mirror of
https://github.com/penpot/penpot.git
synced 2025-03-30 16:41:20 -05:00
🚧 Major refactor of backend code.
Relevant changes: - ring -> vertx - suricatta -> vertx-pgsql - emails improvements - logging - hybrid sync/async -> full async execution model - database layout refactor
This commit is contained in:
parent
73753ce071
commit
e9b00339a5
134 changed files with 5394 additions and 6598 deletions
|
@ -1,35 +1,38 @@
|
|||
{:deps {org.clojure/clojure {:mvn/version "1.10.1"}
|
||||
org.clojure/tools.logging {:mvn/version "0.3.1"}
|
||||
funcool/promesa {:mvn/version "4.0.2"}
|
||||
funcool/cuerdas {:mvn/version "2.2.0"}
|
||||
funcool/promesa {:mvn/version "5.0.0-SNAPSHOT"}
|
||||
funcool/cuerdas {:mvn/version "2.2.1"}
|
||||
|
||||
funcool/suricatta {:mvn/version "2.0.0-SNAPSHOT"}
|
||||
;; Logging
|
||||
org.clojure/tools.logging {:mvn/version "0.5.0"}
|
||||
org.apache.logging.log4j/log4j-api {:mvn/version "2.12.1"}
|
||||
org.apache.logging.log4j/log4j-core {:mvn/version "2.12.1"}
|
||||
org.apache.logging.log4j/log4j-jul {:mvn/version "2.12.1"}
|
||||
|
||||
funcool/datoteka {:mvn/version "1.1.0"}
|
||||
funcool/struct {:mvn/version "2.0.0-SNAPSHOT"}
|
||||
expound/expound {:mvn/version "0.7.2"}
|
||||
instaparse/instaparse {:mvn/version "1.4.10"}
|
||||
|
||||
ring/ring {:mvn/version "1.7.1"}
|
||||
metosin/reitit-core {:mvn/version "0.3.9"}
|
||||
metosin/reitit-ring {:mvn/version "0.3.9"}
|
||||
metosin/reitit-middleware {:mvn/version "0.3.9"}
|
||||
metosin/reitit-spec {:mvn/version "0.3.9"}
|
||||
;; vertx deps
|
||||
metosin/reitit-core {:mvn/version "0.3.10"}
|
||||
metosin/sieppari {:mvn/version "0.0.0-alpha8"}
|
||||
com.cognitect/transit-clj {:mvn/version "0.8.319"}
|
||||
io.vertx/vertx-core {:mvn/version "3.8.1"}
|
||||
io.vertx/vertx-web {:mvn/version "3.8.1"}
|
||||
io.vertx/vertx-pg-client {:mvn/version "3.8.1"}
|
||||
;; end verx deps
|
||||
|
||||
lambdaisland/uri {:mvn/version "1.1.0"}
|
||||
|
||||
danlentz/clj-uuid {:mvn/version "0.1.9"}
|
||||
org.jsoup/jsoup {:mvn/version "1.12.1"}
|
||||
hiccup/hiccup {:mvn/version "1.0.5"}
|
||||
org.im4java/im4java {:mvn/version "1.4.0"}
|
||||
org.slf4j/slf4j-simple {:mvn/version "1.7.26"}
|
||||
com.layerware/hugsql-core {:mvn/version "0.4.9"
|
||||
:exclusions [org.clojure/tools.reader]}
|
||||
niwinz/migrante {:mvn/version "0.1.0"}
|
||||
|
||||
buddy/buddy-sign {:mvn/version "3.1.0"}
|
||||
buddy/buddy-hashers {:mvn/version "1.4.0"}
|
||||
|
||||
org.xerial.snappy/snappy-java {:mvn/version "1.1.7.3"}
|
||||
com.github.spullara.mustache.java/compiler {:mvn/version "0.9.6"}
|
||||
org.postgresql/postgresql {:mvn/version "42.2.6"}
|
||||
org.quartz-scheduler/quartz {:mvn/version "2.3.1"}
|
||||
org.quartz-scheduler/quartz-jobs {:mvn/version "2.3.1"}
|
||||
commons-io/commons-io {:mvn/version "2.6"}
|
||||
com.draines/postal {:mvn/version "2.0.3"
|
||||
:exclusions [commons-codec/commons-codec]}
|
||||
|
@ -37,7 +40,6 @@
|
|||
;; exception printing
|
||||
io.aviso/pretty {:mvn/version "0.1.37"}
|
||||
|
||||
hikari-cp/hikari-cp {:mvn/version "2.7.1"}
|
||||
mount/mount {:mvn/version "0.1.16"}
|
||||
environ/environ {:mvn/version "1.1.0"}
|
||||
}
|
||||
|
@ -46,9 +48,8 @@
|
|||
{:dev
|
||||
{:extra-deps {com.bhauman/rebel-readline {:mvn/version "0.1.4"}
|
||||
org.clojure/tools.namespace {:mvn/version "0.3.1"}
|
||||
fipp/fipp {:mvn/version "0.6.19"}
|
||||
clj-http/clj-http {:mvn/version "2.1.0"}
|
||||
ring/ring-mock {:mvn/version "0.4.0"}
|
||||
fipp/fipp {:mvn/version "0.6.21"}
|
||||
criterium/criterium {:mvn/version "0.4.5"}
|
||||
}
|
||||
:extra-paths ["test"]}
|
||||
:repl {:main-opts ["-m" "rebel-readline.main"]}
|
||||
|
|
14
backend/resources/emails/debug-email-list.html
Normal file
14
backend/resources/emails/debug-email-list.html
Normal file
|
@ -0,0 +1,14 @@
|
|||
<html>
|
||||
<body>
|
||||
<section style="font-family: Monoid, monospace; font-size: 14px;">
|
||||
<h1>Available Emails:</h1>
|
||||
<ul>
|
||||
{{#emails}}
|
||||
<li>
|
||||
<a href="/debug/emails/{{ id }}">{{id}}</a>
|
||||
</li>
|
||||
{{/emails}}
|
||||
</ul>
|
||||
</section>
|
||||
</body>
|
||||
</html>
|
|
@ -11,7 +11,31 @@ UXBOX team.
|
|||
-- end
|
||||
|
||||
-- begin :body-html
|
||||
<p>Hello {{user}}!</p>
|
||||
<p>Welcome to UXBOX.</p>
|
||||
<p>UXBOX team.</p>
|
||||
<html>
|
||||
<head>
|
||||
<meta content="text/html; charset=UTF-8" http-equiv="Content-Type" />
|
||||
<meta content="width=device-width" name="viewport" />
|
||||
<title>title</title>
|
||||
{{> ../partials/inline_style }}
|
||||
</head>
|
||||
<body bgcolor="#f6f6f6" cz-shortcut-listen="true">
|
||||
<table class="body-wrap">
|
||||
<tbody>
|
||||
<tr>
|
||||
<td></td>
|
||||
<td bgcolor="#FFFFFF" class="container">
|
||||
<div class="logo">
|
||||
<img alt="UXBOX" src="{{#static}}images/email/logo.png{{/static}}" />
|
||||
</div>
|
||||
<p>Hello {{user}}!</p>
|
||||
<p>Welcome to UXBOX.</p>
|
||||
<p>UXBOX team.</p>
|
||||
</td>
|
||||
<td></td>
|
||||
</tr>
|
||||
</tbody>
|
||||
</table>
|
||||
{{> ../partials/en/footer }}
|
||||
</body>
|
||||
</html>
|
||||
-- end
|
46
backend/resources/emails/partials/en/footer.mustache
Normal file
46
backend/resources/emails/partials/en/footer.mustache
Normal file
|
@ -0,0 +1,46 @@
|
|||
<table class="footer-wrap">
|
||||
<tbody>
|
||||
<tr>
|
||||
<td></td>
|
||||
<td class="container">
|
||||
<div class="content">
|
||||
<table>
|
||||
<tbody>
|
||||
<tr>
|
||||
<td>
|
||||
<div style="text-align: center;">
|
||||
<a href="#" target="_blank">
|
||||
<img src="{{#static}}images/email/twitter.png{{/static}}"
|
||||
style="display: inline-block; width: 25px; margin-right: 5px;" />
|
||||
</a>
|
||||
<a href="#" target="_blank">
|
||||
<img src="{{#static}}images/email/github.png{{/static}}"
|
||||
style="display: inline-block; width: 25px; margin-right: 5px;" />
|
||||
</a>
|
||||
<a href="#" target="_blank">
|
||||
<img src="{{#static}}images/email/linkedin.png{{/static}}"
|
||||
style="display: inline-block; width: 25px; margin-right: 5px;" />
|
||||
</a>
|
||||
</div>
|
||||
</td>
|
||||
</tr>
|
||||
{{#comment}}
|
||||
<tr>
|
||||
<td align="center">
|
||||
<p>
|
||||
<span>Sent from UXBOX | </span>
|
||||
<a href="#" target="_blank">
|
||||
<unsubscribe>Email preferences</unsubscribe>
|
||||
</a>
|
||||
</p>
|
||||
</td>
|
||||
</tr>
|
||||
{{/comment}}
|
||||
</tbody>
|
||||
</table>
|
||||
</div>
|
||||
</td>
|
||||
<td></td>
|
||||
</tr>
|
||||
</tbody>
|
||||
</table>
|
6
backend/resources/emails/partials/head.mustache
Normal file
6
backend/resources/emails/partials/head.mustache
Normal file
|
@ -0,0 +1,6 @@
|
|||
<head>
|
||||
<meta content="text/html; charset=UTF-8" http-equiv="Content-Type" />
|
||||
<meta content="width=device-width" name="viewport" />
|
||||
<title>title</title>
|
||||
{{> inline_style }}
|
||||
</head>
|
162
backend/resources/emails/partials/inline_style.mustache
Normal file
162
backend/resources/emails/partials/inline_style.mustache
Normal file
|
@ -0,0 +1,162 @@
|
|||
<style>
|
||||
/* GLOBAL */
|
||||
* {
|
||||
margin:0;
|
||||
padding:0;
|
||||
font-family: Arial, sans-serif;
|
||||
font-size: 100%;
|
||||
line-height: 1.6;
|
||||
}
|
||||
|
||||
img {
|
||||
max-width: 100%;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.img-header {
|
||||
border-top-left-radius: 5px;
|
||||
border-top-right-radius: 5px;
|
||||
}
|
||||
|
||||
body {
|
||||
-webkit-font-smoothing:antialiased;
|
||||
-webkit-text-size-adjust:none;
|
||||
width: 100%!important;
|
||||
height: 100%;
|
||||
}
|
||||
|
||||
/* ELEMENTS */
|
||||
a {
|
||||
color: #78dbbe;
|
||||
text-decoration:none;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.btn-primary {
|
||||
text-decoration:none;
|
||||
color: #fff;
|
||||
background-color: #78dbbe;
|
||||
padding: 10px 30px;
|
||||
font-weight: bold;
|
||||
margin: 20px 0;
|
||||
text-align: center;
|
||||
cursor: pointer;
|
||||
display: inline-block;
|
||||
border-radius: 4px;
|
||||
}
|
||||
|
||||
.btn-primary:hover {
|
||||
color: #FFF;
|
||||
background-color: #8eefcf;
|
||||
}
|
||||
|
||||
.last {
|
||||
margin-bottom: 0;
|
||||
}
|
||||
|
||||
.first{
|
||||
margin-top: 0;
|
||||
}
|
||||
|
||||
.logo {
|
||||
background-color: #f6f6f6;
|
||||
padding: 10px;
|
||||
text-align: center;
|
||||
padding-bottom: 25px;
|
||||
}
|
||||
.logo h2 {
|
||||
color: #777;
|
||||
font-size: 20px;
|
||||
font-weight: bold;
|
||||
margin-top: 15px;
|
||||
}
|
||||
.logo img {
|
||||
max-width: 150px;
|
||||
}
|
||||
|
||||
/* BODY */
|
||||
table.body-wrap {
|
||||
width: 100%;
|
||||
padding: 20px;
|
||||
}
|
||||
|
||||
table.body-wrap .container{
|
||||
border-radius: 5px;
|
||||
color: #ababab;
|
||||
}
|
||||
|
||||
|
||||
/* FOOTER */
|
||||
table.footer-wrap {
|
||||
width: 100%;
|
||||
clear:both!important;
|
||||
}
|
||||
|
||||
.footer-wrap .container p {
|
||||
font-size: 12px;
|
||||
color:#666;
|
||||
|
||||
}
|
||||
|
||||
table.footer-wrap a{
|
||||
color: #999;
|
||||
}
|
||||
|
||||
|
||||
/* TYPOGRAPHY */
|
||||
h1,h2,h3{
|
||||
font-family: Arial, sans-serif;
|
||||
line-height: 1.1;
|
||||
margin-bottom:15px;
|
||||
color:#000;
|
||||
margin: 40px 0 10px;
|
||||
line-height: 1.2;
|
||||
font-weight:200;
|
||||
}
|
||||
|
||||
h1 {
|
||||
color: #777;
|
||||
font-size: 28px;
|
||||
font-weight: bold;
|
||||
}
|
||||
h2 {
|
||||
font-size: 24px;
|
||||
}
|
||||
h3 {
|
||||
font-size: 18px;
|
||||
}
|
||||
|
||||
p, ul {
|
||||
margin-bottom: 10px;
|
||||
font-weight: normal;
|
||||
}
|
||||
|
||||
ul li {
|
||||
margin-left:5px;
|
||||
list-style-position: inside;
|
||||
}
|
||||
|
||||
/* RESPONSIVE */
|
||||
|
||||
/* Set a max-width, and make it display as block so it will automatically stretch to that width, but will also shrink down on a phone or something */
|
||||
.container {
|
||||
display: block !important;
|
||||
max-width: 620px !important;
|
||||
margin: 0 auto !important; /* makes it centered */
|
||||
clear: both !important;
|
||||
}
|
||||
|
||||
/* This should also be a block element, so that it will fill 100% of the .container */
|
||||
.content {
|
||||
padding: 20px;
|
||||
max-width: 620px;
|
||||
margin: 0 auto;
|
||||
display: block;
|
||||
}
|
||||
|
||||
/* Let's make sure tables in the content area are 100% wide */
|
||||
.content table {
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
</style>
|
12
backend/resources/log4j2.xml
Normal file
12
backend/resources/log4j2.xml
Normal file
|
@ -0,0 +1,12 @@
|
|||
<Configuration status="info" monitorInterval="60">
|
||||
<Appenders>
|
||||
<Console name="console" target="SYSTEM_OUT">
|
||||
<PatternLayout pattern="%d{HH:mm:ss.SSS} [%t] %-5level %logger{36} - %msg%n"/>
|
||||
</Console>
|
||||
</Appenders>
|
||||
<Loggers>
|
||||
<Root level="info">
|
||||
<AppenderRef ref="console"/>
|
||||
</Root>
|
||||
</Loggers>
|
||||
</Configuration>
|
|
@ -1,28 +0,0 @@
|
|||
CREATE EXTENSION IF NOT EXISTS "uuid-ossp";
|
||||
CREATE EXTENSION IF NOT EXISTS "pgcrypto";
|
||||
|
||||
-- OCC
|
||||
|
||||
CREATE OR REPLACE FUNCTION handle_occ()
|
||||
RETURNS TRIGGER AS $occ$
|
||||
BEGIN
|
||||
IF (NEW.version != OLD.version) THEN
|
||||
RAISE EXCEPTION 'Version missmatch: expected % given %',
|
||||
OLD.version, NEW.version
|
||||
USING ERRCODE='P0002';
|
||||
ELSE
|
||||
NEW.version := NEW.version + 1;
|
||||
END IF;
|
||||
RETURN NEW;
|
||||
END;
|
||||
$occ$ LANGUAGE plpgsql;
|
||||
|
||||
-- Modified At
|
||||
|
||||
CREATE OR REPLACE FUNCTION update_modified_at()
|
||||
RETURNS TRIGGER AS $updt$
|
||||
BEGIN
|
||||
NEW.modified_at := clock_timestamp();
|
||||
RETURN NEW;
|
||||
END;
|
||||
$updt$ LANGUAGE plpgsql;
|
12
backend/resources/migrations/0001.main.up.sql
Normal file
12
backend/resources/migrations/0001.main.up.sql
Normal file
|
@ -0,0 +1,12 @@
|
|||
CREATE EXTENSION IF NOT EXISTS "uuid-ossp";
|
||||
CREATE EXTENSION IF NOT EXISTS "pgcrypto";
|
||||
|
||||
-- Modified At
|
||||
|
||||
CREATE OR REPLACE FUNCTION update_modified_at()
|
||||
RETURNS TRIGGER AS $updt$
|
||||
BEGIN
|
||||
NEW.modified_at := clock_timestamp();
|
||||
RETURN NEW;
|
||||
END;
|
||||
$updt$ LANGUAGE plpgsql;
|
|
@ -1,17 +0,0 @@
|
|||
-- A table that will store the whole transaction log of the database.
|
||||
CREATE TABLE IF NOT EXISTS txlog (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
payload bytea NOT NULL
|
||||
);
|
||||
|
||||
CREATE OR REPLACE FUNCTION handle_txlog_notify()
|
||||
RETURNS TRIGGER AS $notify$
|
||||
BEGIN
|
||||
PERFORM pg_notify('uxbox.transaction', (NEW.id)::text);
|
||||
RETURN NEW;
|
||||
END;
|
||||
$notify$ LANGUAGE plpgsql;
|
||||
|
||||
CREATE TRIGGER txlog_notify_tgr AFTER INSERT ON txlog
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_txlog_notify();
|
|
@ -13,6 +13,16 @@ CREATE TABLE users (
|
|||
metadata bytea NOT NULL
|
||||
);
|
||||
|
||||
CREATE TABLE sessions (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
|
||||
user_id uuid REFERENCES users(id) ON DELETE CASCADE,
|
||||
user_agent TEXT NULL
|
||||
);
|
||||
|
||||
-- Insert a placeholder system user.
|
||||
INSERT INTO users (id, fullname, username, email, photo, password, metadata)
|
||||
VALUES ('00000000-0000-0000-0000-000000000000'::uuid,
|
||||
|
@ -21,22 +31,22 @@ VALUES ('00000000-0000-0000-0000-000000000000'::uuid,
|
|||
'system@uxbox.io',
|
||||
'',
|
||||
'!',
|
||||
''::bytea);
|
||||
'{}');
|
||||
|
||||
CREATE UNIQUE INDEX users_username_idx
|
||||
ON users USING btree (username)
|
||||
WHERE deleted_at is null;
|
||||
ON users USING btree (username)
|
||||
WHERE deleted_at is null;
|
||||
|
||||
CREATE UNIQUE INDEX users_email_idx
|
||||
ON users USING btree (email)
|
||||
WHERE deleted_at is null;
|
||||
ON users USING btree (email)
|
||||
WHERE deleted_at is null;
|
||||
|
||||
CREATE TRIGGER users_modified_at_tgr BEFORE UPDATE ON users
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
||||
CREATE TABLE user_pswd_recovery (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
"user" uuid REFERENCES users(id) ON DELETE CASCADE,
|
||||
user_id uuid REFERENCES users(id) ON DELETE CASCADE,
|
||||
token text NOT NULL,
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
|
@ -44,7 +54,7 @@ CREATE TABLE user_pswd_recovery (
|
|||
);
|
||||
|
||||
CREATE INDEX user_pswd_recovery_user_idx
|
||||
ON user_pswd_recovery USING btree ("user");
|
||||
ON user_pswd_recovery USING btree (user_id);
|
||||
|
||||
CREATE UNIQUE INDEX user_pswd_recovery_token_idx
|
||||
ON user_pswd_recovery USING btree (token);
|
||||
|
|
|
@ -2,13 +2,12 @@
|
|||
|
||||
CREATE TABLE IF NOT EXISTS projects (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
"user" uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
deleted_at timestamptz DEFAULT NULL,
|
||||
|
||||
version bigint NOT NULL DEFAULT 0,
|
||||
name text NOT NULL
|
||||
);
|
||||
|
||||
|
@ -23,7 +22,7 @@ CREATE TABLE IF NOT EXISTS project_shares (
|
|||
-- Indexes
|
||||
|
||||
CREATE INDEX projects_user_idx
|
||||
ON projects("user");
|
||||
ON projects(user_id);
|
||||
|
||||
CREATE UNIQUE INDEX projects_shares_token_idx
|
||||
ON project_shares(token);
|
||||
|
@ -49,10 +48,6 @@ CREATE TRIGGER project_on_create_tgr
|
|||
AFTER INSERT ON projects
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_project_create();
|
||||
|
||||
CREATE TRIGGER project_occ_tgr
|
||||
BEFORE UPDATE ON projects
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_occ();
|
||||
|
||||
CREATE TRIGGER projects_modified_at_tgr
|
||||
BEFORE UPDATE ON projects
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
|
|
@ -3,13 +3,12 @@
|
|||
CREATE TABLE IF NOT EXISTS pages (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
|
||||
"user" uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
project uuid NOT NULL REFERENCES projects(id) ON DELETE CASCADE,
|
||||
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
project_id uuid NOT NULL REFERENCES projects(id) ON DELETE CASCADE,
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
deleted_at timestamptz DEFAULT NULL,
|
||||
version bigint DEFAULT 0,
|
||||
|
||||
name text NOT NULL,
|
||||
data bytea NOT NULL,
|
||||
|
@ -19,8 +18,8 @@ CREATE TABLE IF NOT EXISTS pages (
|
|||
CREATE TABLE IF NOT EXISTS pages_history (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
|
||||
"user" uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
page uuid NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
|
||||
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
page_id uuid NOT NULL REFERENCES pages(id) ON DELETE CASCADE,
|
||||
|
||||
created_at timestamptz NOT NULL,
|
||||
modified_at timestamptz NOT NULL,
|
||||
|
@ -33,10 +32,10 @@ CREATE TABLE IF NOT EXISTS pages_history (
|
|||
|
||||
-- Indexes
|
||||
|
||||
CREATE INDEX pages_project_idx ON pages(project);
|
||||
CREATE INDEX pages_user_idx ON pages("user");
|
||||
CREATE INDEX pages_history_page_idx ON pages_history(page);
|
||||
CREATE INDEX pages_history_user_idx ON pages_history("user");
|
||||
CREATE INDEX pages_project_idx ON pages(project_id);
|
||||
CREATE INDEX pages_user_idx ON pages(user_id);
|
||||
CREATE INDEX pages_history_page_idx ON pages_history(page_id);
|
||||
CREATE INDEX pages_history_user_idx ON pages_history(user_id);
|
||||
|
||||
-- Triggers
|
||||
|
||||
|
@ -46,16 +45,7 @@ CREATE OR REPLACE FUNCTION handle_page_update()
|
|||
--- Update projects modified_at attribute when a
|
||||
--- page of that project is modified.
|
||||
UPDATE projects SET modified_at = clock_timestamp()
|
||||
WHERE id = OLD.project;
|
||||
|
||||
--- Register a new history entry if the data
|
||||
--- property is changed.
|
||||
IF (OLD.data != NEW.data) THEN
|
||||
INSERT INTO pages_history (page, "user", created_at,
|
||||
modified_at, data, version)
|
||||
VALUES (OLD.id, OLD."user", OLD.modified_at,
|
||||
OLD.modified_at, OLD.data, OLD.version);
|
||||
END IF;
|
||||
WHERE id = OLD.project_id;
|
||||
|
||||
RETURN NEW;
|
||||
END;
|
||||
|
@ -64,9 +54,6 @@ $pagechange$ LANGUAGE plpgsql;
|
|||
CREATE TRIGGER page_on_update_tgr BEFORE UPDATE ON pages
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_page_update();
|
||||
|
||||
CREATE TRIGGER page_occ_tgr BEFORE UPDATE ON pages
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_occ();
|
||||
|
||||
CREATE TRIGGER pages_modified_at_tgr BEFORE UPDATE ON pages
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
||||
|
|
|
@ -1,19 +1,14 @@
|
|||
CREATE TABLE IF NOT EXISTS kvstore (
|
||||
"user" uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
|
||||
version bigint NOT NULL DEFAULT 0,
|
||||
|
||||
key text NOT NULL,
|
||||
value bytea NOT NULL,
|
||||
|
||||
PRIMARY KEY (key, "user")
|
||||
PRIMARY KEY (key, user_id)
|
||||
);
|
||||
|
||||
CREATE TRIGGER kvstore_occ_tgr BEFORE UPDATE ON kvstore
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_occ();
|
||||
|
||||
CREATE TRIGGER kvstore_modified_at_tgr BEFORE UPDATE ON kvstore
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
|
|
@ -7,7 +7,7 @@ CREATE TABLE IF NOT EXISTS email_queue (
|
|||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
deleted_at timestamptz DEFAULT NULL,
|
||||
|
||||
data bytea NOT NULL,
|
||||
data jsonb NOT NULL,
|
||||
|
||||
priority smallint NOT NULL DEFAULT 10
|
||||
CHECK (priority BETWEEN 0 and 10),
|
||||
|
@ -19,9 +19,8 @@ CREATE TABLE IF NOT EXISTS email_queue (
|
|||
-- Triggers
|
||||
|
||||
CREATE TRIGGER email_queue_modified_at_tgr BEFORE UPDATE ON email_queue
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
||||
-- Indexes
|
||||
|
||||
CREATE INDEX email_status_idx
|
||||
ON email_queue (status);
|
||||
CREATE INDEX email_status_idx ON email_queue (status);
|
||||
|
|
|
@ -2,32 +2,29 @@
|
|||
|
||||
CREATE TABLE IF NOT EXISTS images_collections (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
"user" uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
deleted_at timestamptz DEFAULT NULL,
|
||||
version bigint NOT NULL DEFAULT 0,
|
||||
|
||||
name text NOT NULL
|
||||
);
|
||||
|
||||
CREATE TABLE IF NOT EXISTS images (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
"user" uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
deleted_at timestamptz DEFAULT NULL,
|
||||
|
||||
version bigint NOT NULL DEFAULT 0,
|
||||
|
||||
width int NOT NULL,
|
||||
height int NOT NULL,
|
||||
mimetype text NOT NULL,
|
||||
collection uuid REFERENCES images_collections(id)
|
||||
ON DELETE SET NULL
|
||||
DEFAULT NULL,
|
||||
collection_id uuid REFERENCES images_collections(id)
|
||||
ON DELETE SET NULL
|
||||
DEFAULT NULL,
|
||||
name text NOT NULL,
|
||||
path text NOT NULL
|
||||
);
|
||||
|
@ -35,25 +32,19 @@ CREATE TABLE IF NOT EXISTS images (
|
|||
-- Indexes
|
||||
|
||||
CREATE INDEX images_collections_user_idx
|
||||
ON images_collections ("user");
|
||||
ON images_collections (user_id);
|
||||
|
||||
CREATE INDEX images_collection_idx
|
||||
ON images (collection);
|
||||
ON images (collection_id);
|
||||
|
||||
CREATE INDEX images_user_idx
|
||||
ON images ("user");
|
||||
ON images (user_id);
|
||||
|
||||
-- Triggers
|
||||
|
||||
CREATE TRIGGER images_collections_occ_tgr BEFORE UPDATE ON images_collections
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_occ();
|
||||
|
||||
CREATE TRIGGER images_collections_modified_at_tgr BEFORE UPDATE ON images_collections
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
||||
CREATE TRIGGER images_occ_tgr BEFORE UPDATE ON images
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_occ();
|
||||
|
||||
CREATE TRIGGER images_modified_at_tgr BEFORE UPDATE ON images
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
||||
|
|
|
@ -2,55 +2,48 @@
|
|||
|
||||
CREATE TABLE IF NOT EXISTS icons_collections (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
"user" uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
deleted_at timestamptz DEFAULT NULL,
|
||||
version bigint NOT NULL DEFAULT 0,
|
||||
|
||||
name text NOT NULL
|
||||
);
|
||||
|
||||
CREATE TABLE IF NOT EXISTS icons (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
"user" uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
user_id uuid NOT NULL REFERENCES users(id) ON DELETE CASCADE,
|
||||
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
deleted_at timestamptz DEFAULT NULL,
|
||||
version bigint NOT NULL DEFAULT 0,
|
||||
|
||||
name text NOT NULL,
|
||||
content text NOT NULL,
|
||||
metadata bytea NOT NULL,
|
||||
collection uuid REFERENCES icons_collections(id)
|
||||
ON DELETE SET NULL
|
||||
DEFAULT NULL
|
||||
|
||||
collection_id uuid REFERENCES icons_collections(id)
|
||||
ON DELETE SET NULL
|
||||
DEFAULT NULL
|
||||
);
|
||||
|
||||
-- Indexes
|
||||
|
||||
CREATE INDEX icon_colections_user_idx
|
||||
ON icons_collections ("user");
|
||||
ON icons_collections (user_id);
|
||||
|
||||
CREATE INDEX icons_user_idx
|
||||
ON icons ("user");
|
||||
ON icons (user_id);
|
||||
|
||||
CREATE INDEX icons_collection_idx
|
||||
ON icons (collection);
|
||||
ON icons (collection_id);
|
||||
|
||||
-- Triggers
|
||||
|
||||
CREATE TRIGGER icons_collections_occ_tgr BEFORE UPDATE ON icons_collections
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_occ();
|
||||
|
||||
CREATE TRIGGER icons_collections_modified_at_tgr BEFORE UPDATE ON icons_collections
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
||||
CREATE TRIGGER icons_occ_tgr BEFORE UPDATE ON icons
|
||||
FOR EACH ROW EXECUTE PROCEDURE handle_occ();
|
||||
|
||||
CREATE TRIGGER icons_modified_at_tgr BEFORE UPDATE ON icons
|
||||
FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
|
||||
|
||||
|
|
|
@ -1,42 +0,0 @@
|
|||
DROP TRIGGER page_on_update_tgr ON pages;
|
||||
|
||||
CREATE OR REPLACE FUNCTION handle_page_update()
|
||||
RETURNS TRIGGER AS $pagechange$
|
||||
BEGIN
|
||||
--- Update projects modified_at attribute when a
|
||||
--- page of that project is modified.
|
||||
UPDATE projects SET modified_at = clock_timestamp()
|
||||
WHERE id = OLD.project;
|
||||
|
||||
RETURN NEW;
|
||||
END;
|
||||
$pagechange$ LANGUAGE plpgsql;
|
||||
|
||||
CREATE OR REPLACE FUNCTION handle_page_history()
|
||||
RETURNS TRIGGER AS $pagehistory$
|
||||
BEGIN
|
||||
INSERT INTO pages_history (page, "user", created_at,
|
||||
modified_at, data, version)
|
||||
VALUES (NEW.id, NEW."user", NEW.modified_at,
|
||||
NEW.modified_at, NEW.data, NEW.version);
|
||||
|
||||
RETURN NEW;
|
||||
END;
|
||||
$pagehistory$ LANGUAGE plpgsql;
|
||||
|
||||
|
||||
CREATE TRIGGER page_on_insert_tgr
|
||||
AFTER INSERT ON pages
|
||||
FOR EACH ROW
|
||||
EXECUTE PROCEDURE handle_page_history();
|
||||
|
||||
CREATE TRIGGER page_on_update_tgr
|
||||
AFTER UPDATE ON pages
|
||||
FOR EACH ROW
|
||||
EXECUTE PROCEDURE handle_page_update();
|
||||
|
||||
CREATE TRIGGER page_on_update_history_tgr
|
||||
AFTER UPDATE ON pages
|
||||
FOR EACH ROW
|
||||
WHEN (OLD.data IS DISTINCT FROM NEW.data)
|
||||
EXECUTE PROCEDURE handle_page_history();
|
|
@ -1,11 +1 @@
|
|||
CREATE TYPE task_status
|
||||
AS ENUM ('pending', 'canceled', 'completed', 'failed');
|
||||
|
||||
CREATE TABLE task (
|
||||
id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
|
||||
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
|
||||
completed_at timestamptz DEFAULT NULL,
|
||||
queue text NOT NULL DEFAULT '',
|
||||
status task_status NOT NULL DEFAULT 'pending',
|
||||
error text NOT NULL DEFAULT ''
|
||||
) WITH (OIDS=FALSE);
|
||||
select version();
|
||||
|
|
|
@ -1,53 +0,0 @@
|
|||
-- :name get-image-collection :? :1
|
||||
select *
|
||||
from images_collections as cc
|
||||
where cc.id = :id
|
||||
and cc."user" = '00000000-0000-0000-0000-000000000000'::uuid;
|
||||
|
||||
-- :name create-image :<! :1
|
||||
insert into images ("user", id, name, collection, path, width, height, mimetype)
|
||||
values ('00000000-0000-0000-0000-000000000000'::uuid,
|
||||
:id, :name, :collection, :path, :width, :height, :mimetype)
|
||||
returning *;
|
||||
|
||||
-- :name delete-image :! :n
|
||||
delete from images
|
||||
where id = :id
|
||||
and "user" = '00000000-0000-0000-0000-000000000000'::uuid;
|
||||
|
||||
-- :name create-images-collection
|
||||
insert into images_collections (id, "user", name)
|
||||
values (:id, '00000000-0000-0000-0000-000000000000'::uuid, :name)
|
||||
on conflict (id)
|
||||
do update set name = :name
|
||||
returning *;
|
||||
|
||||
-- :name get-image
|
||||
select * from images as i
|
||||
where i.id = :id
|
||||
and i."user" = '00000000-0000-0000-0000-000000000000'::uuid;
|
||||
|
||||
-- :name create-icons-collection
|
||||
insert into icons_collections (id, "user", name)
|
||||
values (:id, '00000000-0000-0000-0000-000000000000'::uuid, :name)
|
||||
on conflict (id)
|
||||
do update set name = :name
|
||||
returning *;
|
||||
|
||||
-- :name get-icon
|
||||
select * from icons as i
|
||||
where i.id = :id
|
||||
and i."user" = '00000000-0000-0000-0000-000000000000'::uuid;
|
||||
|
||||
-- :name create-icon :<! :1
|
||||
insert into icons ("user", id, name, collection, metadata, content)
|
||||
values ('00000000-0000-0000-0000-000000000000'::uuid,
|
||||
:id, :name, :collection, :metadata, :content)
|
||||
on conflict (id)
|
||||
do update set name = :name,
|
||||
content = :content,
|
||||
metadata = :metadata,
|
||||
collection = :collection,
|
||||
"user" = '00000000-0000-0000-0000-000000000000'::uuid
|
||||
returning *;
|
||||
|
|
@ -1,45 +0,0 @@
|
|||
-- :name insert-email :! :n
|
||||
insert into email_queue (data, priority)
|
||||
values (:data, :priority);
|
||||
|
||||
-- :name get-pending-emails :? :*
|
||||
select eq.* from email_queue as eq
|
||||
where eq.status = 'pending'
|
||||
and eq.deleted_at is null
|
||||
order by eq.priority desc,
|
||||
eq.created_at desc;
|
||||
|
||||
-- :name get-immediate-emails :? :*
|
||||
select eq.* from email_queue as eq
|
||||
where eq.status = 'pending'
|
||||
and eq.priority = 10
|
||||
and eq.deleted_at is null
|
||||
order by eq.priority desc,
|
||||
eq.created_at desc;
|
||||
|
||||
-- :name get-failed-emails :? :*
|
||||
select eq.* from email_queue as eq
|
||||
where eq.status = 'failed'
|
||||
and eq.deleted_at is null
|
||||
and eq.retries < :max-retries
|
||||
order by eq.priority desc,
|
||||
eq.created_at desc;
|
||||
|
||||
-- :name mark-email-as-sent :! :n
|
||||
update email_queue
|
||||
set status = 'ok'
|
||||
where id = :id
|
||||
and deleted_at is null;
|
||||
|
||||
-- :name mark-email-as-failed :! :n
|
||||
update email_queue
|
||||
set status = 'failed',
|
||||
retries = retries + 1
|
||||
where id = :id
|
||||
and deleted_at is null;
|
||||
|
||||
-- :name delete-email :! :n
|
||||
update email_queue
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = :id
|
||||
and deleted_at is null;
|
|
@ -1,69 +0,0 @@
|
|||
-- :name create-icon-collection :<! :1
|
||||
insert into icons_collections (id, "user", name)
|
||||
values (:id, :user, :name)
|
||||
returning *;
|
||||
|
||||
-- :name update-icon-collection :<! :1
|
||||
update icons_collections
|
||||
set name = :name,
|
||||
version = :version
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
returning *;
|
||||
|
||||
-- :name get-icon-collections :? :*
|
||||
select *,
|
||||
(select count(*) from icons where collection = ic.id) as num_icons
|
||||
from icons_collections as ic
|
||||
where (ic."user" = :user or
|
||||
ic."user" = '00000000-0000-0000-0000-000000000000'::uuid)
|
||||
and ic.deleted_at is null
|
||||
order by ic.created_at desc;
|
||||
|
||||
-- :name delete-icon-collection :! :n
|
||||
update icons_collections
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = :id and "user" = :user;
|
||||
|
||||
-- :name get-icons-by-collection :? :*
|
||||
select *
|
||||
from icons as i
|
||||
where (i."user" = :user or
|
||||
i."user" = '00000000-0000-0000-0000-000000000000'::uuid)
|
||||
and i.deleted_at is null
|
||||
and i."collection" = :collection
|
||||
order by i.created_at desc;
|
||||
|
||||
-- :name get-icons :? :*
|
||||
select * from icons
|
||||
where "user" = :user
|
||||
and deleted_at is null
|
||||
and collection is null
|
||||
order by created_at desc;
|
||||
|
||||
-- :name get-icon :? :1
|
||||
select * from icons
|
||||
where id = :id
|
||||
and deleted_at is null
|
||||
and ("user" = :user or
|
||||
"user" = '00000000-0000-0000-0000-000000000000'::uuid);
|
||||
|
||||
-- :name create-icon :<! :1
|
||||
insert into icons ("user", name, collection, metadata, content)
|
||||
values (:user, :name, :collection, :metadata, :content)
|
||||
returning *;
|
||||
|
||||
-- :name update-icon :<! :1
|
||||
update icons
|
||||
set name = :name,
|
||||
collection = :collection,
|
||||
version = :version
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
returning *;
|
||||
|
||||
-- :name delete-icon :! :n
|
||||
update icons
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = :id
|
||||
and "user" = :user;
|
|
@ -1,67 +0,0 @@
|
|||
-- :name create-image-collection :<! :1
|
||||
insert into images_collections (id, "user", name)
|
||||
values (:id, :user, :name)
|
||||
returning *;
|
||||
|
||||
-- :name update-image-collection :<! :1
|
||||
update images_collections
|
||||
set name = :name,
|
||||
version = :version
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
returning *;
|
||||
|
||||
-- :name get-image-collections :? :*
|
||||
select *,
|
||||
(select count(*) from images where collection = ic.id) as num_images
|
||||
from images_collections as ic
|
||||
where (ic."user" = :user or
|
||||
ic."user" = '00000000-0000-0000-0000-000000000000'::uuid)
|
||||
and ic.deleted_at is null
|
||||
order by ic.created_at desc;
|
||||
|
||||
-- :name delete-image-collection :! :n
|
||||
update images_collections
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = :id
|
||||
and "user" = :user;
|
||||
|
||||
-- :name get-images-by-collection :? :*
|
||||
select * from images
|
||||
where ("user" = :user or
|
||||
"user" = '00000000-0000-0000-0000-000000000000'::uuid)
|
||||
and deleted_at is null
|
||||
and collection = :collection
|
||||
order by created_at desc;
|
||||
|
||||
-- :name get-images :? :*
|
||||
select * from images
|
||||
where "user" = :user
|
||||
and deleted_at is null
|
||||
and collection is null
|
||||
order by created_at desc;
|
||||
|
||||
-- :name get-image :? :1
|
||||
select * from images
|
||||
where id = :id
|
||||
and deleted_at is null;
|
||||
|
||||
-- :name create-image :<! :1
|
||||
insert into images ("user", name, collection, path, width, height, mimetype)
|
||||
values (:user, :name, :collection, :path, :width, :height, :mimetype)
|
||||
returning *;
|
||||
|
||||
-- :name update-image :<! :1
|
||||
update images
|
||||
set name = :name,
|
||||
collection = :collection,
|
||||
version = :version
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
returning *;
|
||||
|
||||
-- :name delete-image :! :n
|
||||
update images
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = :id and "user" = :user
|
||||
returning *;
|
|
@ -1,17 +0,0 @@
|
|||
-- :name update-kvstore :<! :1
|
||||
insert into kvstore (key, value, "user")
|
||||
values (:key, :value, :user)
|
||||
on conflict ("user", key)
|
||||
do update set value = :value, version = :version
|
||||
returning *;
|
||||
|
||||
-- :name retrieve-kvstore :? :1
|
||||
select kv.*
|
||||
from kvstore as kv
|
||||
where kv."user" = :user
|
||||
and kv.key = :key;
|
||||
|
||||
-- :name delete-kvstore :! :n
|
||||
delete from kvstore
|
||||
where "user" = :user
|
||||
and key = :key;
|
|
@ -1,88 +0,0 @@
|
|||
-- :name create-page :<! :1
|
||||
insert into pages (id, "user", project, name, data, metadata)
|
||||
values (:id, :user, :project, :name, :data, :metadata)
|
||||
returning *;
|
||||
|
||||
-- :name update-page :<! :1
|
||||
update pages
|
||||
set name = :name,
|
||||
data = :data,
|
||||
version = :version,
|
||||
metadata = :metadata
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
and deleted_at is null
|
||||
returning *;
|
||||
|
||||
-- :name update-page-metadata :<! :1
|
||||
update pages
|
||||
set name = :name,
|
||||
version = :version,
|
||||
metadata = :metadata
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
and deleted_at is null
|
||||
returning *;
|
||||
|
||||
-- :name delete-page :! :n
|
||||
update pages
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
and deleted_at is null;
|
||||
|
||||
-- :name get-pages :? :*
|
||||
select pg.*
|
||||
from pages as pg
|
||||
where pg.user = :user
|
||||
and pg.deleted_at is null
|
||||
order by created_at asc;
|
||||
|
||||
-- :name get-page-by-id :? :1
|
||||
select pg.* from pages as pg
|
||||
where pg.id = :id
|
||||
and pg.deleted_at is null;
|
||||
|
||||
-- :name get-pages-for-user-and-project :? :*
|
||||
select pg.*
|
||||
from pages as pg
|
||||
where pg.user = :user
|
||||
and pg.project = :project
|
||||
and pg.deleted_at is null
|
||||
order by pg.created_at asc;
|
||||
|
||||
-- :name get-pages-for-project :? :*
|
||||
select pg.*
|
||||
from pages as pg
|
||||
where pg.project = :project
|
||||
and pg.deleted_at is null
|
||||
order by created_at asc;
|
||||
|
||||
-- :name create-page-history :! :n
|
||||
insert into page_history (id, "user", page, pinned, label, data, version);
|
||||
values (:id, :user, :page, :pinned :label, :data, :version);
|
||||
|
||||
-- :name get-page-history :? :*
|
||||
select ph.*
|
||||
from pages_history as ph
|
||||
where ph.user = :user
|
||||
and ph.page = :page
|
||||
and ph.version < :since
|
||||
--~ (when (:pinned params) "and ph.pinned = true")
|
||||
order by ph.version desc
|
||||
limit :max;
|
||||
|
||||
-- :name get-page-history-for-project :? :*
|
||||
select ph.*
|
||||
from pages_history as ph
|
||||
inner join pages as p
|
||||
on (p.id = ph.page)
|
||||
where p.project = :project;
|
||||
|
||||
-- :name update-page-history :? :*
|
||||
update pages_history
|
||||
set label = :label,
|
||||
pinned = :pinned
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
returning *;
|
|
@ -1,49 +0,0 @@
|
|||
-- :name create-project :<! :1
|
||||
insert into projects (id, "user", name)
|
||||
values (:id, :user, :name)
|
||||
returning *;
|
||||
|
||||
-- :name update-project :<! :1
|
||||
update projects
|
||||
set name = :name,
|
||||
version = :version
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
and deleted_at is null
|
||||
returning *;
|
||||
|
||||
-- :name delete-project :! :n
|
||||
update projects
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = :id
|
||||
and "user" = :user
|
||||
and deleted_at is null;
|
||||
|
||||
-- :name get-project-by-id :? :1
|
||||
select p.*
|
||||
from projects as p
|
||||
where p.id = :id
|
||||
and p.deleted_at is null;
|
||||
|
||||
-- :name get-projects :? :*
|
||||
select pr.*,
|
||||
ps.token as share_token
|
||||
from projects as pr
|
||||
inner join project_shares as ps
|
||||
on (ps.project = pr.id)
|
||||
where pr.deleted_at is null
|
||||
and pr."user" = :user
|
||||
order by pr.created_at asc;
|
||||
|
||||
-- :name get-project-by-share-token :? :*
|
||||
select p.*
|
||||
from projects as p
|
||||
inner join project_shares as ps
|
||||
on (p.id = ps.project)
|
||||
where ps.token = :token;
|
||||
|
||||
-- :name get-share-tokens-for-project
|
||||
select s.*
|
||||
from project_shares as s
|
||||
where s.project = :project
|
||||
order by s.created_at desc;
|
|
@ -1,69 +0,0 @@
|
|||
-- :name create-profile :<! :1
|
||||
insert into users (id, fullname, username, email, password, metadata, photo)
|
||||
values (:id, :fullname, :username, :email, :password, :metadata, '')
|
||||
returning *;
|
||||
|
||||
-- :name get-profile :? :1
|
||||
select * from users
|
||||
where id = :id
|
||||
and deleted_at is null;
|
||||
|
||||
-- :name get-profile-by-username :? :1
|
||||
select * from users
|
||||
where (username = :username or email = :username)
|
||||
and deleted_at is null;
|
||||
|
||||
-- :name user-with-username-exists?
|
||||
select exists
|
||||
(select * from users
|
||||
where username = :username
|
||||
--~ (when (:id params) "and id != :id")
|
||||
) as val;
|
||||
|
||||
-- :name user-with-email-exists?
|
||||
select exists
|
||||
(select * from users
|
||||
where email = :email
|
||||
--~ (when (:id params) "and id != :id")
|
||||
) as val;
|
||||
|
||||
-- :name update-profile :<! :1
|
||||
update users
|
||||
set username = :username,
|
||||
email = :email,
|
||||
fullname = :fullname,
|
||||
metadata = :metadata
|
||||
where id = :id
|
||||
and deleted_at is null
|
||||
returning *;
|
||||
|
||||
-- :name update-profile-password :! :n
|
||||
update users
|
||||
set password = :password
|
||||
where id = :id
|
||||
and deleted_at is null
|
||||
|
||||
-- :name update-profile-photo :! :n
|
||||
update users
|
||||
set photo = :photo
|
||||
where id = :id
|
||||
and deleted_at is null
|
||||
|
||||
-- :name create-recovery-token :! :n
|
||||
insert into user_pswd_recovery ("user", token)
|
||||
values (:user, :token);
|
||||
|
||||
-- :name get-recovery-token
|
||||
select * from user_pswd_recovery
|
||||
where used_at is null
|
||||
and token = :token;
|
||||
|
||||
-- :name recovery-token-exists? :? :1
|
||||
select exists (select * from user_pswd_recovery
|
||||
where used_at is null
|
||||
and token = :token) as token_exists;
|
||||
|
||||
-- :name mark-recovery-token-used :! :n
|
||||
update user_pswd_recovery
|
||||
set used_at = clock_timestamp()
|
||||
where token = :token;
|
|
@ -1,53 +0,0 @@
|
|||
-- :name acquire-task :? :1
|
||||
with recursive locked_tasks as (
|
||||
select (j).*, pg_try_advisory_lock((j).id) as locked
|
||||
from (
|
||||
select j
|
||||
from tasks as j
|
||||
where queue = :queue
|
||||
and status = 'pending'
|
||||
and created_at <= now()
|
||||
order by created_at, id
|
||||
limit 1
|
||||
) as t1
|
||||
union all (
|
||||
select (j).*, pg_try_advisory_lock((j).id) as locked
|
||||
from (
|
||||
select (
|
||||
select j
|
||||
from tasks as j
|
||||
where queue = :queue
|
||||
and status = 'pending'
|
||||
and created_at <= now()
|
||||
and (created_at, id) > (locked_tasks.created_at, locked_tasks.id)
|
||||
order by created_at, id
|
||||
limit 1
|
||||
) as j
|
||||
from locked_tasks
|
||||
where locked_tasks.id is not null
|
||||
limit 1
|
||||
) as t1
|
||||
)
|
||||
)
|
||||
select id, status, error, created_at
|
||||
from locked_tasks
|
||||
where locked
|
||||
limit 1;
|
||||
|
||||
-- :name create-task :? :1
|
||||
insert into tasks (queue)
|
||||
values (:queue)
|
||||
returning *;
|
||||
|
||||
-- :name mark-task-done
|
||||
update tasks
|
||||
set status = 'completed',
|
||||
completed_at = clock_timestamp()
|
||||
where id = :id;
|
||||
|
||||
-- :name mark-task-failed
|
||||
update tasks
|
||||
set status = 'failed',
|
||||
error = :error,
|
||||
completed_at = clock_timestamp()
|
||||
where id = :id;
|
|
@ -5,18 +5,48 @@
|
|||
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns user
|
||||
(:require [clojure.tools.namespace.repl :as repl]
|
||||
[clojure.walk :refer [macroexpand-all]]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.test :as test]
|
||||
[clojure.java.io :as io]
|
||||
[buddy.core.codecs :as codecs]
|
||||
[buddy.core.codecs.base64 :as b64]
|
||||
[buddy.core.nonce :as nonce]
|
||||
[mount.core :as mount]
|
||||
[uxbox.main])
|
||||
(:require
|
||||
[clojure.tools.namespace.repl :as repl]
|
||||
[clojure.walk :refer [macroexpand-all]]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.test :as test]
|
||||
[clojure.java.io :as io]
|
||||
[criterium.core :refer [quick-bench bench with-progress-reporting]]
|
||||
[expound.alpha :as expound]
|
||||
[promesa.core :as p]
|
||||
[sieppari.core :as sp]
|
||||
[sieppari.context :as spx]
|
||||
[buddy.core.codecs :as codecs]
|
||||
[buddy.core.codecs.base64 :as b64]
|
||||
[buddy.core.nonce :as nonce]
|
||||
[mount.core :as mount]
|
||||
[uxbox.main]
|
||||
[uxbox.util.blob :as blob])
|
||||
(:gen-class))
|
||||
|
||||
(defmacro run-quick-bench
|
||||
[& exprs]
|
||||
`(with-progress-reporting (quick-bench (do ~@exprs) :verbose)))
|
||||
|
||||
(defmacro run-quick-bench'
|
||||
[& exprs]
|
||||
`(quick-bench (do ~@exprs)))
|
||||
|
||||
(defmacro run-bench
|
||||
[& exprs]
|
||||
`(with-progress-reporting (bench (do ~@exprs) :verbose)))
|
||||
|
||||
(defmacro run-bench'
|
||||
[& exprs]
|
||||
`(bench (do ~@exprs)))
|
||||
|
||||
(def stress-data
|
||||
{:shapes [{:id #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :name "Canvas-1", :type :canvas, :page #uuid "1b7d4218-e3be-5254-9582-18f767d30501", :x1 200, :y1 200, :x2 1224, :y2 968} {:stroke-color "#000000", :name "Rect-1-copy-4-copy-1", :y1 334, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "c1966bac-b568-4f8f-9917-227cc37e5672", :x1 674, :proportion 1.353448275862069, :y2 450, :x2 831, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-7-copy-1", :y1 400, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "20f11fd1-e9a2-41b1-a539-1298194c6d07", :x1 836, :proportion 1.353448275862069, :y2 516, :x2 993, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-11", :y1 355, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "e1efb49a-03dd-4b87-b568-f35e3a85cf19", :x1 223, :proportion 1.353448275862069, :y2 471, :x2 380, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-10", :y1 404, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "4bf2440d-38d4-461b-af41-001cfb00be49", :x1 928, :proportion 1.353448275862069, :y2 520, :x2 1085, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-9", :y1 525, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "bd1cb612-3960-4428-b030-ea0e59c70b06", :x1 497, :proportion 1.353448275862069, :y2 641, :x2 654, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-8", :y1 393, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "78104154-3d6b-43dc-8444-873ca3285bca", :x1 395, :proportion 1.353448275862069, :y2 509, :x2 552, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-7", :y1 711, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "35540bc3-e1a9-4052-8cb7-a4b07da229dd", :x1 838, :proportion 1.353448275862069, :y2 827, :x2 995, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-6", :y1 502, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "a4d2ef30-1da9-4aba-98ed-15088aba36e0", :x1 893, :proportion 1.353448275862069, :y2 618, :x2 1050, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-5", :y1 479, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "4de4a87a-74f3-47ce-85e6-a0d5da9adb62", :x1 595, :proportion 1.353448275862069, :y2 595, :x2 752, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-4", :y1 645, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "c6c062d2-20fe-4e48-8035-63358db2df4c", :x1 676, :proportion 1.353448275862069, :y2 761, :x2 833, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-3", :y1 609, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "b3089c39-24f9-4574-8df1-d1e4596a6200", :x1 831, :proportion 1.353448275862069, :y2 725, :x2 988, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-2", :y1 404, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "da7c624b-807a-41b1-84a6-7e14ed4f150c", :x1 733, :proportion 1.353448275862069, :y2 520, :x2 890, :height 2} {:stroke-color "#000000", :name "Rect-1-copy-1", :y1 609, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "ec65a0a8-9de1-48d7-b245-71f98961dc7c", :x1 518, :proportion 1.353448275862069, :y2 725, :x2 675, :height 2} {:stroke-color "#000000", :name "Rect-1", :y1 566, :width 2, :type :rect, :page #uuid "2ef8e638-4018-5581-aa18-0887f126966c", :canvas #uuid "352cbd3c-1336-5793-80f7-31027d0acfe7", :proportion-lock false, :id #uuid "c7eafc25-214a-4d16-abbe-19aa0f2eb25b", :x1 306, :proportion 1.353448275862069, :y2 682, :x2 463, :height 2}]})
|
||||
|
||||
;; (def a1 (blob/encode stress-data))
|
||||
;; (def b1 (blob/encode-with-json stress-data))
|
||||
;; (def b2 (blob/encode-json-snappy stress-data))
|
||||
|
||||
;; --- Development Stuff
|
||||
|
||||
(defn- make-secret
|
||||
|
@ -27,24 +57,29 @@
|
|||
|
||||
(defn- start
|
||||
[]
|
||||
(-> (mount/except #{#'uxbox.scheduled-jobs/scheduler})
|
||||
(-> #_(mount/except #{#'uxbox.scheduled-jobs/scheduler})
|
||||
(mount/start)))
|
||||
|
||||
(defn- stop
|
||||
[]
|
||||
(mount/stop))
|
||||
|
||||
(defn- start-minimal
|
||||
(defn restart
|
||||
[]
|
||||
(-> (mount/only #{#'uxbox.config/config
|
||||
#'uxbox.db/datasource
|
||||
#'uxbox.migrations/migrations})
|
||||
(mount/start)))
|
||||
(stop)
|
||||
(repl/refresh :after 'user/start))
|
||||
|
||||
;; (defn- start-minimal
|
||||
;; []
|
||||
;; (-> (mount/only #{#'uxbox.config/config
|
||||
;; #'uxbox.db/datasource
|
||||
;; #'uxbox.migrations/migrations})
|
||||
;; (mount/start)))
|
||||
|
||||
(defn- run-test
|
||||
([] (run-test #"^uxbox.tests.*"))
|
||||
([o]
|
||||
(repl/refresh)
|
||||
;; (repl/refresh)
|
||||
(cond
|
||||
(instance? java.util.regex.Pattern o)
|
||||
(test/run-all-tests o)
|
||||
|
|
|
@ -1,72 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.auth
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[struct.core :as st]
|
||||
[uxbox.services :as sv]
|
||||
[uxbox.http.response :as rsp]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(defn login
|
||||
{:description "User login endpoint"
|
||||
:parameters {:body {:username [st/required st/string]
|
||||
:password [st/required st/string]
|
||||
:scope [st/required st/string]}}}
|
||||
[ctx]
|
||||
(let [data (get-in ctx [:parameters :body])]
|
||||
(->> (sv/novelty (assoc data :type :login))
|
||||
(p/map (fn [{:keys [id] :as user}]
|
||||
(-> (rsp/no-content)
|
||||
(assoc :session {:user-id id})))))))
|
||||
|
||||
(defn logout
|
||||
{:description "User logout endpoint"}
|
||||
[req]
|
||||
(-> (rsp/no-content)
|
||||
(assoc :session nil)
|
||||
(p/resolved)))
|
||||
|
||||
(defn register
|
||||
{:parameters {:body {:username [st/required st/string]
|
||||
:email [st/required st/email]
|
||||
:password [st/required st/string]
|
||||
:fullname [st/required st/string]}}}
|
||||
[{:keys [parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data :type :register-profile)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
(defn request-recovery
|
||||
{:parameters {:body {:username [st/required st/string]}}}
|
||||
[{:keys [parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data :type :request-profile-password-recovery)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (constantly (rsp/no-content))))))
|
||||
|
||||
(defn recover-password
|
||||
{:parameters {:body {:token [st/required st/string]
|
||||
:password [st/required st/string]}}}
|
||||
[{:keys [parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data :type :recover-profile-password)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (constantly (rsp/no-content))))))
|
||||
|
||||
(defn validate-recovery-token
|
||||
{:parameters {:path {:token [st/required st/string]}}}
|
||||
[{:keys [parameters]}]
|
||||
(let [message {:type :validate-profile-password-recovery-token
|
||||
:token (get-in parameters [:path :token])}]
|
||||
(->> (sv/query message)
|
||||
(p/map (fn [v]
|
||||
(if v
|
||||
(rsp/no-content)
|
||||
(rsp/not-found "")))))))
|
|
@ -1,67 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.debug-emails
|
||||
"A helper namespace for just render emails."
|
||||
(:require [clojure.edn :as edn]
|
||||
[hiccup.page :refer (html5)]
|
||||
[uxbox.emails :as emails]
|
||||
[uxbox.emails.core :as emails-core]))
|
||||
|
||||
;; (def +available-emails+
|
||||
;; {:users/register
|
||||
;; {:name "Cirilla"}
|
||||
;; :users/password-recovery
|
||||
;; {:name "Cirilla"
|
||||
;; :token "agNFhA6SolcFb4Us2NOTNWh0cfFDquVLAav400xQPjw"}})
|
||||
|
||||
;; (defn- render-emails-list
|
||||
;; []
|
||||
;; (html5
|
||||
;; [:section {:style "font-family: Monoid, monospace; font-size: 14px;"}
|
||||
;; [:h1 "Available emails"]
|
||||
;; [:table {:style "width: 500px;"}
|
||||
;; [:tbody
|
||||
;; [:tr
|
||||
;; (for [[type email] @emails-core/emails]
|
||||
;; [:tr
|
||||
;; [:td (pr-str type)]
|
||||
;; [:td
|
||||
;; [:a {:href (str "/debug/emails/email?id="
|
||||
;; (pr-str type)
|
||||
;; "&type=:text/html")}
|
||||
;; "(html)"]]
|
||||
;; [:td
|
||||
;; [:a {:href (str "/debug/emails/email?id="
|
||||
;; (pr-str type)
|
||||
;; "&type=:text/plain")}
|
||||
;; "(text)"]]])]]]]))
|
||||
|
||||
;; (defn list-emails
|
||||
;; [context]
|
||||
;; (http/ok (render-emails-list)
|
||||
;; {:content-type "text/html; charset=utf-8"}))
|
||||
|
||||
;; (defn- render-email
|
||||
;; [type content]
|
||||
;; (if (= type :text/html)
|
||||
;; content
|
||||
;; (html5
|
||||
;; [:pre content])))
|
||||
|
||||
;; (defn show-email
|
||||
;; [{params :query-params}]
|
||||
;; (let [id (edn/read-string (:id params))
|
||||
;; type (or (edn/read-string (:type params)) :text/html)
|
||||
;; params (-> (get +available-emails+ id)
|
||||
;; (assoc :email/name id))
|
||||
;; email (emails/render params)
|
||||
;; content (->> (:body email)
|
||||
;; (filter #(= (:uxbox.emails.core/type %) type))
|
||||
;; (first)
|
||||
;; (:content))]
|
||||
;; (-> (render-email type content)
|
||||
;; (http/ok {:content-type "text/html; charset=utf-8"}))))
|
|
@ -1,131 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.icons
|
||||
(:require [struct.core :as st]
|
||||
[promesa.core :as p]
|
||||
[uxbox.services :as sv]
|
||||
[uxbox.http.response :as rsp]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(defn create-collection
|
||||
{:parameters {:body {:name [st/required st/string]
|
||||
:id [st/uuid]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data
|
||||
:type :create-icon-collection
|
||||
:user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (fn [result]
|
||||
(let [loc (str "/api/library/icons/" (:id result))]
|
||||
(rsp/created loc result)))))))
|
||||
|
||||
(defn update-collection
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}
|
||||
:body {:name [st/required st/string]
|
||||
:version [st/required st/integer]
|
||||
:id [st/uuid]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data
|
||||
:id (get-in parameters [:path :id])
|
||||
:type :update-icon-collection
|
||||
:user user)]
|
||||
(-> (sv/novelty message)
|
||||
(p/then #(rsp/ok %)))))
|
||||
|
||||
|
||||
(defn delete-collection
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [message {:id (get-in parameters [:path :id])
|
||||
:type :delete-icon-collection
|
||||
:user user}]
|
||||
(-> (sv/novelty message)
|
||||
(p/then (fn [v] (rsp/no-content))))))
|
||||
|
||||
(defn list-collections
|
||||
[{:keys [user]}]
|
||||
(let [params {:user user :type :list-icon-collections}]
|
||||
(-> (sv/query params)
|
||||
(p/then #(rsp/ok %)))))
|
||||
|
||||
;; (def metadata-spec
|
||||
;; {:width [st/number st/positive]
|
||||
;; :height [st/number st/positive]
|
||||
;; :view-box [st/coll [st/every number?]]
|
||||
;; :mimetype [st/string]})
|
||||
|
||||
;; (def metadata-validator
|
||||
;; {:message "must be a metadata"
|
||||
;; :optional true
|
||||
;; :validate #(st/valid? %1 metadata-spec)})
|
||||
|
||||
(defn create-icon
|
||||
{:parameters {:body {:id [st/uuid]
|
||||
:collection [st/uuid]
|
||||
:metadata [st/required] ;; TODO
|
||||
:name [st/required st/string]
|
||||
:content [st/required st/string]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [id (or (get-in parameters [:body :id]) (uuid/random))
|
||||
data (get parameters :body)
|
||||
message (assoc data
|
||||
:user user
|
||||
:id id
|
||||
:type :create-icon)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (fn [entry]
|
||||
(let [loc (str "/api/library/icons/" (:id entry))]
|
||||
(rsp/created loc entry)))))))
|
||||
|
||||
(defn update-icon
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}
|
||||
:body {:name [st/required st/string]
|
||||
:version [st/required st/number]
|
||||
:collection [st/uuid]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data
|
||||
:id (get-in parameters [:path :id])
|
||||
:type :update-icon
|
||||
:user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
(defn copy-icon
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}
|
||||
:body {:collection [st/uuid]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message {:collection (get-in parameters [:body :collection])
|
||||
:id (get-in parameters [:path :id])
|
||||
:user user
|
||||
:type :copy-icon}]
|
||||
(->> (sv/novelty message)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
(defn delete-icon
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [message {:id (get-in parameters [:path :id])
|
||||
:type :delete-icon
|
||||
:user user}]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (fn [v] (rsp/no-content))))))
|
||||
|
||||
(defn list-icons
|
||||
{:parameters {:query {:collection [st/uuid-str]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [collection (get-in parameters [:query :collection])
|
||||
message {:collection collection
|
||||
:type :list-icons
|
||||
:user user}]
|
||||
(->> (sv/query message)
|
||||
(p/map rsp/ok))))
|
||||
|
|
@ -1,169 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.images
|
||||
(:require [struct.core :as st]
|
||||
[promesa.core :as p]
|
||||
[datoteka.storages :as ds]
|
||||
[datoteka.core :as fs]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.images :as images]
|
||||
[uxbox.services :as sv]
|
||||
[uxbox.http.response :as rsp]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(def +thumbnail-options+ {:src :path
|
||||
:dst :thumbnail
|
||||
:width 300
|
||||
:height 100
|
||||
:quality 92
|
||||
:format "webp"})
|
||||
|
||||
(def populate-thumbnails
|
||||
#(images/populate-thumbnails % +thumbnail-options+))
|
||||
|
||||
(def populate-urls
|
||||
#(images/populate-urls % media/images-storage :path :url))
|
||||
|
||||
(defn create-collection
|
||||
{:parameters {:body {:name [st/required st/string]
|
||||
:id [st/uuid]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data
|
||||
:type :create-image-collection
|
||||
:user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (fn [result]
|
||||
(let [loc (str "/api/library/images/" (:id result))]
|
||||
(rsp/created loc result)))))))
|
||||
|
||||
(defn update-collection
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}
|
||||
:body {:name [st/required st/string]
|
||||
:version [st/required st/number]
|
||||
:id [st/uuid]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data
|
||||
:id (get-in parameters [:path :id])
|
||||
:type :update-image-collection
|
||||
:user user)]
|
||||
(-> (sv/novelty message)
|
||||
(p/then rsp/ok))))
|
||||
|
||||
(defn delete-collection
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [message {:id (get-in parameters [:path :id])
|
||||
:type :delete-image-collection
|
||||
:user user}]
|
||||
(-> (sv/novelty message)
|
||||
(p/then (constantly (rsp/no-content))))))
|
||||
|
||||
(defn list-collections
|
||||
[{:keys [user]}]
|
||||
(let [params {:user user :type :list-image-collections}]
|
||||
(-> (sv/query params)
|
||||
(p/then rsp/ok))))
|
||||
|
||||
(defn retrieve-image
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [message {:user user
|
||||
:type :retrieve-image
|
||||
:id (get-in parameters [:path :id])}]
|
||||
(->> (sv/query message)
|
||||
(p/map (fn [result]
|
||||
(if result
|
||||
(-> (populate-thumbnails result)
|
||||
(populate-urls)
|
||||
(rsp/ok))
|
||||
(rsp/not-found "")))))))
|
||||
|
||||
(defn create-image
|
||||
{:parameters {:multipart {:file [st/required]
|
||||
:id [st/uuid-str]
|
||||
:width [st/required st/integer-str]
|
||||
:height [st/required st/integer-str]
|
||||
:mimetype [st/required st/string]
|
||||
:collection [st/uuid-str]}}}
|
||||
[{:keys [user parameters] :as ctx}]
|
||||
(let [params (get parameters :multipart)
|
||||
upload (get params :file)
|
||||
filename (fs/name (:filename upload))
|
||||
tempfile (:tempfile upload)
|
||||
storage media/images-storage]
|
||||
(letfn [(persist-image-entry [path]
|
||||
(let [message (select-keys params [:id :width :height :collection :mimetype])]
|
||||
(sv/novelty (assoc message
|
||||
:id (or (:id params) (uuid/random))
|
||||
:type :create-image
|
||||
:name filename
|
||||
:path (str path)
|
||||
:user user))))
|
||||
(create-response [entry]
|
||||
(let [loc (str "/api/library/images/" (:id entry))]
|
||||
(rsp/created loc entry)))]
|
||||
(->> (ds/save storage filename tempfile)
|
||||
(p/mapcat persist-image-entry)
|
||||
(p/map populate-thumbnails)
|
||||
(p/map populate-urls)
|
||||
(p/map create-response)))))
|
||||
|
||||
(defn update-image
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}
|
||||
:body {:name [st/required st/string]
|
||||
:version [st/required st/number]
|
||||
:collection [st/uuid]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data
|
||||
:id (get-in parameters [:path :id])
|
||||
:type :update-image
|
||||
:user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map populate-thumbnails)
|
||||
(p/map populate-urls)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
(defn copy-image
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}
|
||||
:body {:collection [st/uuid]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [message {:id (get-in parameters [:path :id])
|
||||
:type :copy-image
|
||||
:collection (get-in parameters [:body :collection])}]
|
||||
(->> (sv/novelty message)
|
||||
(p/map populate-thumbnails)
|
||||
(p/map populate-urls)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
(defn delete-image
|
||||
{:parameters {:path {:id [st/required st/uuid-str]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [message {:id (get-in parameters [:path :id])
|
||||
:type :delete-image
|
||||
:user user}]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (constantly (rsp/no-content))))))
|
||||
|
||||
;; --- List collections
|
||||
|
||||
(defn list-images
|
||||
{:parameters {:query {:collection [st/uuid-str]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [collection (get-in parameters [:query :collection])
|
||||
message {:collection collection
|
||||
:type :list-images
|
||||
:user user}]
|
||||
(->> (sv/query message)
|
||||
(p/map (partial map populate-thumbnails))
|
||||
(p/map (partial map populate-urls))
|
||||
(p/map rsp/ok))))
|
||||
|
||||
|
|
@ -1,53 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.kvstore
|
||||
(:refer-clojure :exclude [update])
|
||||
(:require [struct.core :as st]
|
||||
[promesa.core :as p]
|
||||
[uxbox.services :as sv]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.http.response :as rsp]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(defn retrieve
|
||||
{:parameters {:path {:key [st/required st/string]}}}
|
||||
[{:keys [user parameters] }]
|
||||
(let [key (get-in parameters [:path :key])
|
||||
message {:key key
|
||||
:type :retrieve-kvstore
|
||||
:user user}]
|
||||
(->> (sv/query message)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
(defn upsert
|
||||
{:parameters {:path {:key [st/required st/string]}
|
||||
:body {:value [st/required]
|
||||
:version [st/number]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [value (get-in parameters [:body :value])
|
||||
key (get-in parameters [:path :key])
|
||||
version (get-in parameters [:body :version])
|
||||
message {:key key
|
||||
:version version
|
||||
:value value
|
||||
:type :update-kvstore
|
||||
:user user}]
|
||||
(->> (sv/novelty message)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
(defn delete
|
||||
{:parameters {:path {:key [st/required st/string]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [key (get-in parameters [:path :key])
|
||||
message {:key key
|
||||
:type :delete-kvstore
|
||||
:user user}]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (constantly (rsp/no-content))))))
|
||||
|
||||
|
|
@ -1,167 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.pages
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[struct.core :as st]
|
||||
[promesa.core :as p]
|
||||
[uxbox.services :as sv]
|
||||
[uxbox.http.response :as rsp]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
;; --- Common Specs
|
||||
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::name string?)
|
||||
(s/def ::project ::us/uuid)
|
||||
(s/def ::version int?)
|
||||
(s/def ::data any?)
|
||||
(s/def ::metadata any?)
|
||||
|
||||
;; --- List Pages
|
||||
|
||||
(s/def ::list-pages|query
|
||||
(s/keys :req-un [::project]))
|
||||
|
||||
(defn list-pages
|
||||
{:parameters {:query ::list-pages|query}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters]}]
|
||||
(let [project (get-in parameters [:query :project])
|
||||
message {:user user :project project :type :list-pages-by-project}]
|
||||
(-> (sv/query message)
|
||||
(p/then rsp/ok))))
|
||||
|
||||
;; --- Create Page
|
||||
|
||||
(s/def ::create-page|body
|
||||
(s/keys :req-un [::data
|
||||
::metadata
|
||||
::project
|
||||
::name]
|
||||
:opt-un [::id]))
|
||||
|
||||
(defn create-page
|
||||
{:parameters {:body ::create-page|body}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data :user user :type :create-page)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (fn [result]
|
||||
(let [loc (str "/api/pages/" (:id result))]
|
||||
(rsp/created loc result)))))))
|
||||
|
||||
;; --- Update Page
|
||||
|
||||
(s/def ::update-page|path
|
||||
(s/keys :req-un [::id]))
|
||||
|
||||
(s/def ::update-page|body
|
||||
(s/keys :req-un [::data
|
||||
::metadata
|
||||
::project
|
||||
::name
|
||||
::version]
|
||||
:opt-un [::id]))
|
||||
|
||||
(defn update-page
|
||||
{:parameters {:path ::update-page|path
|
||||
:body ::update-page|body}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters]}]
|
||||
(let [id (get-in parameters [:path :id])
|
||||
data (get parameters :body)
|
||||
message (assoc data :id id :type :update-page :user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map #(rsp/ok %)))))
|
||||
|
||||
;; --- Update Page Metadata
|
||||
|
||||
(s/def ::update-page-metadata|path
|
||||
(s/keys :req-un [::id]))
|
||||
|
||||
(s/def ::update-page-metadata|body
|
||||
(s/keys :req-un [::id
|
||||
::metadata
|
||||
::project
|
||||
::name]))
|
||||
|
||||
(defn update-page-metadata
|
||||
{:parameters {:path ::update-page-metadata|path
|
||||
:body ::update-page-metadata|body}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters]}]
|
||||
(let [id (get-in parameters [:path :id])
|
||||
data (get parameters :body)
|
||||
message (assoc data :id id :type :update-page-metadata :user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
;; --- Delete Page
|
||||
|
||||
(s/def ::delete-page|path
|
||||
(s/keys :req-un [::id]))
|
||||
|
||||
(defn delete-page
|
||||
{:parameters {:path ::delete-page|path}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters]}]
|
||||
(let [id (get-in parameters [:path :id])
|
||||
message {:id id :type :delete-page :user user}]
|
||||
(-> (sv/novelty message)
|
||||
(p/then (constantly (rsp/no-content))))))
|
||||
|
||||
;; --- Retrieve Page History
|
||||
|
||||
(s/def ::max ::us/integer)
|
||||
(s/def ::since ::us/integer)
|
||||
(s/def ::pinned ::us/boolean)
|
||||
|
||||
(s/def ::retrieve-page-history|path
|
||||
(s/keys :req-un [::id]))
|
||||
|
||||
(s/def ::retrieve-page-history|query
|
||||
(s/keys :opt-un [::max
|
||||
::since
|
||||
::pinned]))
|
||||
|
||||
(defn retrieve-page-history
|
||||
"Retrieve the page history"
|
||||
{:parameters {:path ::retrieve-page-history|path
|
||||
:query ::retrieve-page-history|query}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters]}]
|
||||
(let [id (get-in parameters [:path :id])
|
||||
data (get parameters :query)
|
||||
message (assoc data :id id :type :list-page-history :user user)]
|
||||
(->> (sv/query message)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
;; --- Update page history
|
||||
|
||||
(s/def ::hid ::us/uuid)
|
||||
(s/def ::label string?)
|
||||
|
||||
(s/def ::update-page-history|path
|
||||
(s/keys :req-un [::id ::hid]))
|
||||
|
||||
(s/def ::update-page-history|body
|
||||
(s/keys :req-un [::label ::pinned]))
|
||||
|
||||
(defn update-page-history
|
||||
{:parameters {:path ::update-page-history|path
|
||||
:body ::update-page-history|body}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters]}]
|
||||
(let [{:keys [id hid]} (get parameters :path)
|
||||
message (assoc (get parameters :body)
|
||||
:type :update-page-history
|
||||
:id hid
|
||||
:user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map rsp/ok))))
|
|
@ -1,102 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.projects
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[struct.core :as st]
|
||||
[promesa.core :as p]
|
||||
[uxbox.services :as sv]
|
||||
[uxbox.http.response :as rsp]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[uxbox.util.exceptions :as ex]))
|
||||
|
||||
|
||||
;; --- Common Specs
|
||||
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::name string?)
|
||||
(s/def ::version int?)
|
||||
|
||||
;; --- List Projects
|
||||
|
||||
(defn list-projects
|
||||
{:description "List projects"}
|
||||
[{:keys [user] :as req}]
|
||||
(let [message {:user user :type :list-projects}]
|
||||
(->> (sv/query message)
|
||||
(p/map rsp/ok))))
|
||||
|
||||
;; --- Create Projects
|
||||
|
||||
(s/def ::create-project|body
|
||||
(s/keys :req-un [::name]
|
||||
:opt-un [::id]))
|
||||
|
||||
(defn create-project
|
||||
"Create project"
|
||||
{:parameters {:body ::create-project|body}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters] :as req}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data :type :create-project :user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map (fn [result]
|
||||
(let [loc (str "/api/projects/" (:id result))]
|
||||
(rsp/created loc result)))))))
|
||||
|
||||
;; --- Update Project
|
||||
|
||||
(s/def ::update-project|path
|
||||
(s/keys :req-un [::id]))
|
||||
|
||||
(s/def ::update-project|body
|
||||
(s/keys :req-un [::name ::version]))
|
||||
|
||||
(defn update-project
|
||||
"Update project"
|
||||
{:parameters {:path ::update-project|path
|
||||
:body ::update-project|body}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters] :as req}]
|
||||
(let [id (get-in parameters [:path :id])
|
||||
data (get parameters :body)
|
||||
message (assoc data :id id :type :update-project :user user)]
|
||||
(-> (sv/novelty message)
|
||||
(p/then rsp/ok))))
|
||||
|
||||
;; --- Delete Project
|
||||
|
||||
(s/def ::delete-project|path
|
||||
(s/keys :req-un [::id]))
|
||||
|
||||
(defn delete-project
|
||||
"Delete project"
|
||||
{:parameters {:path ::delete-project|path}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters] :as req}]
|
||||
(let [id (get-in parameters [:path :id])
|
||||
message {:id id :type :delete-project :user user}]
|
||||
(-> (sv/novelty message)
|
||||
(p/then (constantly (rsp/no-content))))))
|
||||
|
||||
;; --- Get Project by Share Token
|
||||
|
||||
(s/def ::token string?)
|
||||
|
||||
(s/def ::get-project-by-share-token|path
|
||||
(s/keys :req-un [::token]))
|
||||
|
||||
(defn get-project-by-share-token
|
||||
"Get a project by shared token"
|
||||
{:parameters {:path ::get-project-by-share-token|path}
|
||||
:validation :spec}
|
||||
[{:keys [user parameters] :as req}]
|
||||
(let [message {:token (get-in parameters [:path :token])
|
||||
:type :retrieve-project-by-share-token}]
|
||||
(->> (sv/query message)
|
||||
(p/map rsp/ok))))
|
|
@ -1,19 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.svg
|
||||
(:require [promesa.core :as p]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.services :as sv]
|
||||
[uxbox.util.http :as http]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(defn parse
|
||||
[{:keys [body] :as req}]
|
||||
(let [message {:data (slurp body)
|
||||
:type :parse-svg}]
|
||||
(->> (sv/query message)
|
||||
(p/map http/ok))))
|
|
@ -1,84 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.api.users
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[struct.core :as st]
|
||||
[promesa.core :as p]
|
||||
[datoteka.storages :as ds]
|
||||
[datoteka.core :as fs]
|
||||
[uxbox.services :as sv]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.images :as images]
|
||||
[uxbox.util.http :as http]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
;; --- Helpers
|
||||
|
||||
(defn- resolve-thumbnail
|
||||
[user]
|
||||
(let [opts {:src :photo
|
||||
:dst :photo
|
||||
:size [100 100]
|
||||
:quality 90
|
||||
:format "jpg"}]
|
||||
(images/populate-thumbnails user opts)))
|
||||
|
||||
(defn retrieve-profile
|
||||
[{:keys [user]}]
|
||||
(let [message {:user user :type :retrieve-profile}]
|
||||
(->> (sv/query message)
|
||||
(p/map resolve-thumbnail)
|
||||
(p/map #(http/ok %)))))
|
||||
|
||||
(defn update-profile
|
||||
{:parameters {:body {:username [st/required st/string]
|
||||
:email [st/required st/email]
|
||||
:fullname [st/required st/string]
|
||||
:metadata [st/required]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data
|
||||
:type :update-profile
|
||||
:user user)]
|
||||
(->> (sv/novelty message)
|
||||
(p/map resolve-thumbnail)
|
||||
(p/map #(http/ok %)))))
|
||||
|
||||
|
||||
(defn update-password
|
||||
{:parameters {:body {:password [st/required st/string]
|
||||
:old-password [st/required st/string]}}}
|
||||
[{:keys [user parameters]}]
|
||||
(let [data (get parameters :body)
|
||||
message (assoc data
|
||||
:type :update-profile-password
|
||||
:user user)]
|
||||
(-> (sv/novelty message)
|
||||
(p/then (fn [_] (http/no-content))))))
|
||||
|
||||
;; TODO: validate {:multipart {:file {:filename "sample.jpg", :content-type "application/octet-stream", :tempfile #file "/tmp/ring-multipart-7913603702731714635.tmp", :size 312043}}}
|
||||
|
||||
(defn update-photo
|
||||
{:parameters {:multipart {:file [st/required]}}}
|
||||
[{:keys [user parameters] :as ctx}]
|
||||
(letfn [(store-photo [{:keys [filename tempfile] :as upload}]
|
||||
(let [filename (fs/name filename)
|
||||
storage media/images-storage]
|
||||
(ds/save storage filename tempfile)))
|
||||
(assign-photo [path]
|
||||
(sv/novelty {:user user
|
||||
:path (str path)
|
||||
:type :update-profile-photo}))]
|
||||
(->> (get-in parameters [:multipart :file])
|
||||
(store-photo)
|
||||
(p/mapcat assign-photo)
|
||||
(p/map (constantly (http/no-content))))))
|
||||
|
||||
|
||||
|
||||
|
|
@ -1,224 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.cli.collimp
|
||||
"Collection importer command line helper."
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[clojure.pprint :refer [pprint]]
|
||||
[clojure.java.io :as io]
|
||||
[mount.core :as mount]
|
||||
[cuerdas.core :as str]
|
||||
[suricatta.core :as sc]
|
||||
[datoteka.storages :as st]
|
||||
[datoteka.core :as fs]
|
||||
[uxbox.config]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.migrations]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.cli.sql :as sql]
|
||||
[uxbox.services.svgparse :as svg]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.cli :as cli]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[uxbox.util.data :as data])
|
||||
(:import [java.io Reader PushbackReader]
|
||||
[org.im4java.core Info]))
|
||||
|
||||
;; --- Constants & Helpers
|
||||
|
||||
(def ^:const +images-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6e")
|
||||
(def ^:const +icons-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6f")
|
||||
|
||||
(s/def ::name string?)
|
||||
(s/def ::path string?)
|
||||
(s/def ::regex us/regex?)
|
||||
|
||||
(s/def ::import-entry
|
||||
(s/keys :req-un [::name ::path ::regex]))
|
||||
|
||||
(defn- pushback-reader
|
||||
[reader]
|
||||
(PushbackReader. ^Reader reader))
|
||||
|
||||
;; --- Icons Collections Importer
|
||||
|
||||
(defn- create-icons-collection
|
||||
"Create or replace image collection by its name."
|
||||
[conn {:keys [name] :as entry}]
|
||||
(println "Creating or updating icons collection:" name)
|
||||
(let [id (uuid/namespaced +icons-uuid-ns+ name)
|
||||
sqlv (sql/create-icons-collection {:id id :name name})]
|
||||
(sc/execute conn sqlv)
|
||||
id))
|
||||
|
||||
(defn- retrieve-icon
|
||||
[conn id]
|
||||
{:pre [(uuid? id)]}
|
||||
(let [sqlv (sql/get-icon {:id id})]
|
||||
(some->> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
|
||||
(defn- create-icon
|
||||
[conn collid iconid localpath]
|
||||
{:pre [(fs/path? localpath)
|
||||
(uuid? collid)
|
||||
(uuid? iconid)]}
|
||||
(let [filename (fs/name localpath)
|
||||
extension (second (fs/split-ext filename))
|
||||
data (svg/parse localpath)
|
||||
params {:name (:name data filename)
|
||||
:content (:content data)
|
||||
:metadata (-> {:width (:width data)
|
||||
:height (:height data)
|
||||
:view-box (:view-box data)}
|
||||
t/encode blob/encode)
|
||||
:collection collid
|
||||
:id iconid}
|
||||
sqlv (sql/create-icon params)]
|
||||
(sc/execute conn sqlv)))
|
||||
|
||||
(defn- import-icon
|
||||
[conn id fpath]
|
||||
{:pre [(uuid? id) (fs/path? fpath)]}
|
||||
(let [filename (fs/name fpath)
|
||||
iconid (uuid/namespaced +icons-uuid-ns+ (str id filename))]
|
||||
(when-not (retrieve-icon conn iconid)
|
||||
(println "Importing icon:" (str fpath))
|
||||
(create-icon conn id iconid fpath))))
|
||||
|
||||
(defn- process-icons-entry
|
||||
[conn basedir {:keys [path regex] :as entry}]
|
||||
{:pre [(us/valid? ::import-entry entry)]}
|
||||
(let [id (create-icons-collection conn entry)
|
||||
path (fs/join basedir path)]
|
||||
(doseq [fpath (->> (fs/list-dir path)
|
||||
(filter fs/regular-file?))]
|
||||
(when (re-matches regex (str fpath))
|
||||
(import-icon conn id fpath)))))
|
||||
|
||||
;; --- Images Collections Importer
|
||||
|
||||
(defn- create-images-collection
|
||||
"Create or replace image collection by its name."
|
||||
[conn {:keys [name] :as entry}]
|
||||
(println "Creating or updating image collection:" name)
|
||||
(let [id (uuid/namespaced +images-uuid-ns+ name)
|
||||
sqlv (sql/create-images-collection {:id id :name name})]
|
||||
(sc/execute conn sqlv)
|
||||
id))
|
||||
|
||||
(defn- retrieve-image-size
|
||||
[path]
|
||||
(let [info (Info. (str path) true)]
|
||||
[(.getImageWidth info) (.getImageHeight info)]))
|
||||
|
||||
(defn- retrieve-image
|
||||
[conn id]
|
||||
{:pre [(uuid? id)]}
|
||||
(let [sqlv (sql/get-image {:id id})]
|
||||
(some->> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
|
||||
(defn- delete-image
|
||||
[conn {:keys [id path] :as image}]
|
||||
{:pre [(uuid? id)
|
||||
(fs/path? path)]}
|
||||
(let [sqlv (sql/delete-image {:id id})
|
||||
storage media/images-storage]
|
||||
@(st/delete storage path)
|
||||
(sc/execute conn sqlv)))
|
||||
|
||||
(defn- create-image
|
||||
[conn collid imageid localpath]
|
||||
{:pre [(fs/path? localpath)
|
||||
(uuid? collid)
|
||||
(uuid? imageid)]}
|
||||
(let [filename (fs/name localpath)
|
||||
storage media/images-storage
|
||||
[width height] (retrieve-image-size localpath)
|
||||
extension (second (fs/split-ext filename))
|
||||
path @(st/save storage filename localpath)
|
||||
params {:name filename
|
||||
:path (str path)
|
||||
:mimetype (case extension
|
||||
".jpg" "image/jpeg"
|
||||
".png" "image/png")
|
||||
:width width
|
||||
:height height
|
||||
:collection collid
|
||||
:id imageid}
|
||||
sqlv (sql/create-image params)]
|
||||
(sc/execute conn sqlv)))
|
||||
|
||||
(defn- import-image
|
||||
[conn id fpath]
|
||||
{:pre [(uuid? id) (fs/path? fpath)]}
|
||||
(let [filename (fs/name fpath)
|
||||
imageid (uuid/namespaced +images-uuid-ns+ (str id filename))]
|
||||
(when-not (retrieve-image conn imageid)
|
||||
(println "Importing image:" (str fpath))
|
||||
(create-image conn id imageid fpath))))
|
||||
|
||||
(defn- process-images-entry
|
||||
[conn basedir {:keys [path regex] :as entry}]
|
||||
{:pre [(us/valid? ::import-entry entry)]}
|
||||
(let [id (create-images-collection conn entry)
|
||||
path (fs/join basedir path)]
|
||||
(doseq [fpath (->> (fs/list-dir path)
|
||||
(filter fs/regular-file?))]
|
||||
(when (re-matches regex (str fpath))
|
||||
(import-image conn id fpath)))))
|
||||
|
||||
;; --- Entry Point
|
||||
|
||||
(defn- check-path!
|
||||
[path]
|
||||
(when-not path
|
||||
(cli/print-err! "No path is provided.")
|
||||
(cli/exit! -1))
|
||||
(when-not (fs/exists? path)
|
||||
(cli/print-err! "Path does not exists.")
|
||||
(cli/exit! -1))
|
||||
(when (fs/directory? path)
|
||||
(cli/print-err! "The provided path is a directory.")
|
||||
(cli/exit! -1))
|
||||
(fs/path path))
|
||||
|
||||
(defn- read-import-file
|
||||
[path]
|
||||
(let [path (check-path! path)
|
||||
parent (fs/parent path)
|
||||
reader (pushback-reader (io/reader path))]
|
||||
[parent (read reader)]))
|
||||
|
||||
(defn- start-system
|
||||
[]
|
||||
(-> (mount/except #{#'uxbox.http/server})
|
||||
(mount/start)))
|
||||
|
||||
(defn- stop-system
|
||||
[]
|
||||
(mount/stop))
|
||||
|
||||
(defn- run-importer
|
||||
[conn basedir data]
|
||||
(let [images (:images data)
|
||||
icons (:icons data)]
|
||||
(run! #(process-images-entry conn basedir %) images)
|
||||
(run! #(process-icons-entry conn basedir %) icons)
|
||||
#_(throw (ex-info "" {}))))
|
||||
|
||||
(defn -main
|
||||
[& [path]]
|
||||
(let [[basedir data] (read-import-file path)]
|
||||
(start-system)
|
||||
(try
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn run-importer basedir data))
|
||||
(finally
|
||||
(stop-system)))))
|
|
@ -1,4 +0,0 @@
|
|||
(ns uxbox.cli.sql
|
||||
(:require [hugsql.core :as hugsql]))
|
||||
|
||||
(hugsql/def-sqlvec-fns "sql/cli.sql" {:quoting :ansi :fn-suffix ""})
|
|
@ -38,7 +38,7 @@
|
|||
:http-server-cors (lookup-env env :uxbox-http-server-cors "http://localhost:3449")
|
||||
:database-username (lookup-env env :uxbox-database-username nil)
|
||||
:database-password (lookup-env env :uxbox-database-password nil)
|
||||
:database-uri (lookup-env env :uxbox-database-uri "jdbc:postgresql://127.0.0.1/uxbox")
|
||||
:database-uri (lookup-env env :uxbox-database-uri "postgresql://127.0.0.1/uxbox")
|
||||
:media-directory (lookup-env env :uxbox-media-directory "resources/public/media")
|
||||
:media-uri (lookup-env env :uxbox-media-uri "http://localhost:6060/media/")
|
||||
:assets-directory (lookup-env env :uxbox-assets-directory "resources/public/static")
|
||||
|
@ -54,15 +54,13 @@
|
|||
:smtp-tls (lookup-env env :uxbox-smtp-tls false)
|
||||
:smtp-ssl (lookup-env env :uxbox-smtp-ssl false)
|
||||
:smtp-enabled (lookup-env env :uxbox-smtp-enabled false)
|
||||
|
||||
:registration-enabled (lookup-env env :uxbox-registration-enabled true)
|
||||
|
||||
:secret (lookup-env env :uxbox-secret "5qjiAndGY3")})
|
||||
|
||||
(defn read-test-config
|
||||
[]
|
||||
(assoc (read-config)
|
||||
:database-name "test"
|
||||
:database-uri "postgresql://postgres/test"
|
||||
:media-directory "/tmp/uxbox/media"
|
||||
:assets-directory "/tmp/uxbox/static"
|
||||
:migrations-verbose false))
|
||||
|
|
16
backend/src/uxbox/core.clj
Normal file
16
backend/src/uxbox/core.clj
Normal file
|
@ -0,0 +1,16 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.core
|
||||
(:require
|
||||
[vertx.core :as vx]
|
||||
[mount.core :as mount :refer [defstate]]))
|
||||
|
||||
(defstate system
|
||||
:start (vx/system)
|
||||
:stop (.close system))
|
||||
|
||||
|
|
@ -2,91 +2,48 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.db
|
||||
"Database access layer for UXBOX."
|
||||
(:require
|
||||
[executors.core :as exec]
|
||||
[hikari-cp.core :as hikari]
|
||||
[mount.core :as mount :refer (defstate)]
|
||||
[clojure.tools.logging :as log]
|
||||
[lambdaisland.uri :refer [uri]]
|
||||
[mount.core :as mount :refer [defstate]]
|
||||
[promesa.core :as p]
|
||||
[suricatta.core :as sc]
|
||||
[suricatta.impl :as si]
|
||||
[suricatta.proto :as sp]
|
||||
[uxbox.config :as cfg])
|
||||
(:import
|
||||
org.jooq.Configuration
|
||||
org.jooq.TransactionContext
|
||||
org.jooq.TransactionProvider
|
||||
))
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.core :refer [system]]
|
||||
[uxbox.util.data :as data]
|
||||
[uxbox.util.pgsql :as pg]
|
||||
[vertx.core :as vx])
|
||||
(:import io.vertx.core.buffer.Buffer))
|
||||
|
||||
;; --- State
|
||||
(defn- create-pool
|
||||
[config system]
|
||||
(let [dburi (:database-uri config)
|
||||
username (:database-username config)
|
||||
password (:database-password config)
|
||||
dburi (-> (uri dburi)
|
||||
(assoc :user username)
|
||||
(assoc :password password)
|
||||
(str))]
|
||||
(log/info "creating connection pool with" dburi)
|
||||
(pg/tl-pool dburi {:system system})))
|
||||
|
||||
(def connection-defaults
|
||||
{:connection-timeout 30000
|
||||
:idle-timeout 600000
|
||||
:max-lifetime 1800000
|
||||
:minimum-idle 10
|
||||
:maximum-pool-size 10})
|
||||
(defstate pool
|
||||
:start (create-pool cfg/config system))
|
||||
|
||||
(defn get-db-config
|
||||
[config]
|
||||
(assoc connection-defaults
|
||||
:username (:database-username config)
|
||||
:password (:database-password config)
|
||||
:jdbc-url (:database-uri config)))
|
||||
|
||||
(defn create-datasource
|
||||
[config]
|
||||
(let [dbconf (get-db-config config)]
|
||||
(hikari/make-datasource dbconf)))
|
||||
|
||||
(defstate datasource
|
||||
:start (create-datasource cfg/config)
|
||||
:stop (hikari/close-datasource datasource))
|
||||
|
||||
;; --- Suricatta Async Adapter
|
||||
|
||||
(defn transaction
|
||||
"Asynchronous transaction handling."
|
||||
{:internal true}
|
||||
[ctx func]
|
||||
(let [^Configuration conf (.derive (sp/-config ctx))
|
||||
^TransactionContext txctx (si/transaction-context conf)
|
||||
^TransactionProvider provider (.transactionProvider conf)]
|
||||
(doto conf
|
||||
(.data "suricatta.rollback" false)
|
||||
(.data "suricatta.transaction" true))
|
||||
(try
|
||||
(.begin provider txctx)
|
||||
(->> (func (si/make-context conf))
|
||||
(p/map (fn [result]
|
||||
(if (.data conf "suricatta.rollback")
|
||||
(.rollback provider txctx)
|
||||
(.commit provider txctx))
|
||||
result))
|
||||
(p/error (fn [error]
|
||||
(.rollback provider (.cause txctx error))
|
||||
(p/rejected error))))
|
||||
(catch Exception cause
|
||||
(.rollback provider (.cause txctx cause))
|
||||
(p/rejected cause)))))
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(defmacro atomic
|
||||
[ctx & body]
|
||||
`(transaction ~ctx (fn [~ctx] ~@body)))
|
||||
|
||||
(defn connection
|
||||
[]
|
||||
(sc/context datasource))
|
||||
|
||||
(defn fetch
|
||||
(defmacro with-atomic
|
||||
[& args]
|
||||
(exec/submit #(apply sc/fetch args)))
|
||||
`(pg/with-atomic ~@args))
|
||||
|
||||
(defn execute
|
||||
(def row-xfm
|
||||
(comp (map pg/row->map)
|
||||
(map data/normalize-attrs)))
|
||||
|
||||
(defmacro query
|
||||
[& args]
|
||||
(exec/submit #(apply sc/execute args)))
|
||||
`(pg/query ~@args {:xfm row-xfm}))
|
||||
|
||||
(defmacro query-one
|
||||
[& args]
|
||||
`(pg/query-one ~@args {:xfm row-xfm}))
|
||||
|
|
|
@ -2,13 +2,48 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.emails
|
||||
"Main api for send emails."
|
||||
(:require [uxbox.emails.core :as core]))
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.emails :as emails]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.spec :as us]))
|
||||
|
||||
(def send! core/send!)
|
||||
(def render core/render)
|
||||
(def default-context
|
||||
{:static media/resolve-asset
|
||||
:comment (constantly nil)})
|
||||
|
||||
(load "emails/users")
|
||||
(def register
|
||||
"A new profile registration welcome email."
|
||||
(emails/build :register default-context))
|
||||
|
||||
;; (defn render
|
||||
;; [email context]
|
||||
;; (let [defaults {:from (:email-from cfg/config)
|
||||
;; :reply-to (:email-reply-to cfg/config)}]
|
||||
;; (->> (email context)
|
||||
;; (merge defaults))))
|
||||
|
||||
(defn send!
|
||||
"Schedule the email for sending."
|
||||
[email context]
|
||||
(s/assert fn? email)
|
||||
(s/assert map? context)
|
||||
(let [defaults {:from (:email-from cfg/config)
|
||||
:reply-to (:email-reply-to cfg/config)}
|
||||
data (->> (email context)
|
||||
(merge defaults)
|
||||
(blob/encode))
|
||||
priority (case (::priority context) :low 1 :high 10)
|
||||
sql "insert into email_queue (data, priority)
|
||||
values ($1, $2) returning *"]
|
||||
(-> (db/query-one db/pool [sql data priority])
|
||||
(p/then' (constantly nil)))))
|
||||
|
|
|
@ -1,88 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.emails.core
|
||||
(:require [hiccup.core :refer [html]]
|
||||
[hiccup.page :refer [html4]]
|
||||
[suricatta.core :as sc]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.emails.layouts :as layouts]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.transit :as t]))
|
||||
|
||||
(def emails
|
||||
"A global state for registring emails."
|
||||
(atom {}))
|
||||
|
||||
(defmacro defemail
|
||||
[type & args]
|
||||
(let [email (apply hash-map args)]
|
||||
`(do
|
||||
(swap! emails assoc ~type ~email)
|
||||
nil)))
|
||||
|
||||
(defn- render-subject
|
||||
[{:keys [subject]} context]
|
||||
(cond
|
||||
(delay? subject) (deref subject)
|
||||
(ifn? subject) (subject context)
|
||||
(string? subject) subject
|
||||
:else (throw (ex-info "Invalid subject." {}))))
|
||||
|
||||
(defn- render-body
|
||||
[[type bodyfn] layout context]
|
||||
(let [layoutfn (get layout type)]
|
||||
{:content (cond-> (bodyfn context)
|
||||
layoutfn (layoutfn context)
|
||||
(= type :text/html) (html4))
|
||||
::type type
|
||||
:type (subs (str type) 1)}))
|
||||
|
||||
(defn- render-body-alternatives
|
||||
[{:keys [layout body] :as email} context]
|
||||
(reduce #(conj %1 (render-body %2 layout context)) [:alternatives] body))
|
||||
|
||||
(defn render-email
|
||||
[email context]
|
||||
(let [from (or (:email/from context)
|
||||
(:email-from cfg/config))
|
||||
reply-to (or (:email/reply-to context)
|
||||
(:email-reply-to cfg/config)
|
||||
from)]
|
||||
{:subject (render-subject email context)
|
||||
:body (render-body-alternatives email context)
|
||||
:to (:email/to context)
|
||||
:from from
|
||||
:reply-to reply-to}))
|
||||
|
||||
(def valid-priority? #{:high :low})
|
||||
(def valid-email-identifier? #(contains? @emails %))
|
||||
|
||||
(defn render
|
||||
"Render a email as data structure."
|
||||
[{name :email/name :as context}]
|
||||
{:pre [(valid-email-identifier? name)]}
|
||||
(let [email (get @emails name)]
|
||||
(render-email email context)))
|
||||
|
||||
(defn send!
|
||||
"Schedule the email for sending."
|
||||
[{name :email/name
|
||||
priority :email/priority
|
||||
:or {priority :high}
|
||||
:as context}]
|
||||
{:pre [(valid-priority? priority)
|
||||
(valid-email-identifier? name)]}
|
||||
(let [email (get @emails name)
|
||||
email (render-email email context)
|
||||
data (-> email t/encode blob/encode)
|
||||
priority (case priority :low 1 :high 10)
|
||||
sqlv (sql/insert-email {:data data :priority priority})]
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/atomic conn
|
||||
(sc/execute conn sqlv)))))
|
|
@ -1,228 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.emails.layouts
|
||||
(:require [uxbox.media :as md]))
|
||||
|
||||
(def default-embedded-styles
|
||||
"/* GLOBAL */
|
||||
* {
|
||||
margin:0;
|
||||
padding:0;
|
||||
font-family: Arial, sans-serif;
|
||||
font-size: 100%;
|
||||
line-height: 1.6;
|
||||
}
|
||||
|
||||
img {
|
||||
max-width: 100%;
|
||||
width: 100%;
|
||||
}
|
||||
|
||||
.img-header {
|
||||
border-top-left-radius: 5px;
|
||||
border-top-right-radius: 5px;
|
||||
}
|
||||
|
||||
body {
|
||||
-webkit-font-smoothing:antialiased;
|
||||
-webkit-text-size-adjust:none;
|
||||
width: 100%!important;
|
||||
height: 100%;
|
||||
}
|
||||
|
||||
/* ELEMENTS */
|
||||
a {
|
||||
color: #78dbbe;
|
||||
text-decoration:none;
|
||||
font-weight: bold;
|
||||
}
|
||||
|
||||
.btn-primary {
|
||||
text-decoration:none;
|
||||
color: #fff;
|
||||
background-color: #78dbbe;
|
||||
padding: 10px 30px;
|
||||
font-weight: bold;
|
||||
margin: 20px 0;
|
||||
text-align: center;
|
||||
cursor: pointer;
|
||||
display: inline-block;
|
||||
border-radius: 4px;
|
||||
}
|
||||
|
||||
.btn-primary:hover {
|
||||
color: #FFF;
|
||||
background-color: #8eefcf;
|
||||
}
|
||||
|
||||
.last {
|
||||
margin-bottom: 0;
|
||||
}
|
||||
|
||||
.first{
|
||||
margin-top: 0;
|
||||
}
|
||||
|
||||
.logo {
|
||||
background-color: #f6f6f6;
|
||||
padding: 10px;
|
||||
text-align: center;
|
||||
padding-bottom: 25px;
|
||||
}
|
||||
.logo h2 {
|
||||
color: #777;
|
||||
font-size: 20px;
|
||||
font-weight: bold;
|
||||
margin-top: 15px;
|
||||
}
|
||||
.logo img {
|
||||
max-width: 150px;
|
||||
}
|
||||
|
||||
/* BODY */
|
||||
table.body-wrap {
|
||||
width: 100%;
|
||||
padding: 20px;
|
||||
}
|
||||
|
||||
table.body-wrap .container{
|
||||
border-radius: 5px;
|
||||
color: #ababab;
|
||||
}
|
||||
|
||||
|
||||
/* FOOTER */
|
||||
table.footer-wrap {
|
||||
width: 100%;
|
||||
clear:both!important;
|
||||
}
|
||||
|
||||
.footer-wrap .container p {
|
||||
font-size: 12px;
|
||||
color:#666;
|
||||
|
||||
}
|
||||
|
||||
table.footer-wrap a{
|
||||
color: #999;
|
||||
}
|
||||
|
||||
|
||||
/* TYPOGRAPHY */
|
||||
h1,h2,h3{
|
||||
font-family: Arial, sans-serif;
|
||||
line-height: 1.1;
|
||||
margin-bottom:15px;
|
||||
color:#000;
|
||||
margin: 40px 0 10px;
|
||||
line-height: 1.2;
|
||||
font-weight:200;
|
||||
}
|
||||
|
||||
h1 {
|
||||
color: #777;
|
||||
font-size: 28px;
|
||||
font-weight: bold;
|
||||
}
|
||||
h2 {
|
||||
font-size: 24px;
|
||||
}
|
||||
h3 {
|
||||
font-size: 18px;
|
||||
}
|
||||
|
||||
p, ul {
|
||||
margin-bottom: 10px;
|
||||
font-weight: normal;
|
||||
}
|
||||
|
||||
ul li {
|
||||
margin-left:5px;
|
||||
list-style-position: inside;
|
||||
}
|
||||
|
||||
/* RESPONSIVE */
|
||||
|
||||
/* Set a max-width, and make it display as block so it will automatically stretch to that width, but will also shrink down on a phone or something */
|
||||
.container {
|
||||
display: block !important;
|
||||
max-width: 620px !important;
|
||||
margin: 0 auto !important; /* makes it centered */
|
||||
clear: both !important;
|
||||
}
|
||||
|
||||
/* This should also be a block element, so that it will fill 100% of the .container */
|
||||
.content {
|
||||
padding: 20px;
|
||||
max-width: 620px;
|
||||
margin: 0 auto;
|
||||
display: block;
|
||||
}
|
||||
|
||||
/* Let's make sure tables in the content area are 100% wide */
|
||||
.content table {
|
||||
width: 100%;
|
||||
}")
|
||||
|
||||
(defn- default-html
|
||||
[body context]
|
||||
[:html
|
||||
[:head
|
||||
[:meta {:http-equiv "Content-Type"
|
||||
:content "text/html; charset=UTF-8"}]
|
||||
[:meta {:name "viewport"
|
||||
:content "width=device-width"}]
|
||||
[:title "title"]
|
||||
[:style default-embedded-styles]]
|
||||
[:body {:bgcolor "#f6f6f6"
|
||||
:cz-shortcut-listen "true"}
|
||||
[:table.body-wrap
|
||||
[:tbody
|
||||
[:tr
|
||||
[:td]
|
||||
[:td.container {:bgcolor "#FFFFFF"}
|
||||
[:div.logo
|
||||
[:img {:src (md/resolve-asset "images/email/logo.png")
|
||||
:alt "UXBOX"}]]
|
||||
body]
|
||||
[:td]]]]
|
||||
[:table.footer-wrap
|
||||
[:tbody
|
||||
[:tr
|
||||
[:td]
|
||||
[:td.container
|
||||
[:div.content
|
||||
[:table
|
||||
[:tbody
|
||||
[:tr
|
||||
[:td
|
||||
[:div {:style "text-align: center;"}
|
||||
[:a {:href "#" :target "_blank"}
|
||||
[:img {:style "display: inline-block; width: 25px; margin-right: 5px;"
|
||||
:src (md/resolve-asset "images/email/twitter.png")}]]
|
||||
[:a {:href "#" :target "_blank"}
|
||||
[:img {:style "display: inline-block; width: 25px; margin-right: 5px;"
|
||||
:src (md/resolve-asset "images/email/github.png")}]]
|
||||
[:a {:href "#" :target "_blank"}
|
||||
[:img {:style "display: inline-block; width: 25px; margin-right: 5px;"
|
||||
:src (md/resolve-asset "images/email/linkedin.png")}]]]]]
|
||||
[:tr
|
||||
[:td {:align "center"}
|
||||
[:p
|
||||
[:span "Sent from UXBOX | "]
|
||||
[:a {:href "#" :target "_blank"}
|
||||
[:unsubscribe "Email preferences"]]]]]]]]]
|
||||
[:td]]]]]])
|
||||
|
||||
(defn default-text
|
||||
[body context]
|
||||
body)
|
||||
|
||||
(def default
|
||||
"Default layout instance."
|
||||
{:text/html default-html
|
||||
:text/plain default-text})
|
|
@ -1,77 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.emails.users
|
||||
(:require [uxbox.media :as md]
|
||||
[uxbox.emails.core :refer (defemail)]
|
||||
[uxbox.emails.layouts :as layouts]))
|
||||
|
||||
;; --- User Register
|
||||
|
||||
(defn- register-body-html
|
||||
[{:keys [name] :as ctx}]
|
||||
[:div
|
||||
[:img.img-header {:src (md/resolve-asset "images/email/img-header.jpg")
|
||||
:alt "UXBOX"}]
|
||||
[:div.content
|
||||
[:table
|
||||
[:tbody
|
||||
[:tr
|
||||
[:td
|
||||
[:h1 "Hi " name]
|
||||
[:p "Welcome to uxbox."]
|
||||
[:p
|
||||
[:a.btn-primary {:href "#"} "Sign in"]]
|
||||
[:p "Sincerely," [:br] [:strong "The UXBOX Team"]]
|
||||
#_[:p "P.S. Having trouble signing up? please contact "
|
||||
[:a {:href "#"} "Support email"]]]]]]]])
|
||||
|
||||
(defn- register-body-text
|
||||
[{:keys [name] :as ctx}]
|
||||
(str "Hi " name "\n\n"
|
||||
"Welcome to uxbox!\n\n"
|
||||
"Sincerely, the UXBOX team.\n"))
|
||||
|
||||
(defemail :users/register
|
||||
:layout layouts/default
|
||||
:subject "UXBOX: Welcome!"
|
||||
:body {:text/html register-body-html
|
||||
:text/plain register-body-text})
|
||||
|
||||
;; --- Password Recovery
|
||||
|
||||
(defn- password-recovery-body-html
|
||||
[{:keys [name token] :as ctx}]
|
||||
[:div
|
||||
[:img.img-header {:src (md/resolve-asset "images/img-header.jpg")
|
||||
:alt "UXBOX"}]
|
||||
[:div.content
|
||||
[:table
|
||||
[:tbody
|
||||
[:tr
|
||||
[:td
|
||||
[:h1 "Hi " name]
|
||||
[:p "A password recovery is requested."]
|
||||
[:p
|
||||
"Please, follow the following url in order to"
|
||||
"change your password."
|
||||
[:a {:href "#"} "http://uxbox.io/..."]]
|
||||
[:p "Sincerely," [:br] [:strong "The UXBOX Team"]]]]]]]])
|
||||
|
||||
(defn- password-recovery-body-text
|
||||
[{:keys [name token] :as ctx}]
|
||||
(str "Hi " name "\n\n"
|
||||
"A password recovery is requested.\n\n"
|
||||
"Please follow the following url in order to change the password:\n\n"
|
||||
" http://uxbox.io/recovery/" token "\n\n\n"
|
||||
"Sincerely, the UXBOX team.\n"))
|
||||
|
||||
(defemail :users/password-recovery
|
||||
:layout layouts/default
|
||||
:subject "Password recovery requested."
|
||||
:body {:text/html password-recovery-body-html
|
||||
:text/plain password-recovery-body-text})
|
||||
|
|
@ -2,101 +2,112 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.fixtures
|
||||
"A initial fixtures."
|
||||
(:require
|
||||
[buddy.core.codecs :as codecs]
|
||||
[buddy.hashers :as hashers]
|
||||
[clj-uuid :as uuid]
|
||||
[mount.core :as mount]
|
||||
[suricatta.core :as sc]
|
||||
[promesa.core :as p]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.core]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.migrations]
|
||||
[uxbox.services.pages :as spag]
|
||||
[uxbox.services.projects :as sproj]
|
||||
[uxbox.services.users :as susers]
|
||||
[uxbox.util.transit :as t]))
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(defn- mk-uuid
|
||||
[prefix & args]
|
||||
(uuid/v5 uuid/+namespace-oid+ (apply str prefix args)))
|
||||
(uuid/namespaced uuid/oid (apply str prefix args)))
|
||||
|
||||
(defn- data-encode
|
||||
[data]
|
||||
(-> (t/encode data)
|
||||
(codecs/bytes->str)))
|
||||
;; --- Users creation
|
||||
|
||||
(defn- create-user
|
||||
(def create-user-sql
|
||||
"insert into users (id, fullname, username, email, password, metadata, photo)
|
||||
values ($1, $2, $3, $4, $5, $6, $7)
|
||||
returning *;")
|
||||
|
||||
(defn create-user
|
||||
[conn i]
|
||||
(println "create user" i)
|
||||
(susers/create-user conn
|
||||
{:username (str "user" i)
|
||||
:id (mk-uuid "user" i)
|
||||
:fullname (str "User " i)
|
||||
:metadata {}
|
||||
:password "123123"
|
||||
:email (str "user" i ".test@uxbox.io")}))
|
||||
(db/query-one conn [create-user-sql
|
||||
(mk-uuid "user" i)
|
||||
(str "User " i)
|
||||
(str "user" i)
|
||||
(str "user" i ".test@uxbox.io")
|
||||
(hashers/encrypt "123123")
|
||||
(blob/encode {})
|
||||
""]))
|
||||
|
||||
(defn- create-project
|
||||
[conn i ui]
|
||||
;; (Thread/sleep 20)
|
||||
(println "create project" i "for user" ui)
|
||||
(sproj/create-project conn
|
||||
{:id (mk-uuid "project" i)
|
||||
:user (mk-uuid "user" ui)
|
||||
:name (str "project " i)}))
|
||||
;; --- Projects creation
|
||||
|
||||
(defn- create-page
|
||||
[conn i pi ui]
|
||||
;; (Thread/sleep 1)
|
||||
(println "create page" i "for user" ui "for project" pi)
|
||||
(spag/create-page conn
|
||||
{:id (mk-uuid "page" i)
|
||||
:user (mk-uuid "user" ui)
|
||||
:project (mk-uuid "project" pi)
|
||||
:data {:shapes [{:id (mk-uuid "canvas" i 1)
|
||||
:name "Canvas-1"
|
||||
:type :canvas
|
||||
:page (mk-uuid "page" i)
|
||||
:x1 200
|
||||
:y1 200
|
||||
:x2 1224
|
||||
:y2 968}]}
|
||||
:metadata {:width 1024
|
||||
:height 768
|
||||
:layout "tablet"}
|
||||
:name (str "page " i)}))
|
||||
(def create-project-sql
|
||||
"insert into projects (id, user_id, name)
|
||||
values ($1, $2, $3)
|
||||
returning *;")
|
||||
|
||||
(def num-users 50)
|
||||
(defn create-project
|
||||
[conn [pjid uid]]
|
||||
(println "create project" pjid "(for user=" uid ")")
|
||||
(db/query-one conn [create-project-sql
|
||||
(mk-uuid "project" pjid uid)
|
||||
(mk-uuid "user" uid)
|
||||
(str "sample project " pjid)]))
|
||||
|
||||
;; --- Pages creation
|
||||
|
||||
(def create-page-sql
|
||||
"insert into pages (id, user_id, project_id, name, data, metadata)
|
||||
values ($1, $2, $3, $4, $5, $6)
|
||||
returning *;")
|
||||
|
||||
(defn create-page
|
||||
[conn [pjid paid uid]]
|
||||
(println "create page" paid "(for project=" pjid ", user=" uid ")")
|
||||
(let [data {:shapes [{:id (mk-uuid "canvas" 1)
|
||||
:name "Canvas-1"
|
||||
:type :canvas
|
||||
:page (mk-uuid "page" pjid paid uid)
|
||||
:x1 200
|
||||
:y1 200
|
||||
:x2 1224
|
||||
:y2 968}]}]
|
||||
(db/query-one conn [create-page-sql
|
||||
(mk-uuid "page" pjid paid uid)
|
||||
(mk-uuid "user" uid)
|
||||
(mk-uuid "project" pjid uid)
|
||||
(str "page " paid)
|
||||
(blob/encode data)
|
||||
(blob/encode {})])))
|
||||
|
||||
|
||||
(def num-users 5)
|
||||
(def num-projects 5)
|
||||
(def num-pages 5)
|
||||
|
||||
(defn -main
|
||||
[& args]
|
||||
(-> (mount/only #{#'uxbox.config/config
|
||||
#'uxbox.config/secret
|
||||
#'uxbox.db/datasource
|
||||
#'uxbox.migrations/migrations
|
||||
#'uxbox.media/assets-storage
|
||||
#'uxbox.media/media-storage
|
||||
#'uxbox.media/images-storage
|
||||
#'uxbox.media/thumbnails-storage})
|
||||
(mount/start))
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/atomic conn
|
||||
(doseq [i (range num-users)]
|
||||
(create-user conn i))
|
||||
|
||||
(doseq [ui (range num-users)]
|
||||
(doseq [i (range num-projects)]
|
||||
(create-project conn (str ui i) ui)))
|
||||
|
||||
(doseq [pi (range num-projects)]
|
||||
(doseq [ui (range num-users)]
|
||||
(doseq [i (range num-pages)]
|
||||
(create-page conn (str pi ui i) (str ui pi) ui))))))
|
||||
(mount/stop))
|
||||
(try
|
||||
(-> (mount/only #{#'uxbox.config/config
|
||||
#'uxbox.config/secret
|
||||
#'uxbox.core/system
|
||||
#'uxbox.db/pool
|
||||
#'uxbox.migrations/migrations})
|
||||
(mount/start))
|
||||
@(db/with-atomic [conn db/pool]
|
||||
(p/do!
|
||||
(p/run! #(create-user conn %) (range num-users))
|
||||
(p/run! #(create-project conn %)
|
||||
(for [uid (range num-users)
|
||||
pjid (range num-projects)]
|
||||
[pjid uid]))
|
||||
(p/run! #(create-page conn %)
|
||||
(for [pjid(range num-projects)
|
||||
paid (range num-pages)
|
||||
uid (range num-users)]
|
||||
[pjid paid uid]))
|
||||
(p/promise 1)))
|
||||
(finally
|
||||
(mount/stop))))
|
||||
|
|
|
@ -5,115 +5,67 @@
|
|||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http
|
||||
(:require [mount.core :refer [defstate]]
|
||||
[ring.adapter.jetty :as jetty]
|
||||
[reitit.ring :as rr]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.http.middleware :refer [handler
|
||||
middleware
|
||||
options-handler
|
||||
authorization-middleware]]
|
||||
[uxbox.api.auth :as api-auth]
|
||||
[uxbox.api.pages :as api-pages]
|
||||
[uxbox.api.users :as api-users]
|
||||
[uxbox.api.icons :as api-icons]
|
||||
[uxbox.api.images :as api-images]
|
||||
[uxbox.api.kvstore :as api-kvstore]
|
||||
[uxbox.api.projects :as api-projects]
|
||||
[uxbox.api.svg :as api-svg]
|
||||
[uxbox.util.transit :as t]))
|
||||
(:require
|
||||
[clojure.tools.logging :as log]
|
||||
[mount.core :as mount :refer [defstate]]
|
||||
[promesa.core :as p]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.core :refer [system]]
|
||||
[uxbox.http.errors :as errors]
|
||||
[uxbox.http.interceptors :as interceptors]
|
||||
[uxbox.http.session :as session]
|
||||
[uxbox.http.handlers :as handlers]
|
||||
[uxbox.http.debug :as debug]
|
||||
[uxbox.services.core :as sv]
|
||||
[vertx.core :as vc]
|
||||
[vertx.http :as vh]
|
||||
[vertx.web :as vw]
|
||||
[vertx.web.interceptors :as vxi]))
|
||||
|
||||
(def ^:private router-options
|
||||
{::rr/default-options-handler options-handler
|
||||
:data {:middleware middleware}})
|
||||
(declare login-handler)
|
||||
(declare logout-handler)
|
||||
(declare register-handler)
|
||||
(declare mutation-handler)
|
||||
(declare query-handler)
|
||||
(declare echo-handler)
|
||||
|
||||
(def routes
|
||||
[["/media/*" (rr/create-resource-handler {:root "public/media"})]
|
||||
["/static/*" (rr/create-resource-handler {:root "public/static"})]
|
||||
(defn- on-start
|
||||
[ctx]
|
||||
(let [cors-opts {:origin (:http-server-cors cfg/config "http://localhost:3449")
|
||||
:max-age 3600
|
||||
:allow-credentials true
|
||||
:allow-methods #{:post :get :patch :head :options :put}
|
||||
:allow-headers #{:x-requested-with :content-type :cookie}}
|
||||
|
||||
["/api/auth"
|
||||
["/login" {:post (handler #'api-auth/login)}]
|
||||
["/logout" {:post (handler #'api-auth/logout)}]
|
||||
["/register" {:post (handler #'api-auth/register)}]
|
||||
["/recovery/:token" {:get (handler #'api-auth/register)}]
|
||||
["/recovery" {:post (handler #'api-auth/request-recovery)
|
||||
:get (handler #'api-auth/recover-password)}]]
|
||||
interceptors [(vxi/cookies)
|
||||
(vxi/headers)
|
||||
(vxi/params)
|
||||
(vxi/cors cors-opts)
|
||||
interceptors/parse-request-body
|
||||
interceptors/format-response-body]
|
||||
|
||||
["/api" {:middleware [authorization-middleware]}
|
||||
;; KVStore
|
||||
["/kvstore/:key" {:put (handler #'api-kvstore/upsert)
|
||||
:get (handler #'api-kvstore/retrieve)
|
||||
:delete (handler #'api-kvstore/delete)}]
|
||||
routes [["/api" {:interceptors interceptors}
|
||||
["/echo" {:interceptors [(session/auth)]
|
||||
:all handlers/echo-handler}]
|
||||
["/login" {:post handlers/login-handler}]
|
||||
["/logout" {:post handlers/logout-handler}]
|
||||
["/register" {:post handlers/register-handler}]
|
||||
["/debug"
|
||||
["/emails" {:get debug/emails-list}]
|
||||
["/emails/:id" {:get debug/email}]]
|
||||
["/w" {:interceptors [(session/auth)]}
|
||||
["/mutation/:type" {:interceptors [(vxi/uploads)]
|
||||
:post handlers/mutation-handler}]
|
||||
["/query/:type" {:get handlers/query-handler}]]]]
|
||||
|
||||
["/svg/parse" {:post (handler #'api-svg/parse)}]
|
||||
handler (vw/handler ctx
|
||||
(vw/assets "/media/*" {:root "resources/public/media/"})
|
||||
(vw/assets "/static/*" {:root "resources/public/static"})
|
||||
(vw/router routes))]
|
||||
|
||||
;; Projects
|
||||
["/projects" {:get (handler #'api-projects/list-projects)
|
||||
:post (handler #'api-projects/create-project)}]
|
||||
["/projects/by-token/:token" {:get (handler #'api-projects/get-project-by-share-token)}]
|
||||
["/projects/:id" {:put (handler #'api-projects/update-project)
|
||||
:delete (handler #'api-projects/delete-project)}]
|
||||
(vh/server ctx {:handler handler
|
||||
:port (:http-server-port cfg/config)})))
|
||||
|
||||
;; Pages
|
||||
["/pages" {:get (handler #'api-pages/list-pages)
|
||||
:post (handler #'api-pages/create-page)}]
|
||||
["/pages/:id" {:put (handler #'api-pages/update-page)
|
||||
:delete (handler #'api-pages/delete-page)}]
|
||||
["/pages/:id/metadata" {:put (handler #'api-pages/update-page-metadata)}]
|
||||
["/pages/:id/history" {:get (handler #'api-pages/retrieve-page-history)}]
|
||||
["/pages/:id/history/:hid" {:put (handler #'api-pages/update-page-history)}]
|
||||
|
||||
;; Profile
|
||||
["/profile"
|
||||
["/me" {:get (handler #'api-users/retrieve-profile)
|
||||
:put (handler #'api-users/update-profile)}]
|
||||
["/me/password" {:put (handler #'api-users/update-password)}]
|
||||
["/me/photo" {:post (handler #'api-users/update-photo)}]]
|
||||
|
||||
;; Library
|
||||
["/library"
|
||||
;; Icons
|
||||
["/icon-collections/:id" {:put (handler #'api-icons/update-collection)
|
||||
:delete (handler #'api-icons/delete-collection)}]
|
||||
["/icon-collections" {:get (handler #'api-icons/list-collections)
|
||||
:post (handler #'api-icons/create-collection)}]
|
||||
|
||||
["/icons/:id/copy" {:put (handler #'api-icons/copy-icon)}]
|
||||
|
||||
["/icons/:id" {:put (handler #'api-icons/update-icon)
|
||||
:delete (handler #'api-icons/delete-icon)}]
|
||||
["/icons" {:post (handler #'api-icons/create-icon)
|
||||
:get (handler #'api-icons/list-icons)}]
|
||||
|
||||
;; Images
|
||||
["/image-collections/:id" {:put (handler #'api-images/update-collection)
|
||||
:delete (handler #'api-images/delete-collection)}]
|
||||
["/image-collections" {:post (handler #'api-images/create-collection)
|
||||
:get (handler #'api-images/list-collections)}]
|
||||
["/images/:id/copy" {:put (handler #'api-images/copy-image)}]
|
||||
["/images/:id" {:get (handler #'api-images/retrieve-image)
|
||||
:delete (handler #'api-images/delete-image)
|
||||
:put (handler #'api-images/update-image)}]
|
||||
["/images" {:post (handler #'api-images/create-image)
|
||||
:get (handler #'api-images/list-images)}]
|
||||
]
|
||||
|
||||
]])
|
||||
|
||||
|
||||
;; --- State Initialization
|
||||
(def app
|
||||
(delay
|
||||
(let [router (rr/router routes router-options)]
|
||||
(rr/ring-handler router (rr/create-default-handler)))))
|
||||
|
||||
(defn- start-server
|
||||
[config]
|
||||
(jetty/run-jetty @app {:join? false
|
||||
:async? true
|
||||
:daemon? false
|
||||
:port (:http-server-port config)}))
|
||||
|
||||
(defstate server
|
||||
:start (start-server cfg/config)
|
||||
:stop (.stop server))
|
||||
(defstate http-verticle
|
||||
:start (let [factory (vc/verticle {:on-start on-start})]
|
||||
@(vc/deploy! system factory {:instances 4})))
|
||||
|
|
|
@ -1,77 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http.cors
|
||||
"CORS Implementation for Async Ring"
|
||||
(:require [cuerdas.core :as str]))
|
||||
|
||||
(defn- allow-origin?
|
||||
[value {:keys [origin]}]
|
||||
(cond
|
||||
(nil? value) value
|
||||
(= origin "*") origin
|
||||
(set? origin) (origin value)
|
||||
(= origin value) origin))
|
||||
|
||||
(defn- normalize-headers
|
||||
[headers]
|
||||
(->> (map (comp str/lower name) headers)
|
||||
(str/join ",")))
|
||||
|
||||
(defn- normalize-methods
|
||||
[methods]
|
||||
(->> (map (comp str/upper name) methods)
|
||||
(str/join ",")))
|
||||
|
||||
(defn- get-preflight-headers
|
||||
[origin {:keys [allow-methods allow-headers max-age allow-credentials]
|
||||
:or {allow-methods #{:get :post :put :delete}}
|
||||
:as opts}]
|
||||
(when-let [origin (allow-origin? origin opts)]
|
||||
(cond-> {"access-control-allow-origin" origin
|
||||
"access-control-allow-methods" (normalize-methods allow-methods)}
|
||||
allow-credentials
|
||||
(assoc "access-control-allow-credentials" "true")
|
||||
|
||||
max-age
|
||||
(assoc "access-control-max-age" (str max-age))
|
||||
|
||||
allow-headers
|
||||
(assoc "access-control-allow-headers" (normalize-headers allow-headers)))))
|
||||
|
||||
(defn get-response-headers
|
||||
[origin {:keys [allow-headers expose-headers allow-credentials] :as opts}]
|
||||
(when-let [origin (allow-origin? origin opts)]
|
||||
(cond-> {"access-control-allow-origin" origin}
|
||||
allow-credentials
|
||||
(assoc "access-control-allow-credentials" "true")
|
||||
|
||||
allow-headers
|
||||
(assoc "access-control-allow-headers" (normalize-headers allow-headers))
|
||||
|
||||
expose-headers
|
||||
(assoc "access-control-expose-headers" (normalize-headers expose-headers)))))
|
||||
|
||||
(defn- cors-preflight?
|
||||
[{:keys [request-method headers] :as req}]
|
||||
(and (= request-method :options)
|
||||
(contains? headers "origin")
|
||||
(contains? headers "access-control-request-method")))
|
||||
|
||||
(defn wrap-cors
|
||||
"A chain handler that handles cors related headers."
|
||||
[handler opts]
|
||||
(fn [{:keys [headers] :as req} respond raise]
|
||||
(let [origin (get headers "origin")]
|
||||
(if (cors-preflight? req)
|
||||
(let [headers (get-preflight-headers origin opts)]
|
||||
(respond {:status 200 :headers headers :body ""}))
|
||||
(let [headers (get-response-headers origin opts)
|
||||
wrapped-respond (fn [response] (respond (update response :headers merge headers)))]
|
||||
(handler req wrapped-respond raise))))))
|
||||
|
||||
|
||||
|
25
backend/src/uxbox/http/debug.clj
Normal file
25
backend/src/uxbox/http/debug.clj
Normal file
|
@ -0,0 +1,25 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http.debug
|
||||
"Debug related handlers."
|
||||
(:require
|
||||
[clojure.tools.logging :as log]
|
||||
[promesa.core :as p]
|
||||
[uxbox.http.errors :as errors]
|
||||
[uxbox.http.session :as session]
|
||||
[uxbox.services.core :as sv]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(defn emails-list
|
||||
[req]
|
||||
{:status 200
|
||||
:body "Hello world\n"})
|
||||
|
||||
(defn email
|
||||
[req]
|
||||
{:status 200
|
||||
:body "Hello world\n"})
|
|
@ -16,6 +16,12 @@
|
|||
{:status 400
|
||||
:body response}))
|
||||
|
||||
(defmethod handle-exception :not-found
|
||||
[err]
|
||||
(let [response (ex-data err)]
|
||||
{:status 404
|
||||
:body response}))
|
||||
|
||||
(defmethod handle-exception :parse
|
||||
[err]
|
||||
{:status 400
|
||||
|
@ -24,7 +30,9 @@
|
|||
|
||||
(defmethod handle-exception :default
|
||||
[err]
|
||||
(println "--- START REQ EXCEPTION ---")
|
||||
(e/write-exception err)
|
||||
(println "--- END REQ EXCEPTION ---")
|
||||
{:status 500
|
||||
:body {:type :exception
|
||||
:message (ex-message err)}})
|
||||
|
@ -40,14 +48,14 @@
|
|||
:type :occ}}
|
||||
(handle-exception err))))
|
||||
|
||||
(defn errors-handler
|
||||
[error context]
|
||||
(defn handle
|
||||
[error]
|
||||
(cond
|
||||
(or (instance? java.util.concurrent.CompletionException error)
|
||||
(instance? java.util.concurrent.ExecutionException error))
|
||||
(errors-handler context (.getCause error))
|
||||
(handle (.getCause error))
|
||||
|
||||
(instance? org.jooq.exception.DataAccessException error)
|
||||
(handle-data-access-exception error)
|
||||
;; (instance? org.jooq.exception.DataAccessException error)
|
||||
;; (handle-data-access-exception error)
|
||||
|
||||
:else (handle-exception error)))
|
||||
|
|
|
@ -1,53 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http.etag
|
||||
"ETag calculation helpers."
|
||||
(:require [clojure.java.io :as io]
|
||||
[buddy.core.hash :as hash]
|
||||
[buddy.core.codecs :as codecs]
|
||||
[buddy.core.codecs.base64 :as b64]))
|
||||
|
||||
(defn digest
|
||||
[^bytes data]
|
||||
(-> (hash/blake2b-256 data)
|
||||
(b64/encode true)
|
||||
(codecs/bytes->str)))
|
||||
|
||||
(defn- etag-match?
|
||||
[request new-tag]
|
||||
(when-let [etag (get-in request [:headers "if-none-match"])]
|
||||
(= etag new-tag)))
|
||||
|
||||
(defn stream-bytes
|
||||
[is]
|
||||
(let [baos (java.io.ByteArrayOutputStream.)]
|
||||
(io/copy is baos)
|
||||
(.toByteArray baos)))
|
||||
|
||||
(defn handle-response
|
||||
[request {:keys [body] :as response}]
|
||||
(when (instance? java.io.ByteArrayInputStream body)
|
||||
(let [data (stream-bytes body)
|
||||
etag (digest data)]
|
||||
(.reset body)
|
||||
(if-not (etag-match? request etag)
|
||||
(update response :headers assoc "etag" etag)
|
||||
(-> response
|
||||
(assoc :body "" :status 304)
|
||||
(update :headers assoc "etag" etag))))))
|
||||
|
||||
(defn wrap-etag
|
||||
[handler]
|
||||
(fn [request respond raise]
|
||||
(handler request
|
||||
(fn [response]
|
||||
(if (= (:request-method request) :get)
|
||||
(respond (or (handle-response request response) response))
|
||||
(respond response)))
|
||||
raise)))
|
||||
|
||||
|
86
backend/src/uxbox/http/handlers.clj
Normal file
86
backend/src/uxbox/http/handlers.clj
Normal file
|
@ -0,0 +1,86 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http.handlers
|
||||
(:require
|
||||
[clojure.tools.logging :as log]
|
||||
[promesa.core :as p]
|
||||
[uxbox.http.errors :as errors]
|
||||
[uxbox.http.session :as session]
|
||||
[uxbox.services.core :as sv]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(defn query-handler
|
||||
[req]
|
||||
(let [type (get-in req [:path-params :type])
|
||||
data (merge (:params req)
|
||||
{::sv/type (keyword type)
|
||||
:user (:user req)})]
|
||||
(-> (sv/query (with-meta data {:req req}))
|
||||
(p/handle (fn [result error]
|
||||
(if error
|
||||
(errors/handle error)
|
||||
{:status 200
|
||||
:body result}))))))
|
||||
|
||||
(defn mutation-handler
|
||||
[req]
|
||||
(let [type (get-in req [:path-params :type])
|
||||
data (merge (:params req)
|
||||
(:body-params req)
|
||||
(:uploads req)
|
||||
{::sv/type (keyword type)
|
||||
:user (:user req)})]
|
||||
(-> (sv/mutation (with-meta data {:req req}))
|
||||
(p/handle (fn [result error]
|
||||
(if error
|
||||
(errors/handle error)
|
||||
{:status 200 :body result}))))))
|
||||
|
||||
(defn login-handler
|
||||
[req]
|
||||
(let [data (:body-params req)
|
||||
user-agent (get-in req [:headers "user-agent"])]
|
||||
(-> (sv/mutation (assoc data ::sv/type :login))
|
||||
(p/then #(session/create % user-agent))
|
||||
(p/then (fn [token]
|
||||
{:status 204
|
||||
:cookies {"auth-token" {:value token}}
|
||||
:body ""}))
|
||||
(p/catch errors/handle))))
|
||||
|
||||
(defn logout-handler
|
||||
[req]
|
||||
(let [token (get-in req [:cookies "auth-token"])
|
||||
token (uuid/from-string token)]
|
||||
(-> (session/delete token)
|
||||
(p/then (fn [token]
|
||||
{:status 204
|
||||
:cookies {"auth-token" {:value nil}}
|
||||
:body ""}))
|
||||
(p/catch errors/handle))))
|
||||
|
||||
(defn register-handler
|
||||
[req]
|
||||
(let [data (merge (:body-params req)
|
||||
{::sv/type :register-profile})
|
||||
user-agent (get-in req [:headers "user-agent"])]
|
||||
(-> (sv/mutation (with-meta data {:req req}))
|
||||
(p/then (fn [{:keys [id] :as user}]
|
||||
(session/create id user-agent)))
|
||||
(p/then' (fn [token]
|
||||
{:status 204
|
||||
:cookies {"auth-token" {:value token}}
|
||||
:body ""}))
|
||||
(p/catch' errors/handle))))
|
||||
|
||||
(defn echo-handler
|
||||
[req]
|
||||
{:status 200
|
||||
:body {:params (:params req)
|
||||
:cookies (:cookies req)
|
||||
:headers (:headers req)}})
|
||||
|
65
backend/src/uxbox/http/interceptors.clj
Normal file
65
backend/src/uxbox/http/interceptors.clj
Normal file
|
@ -0,0 +1,65 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http.interceptors
|
||||
(:require
|
||||
[vertx.web :as vw]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.exceptions :as ex])
|
||||
(:import
|
||||
io.vertx.ext.web.RoutingContext
|
||||
io.vertx.ext.web.FileUpload
|
||||
io.vertx.core.buffer.Buffer))
|
||||
|
||||
(def parse-request-body
|
||||
{:enter (fn [{:keys [request] :as data}]
|
||||
(let [body (:body request)
|
||||
mtype (get-in request [:headers "content-type"])]
|
||||
(if (= "application/transit+json" mtype)
|
||||
(try
|
||||
(let [params (blob/decode-from-json body)]
|
||||
(update data :request assoc :body-params params))
|
||||
(catch Exception e
|
||||
(ex/raise :type :parse
|
||||
:message "Unable to parse transit from request body."
|
||||
:cause e)))
|
||||
data)))})
|
||||
|
||||
(def format-response-body
|
||||
{:leave (fn [{:keys [response] :as data}]
|
||||
(let [body (:body response)]
|
||||
(cond
|
||||
(coll? body)
|
||||
(-> data
|
||||
(assoc-in [:response :body]
|
||||
(blob/encode-with-json body true))
|
||||
(update-in [:response :headers]
|
||||
assoc "content-type" "application/transit+json"))
|
||||
|
||||
(nil? body)
|
||||
(-> data
|
||||
(assoc-in [:response :status] 204)
|
||||
(assoc-in [:response :body] ""))
|
||||
|
||||
:else
|
||||
data)))})
|
||||
|
||||
(def handle-uploads
|
||||
{:enter (fn [data]
|
||||
(let [rcontext (get-in data [:request ::vw/routing-context])
|
||||
uploads (.fileUploads ^RoutingContext rcontext)
|
||||
uploads (reduce (fn [acc ^FileUpload upload]
|
||||
(assoc acc
|
||||
(keyword (.name upload))
|
||||
{:type :uploaded-file
|
||||
:mtype (.contentType upload)
|
||||
:path (.uploadedFileName upload)
|
||||
:name (.fileName upload)
|
||||
:size (.size upload)}))
|
||||
{}
|
||||
uploads)]
|
||||
(assoc-in data [:request :upload-params] uploads)))})
|
||||
|
|
@ -1,307 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http.middleware
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.java.io :as io]
|
||||
[cuerdas.core :as str]
|
||||
[promesa.core :as p]
|
||||
[reitit.ring :as rr]
|
||||
[reitit.ring.middleware.exception :as exception]
|
||||
[reitit.ring.middleware.multipart :as multipart]
|
||||
[reitit.ring.middleware.parameters :as parameters]
|
||||
[ring.middleware.multipart-params :refer [wrap-multipart-params]]
|
||||
[ring.middleware.session :refer [wrap-session]]
|
||||
[ring.middleware.session.cookie :refer [cookie-store]]
|
||||
[struct.core :as st]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.http.cors :refer [wrap-cors]]
|
||||
[uxbox.http.errors :as errors]
|
||||
[uxbox.http.etag :refer [wrap-etag]]
|
||||
[uxbox.http.response :as rsp]
|
||||
[uxbox.util.data :refer [normalize-attrs]]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.transit :as t]))
|
||||
|
||||
(extend-protocol ring.core.protocols/StreamableResponseBody
|
||||
(Class/forName "[B")
|
||||
(write-body-to-stream [body _ ^java.io.OutputStream output-stream]
|
||||
(with-open [out output-stream]
|
||||
(.write out ^bytes body))))
|
||||
|
||||
(defn- transform-handler
|
||||
[handler]
|
||||
(fn [request respond raise]
|
||||
(try
|
||||
(let [response (handler request)]
|
||||
(if (p/promise? response)
|
||||
(-> response
|
||||
(p/then respond)
|
||||
(p/catch raise))
|
||||
(respond response)))
|
||||
(catch Exception e
|
||||
(raise e)))))
|
||||
|
||||
;; The middleware that transform string keys to keywords and perform
|
||||
;; usability transformations.
|
||||
|
||||
(def ^:private normalize-params-middleware
|
||||
{:name ::normalize-params-middleware
|
||||
:wrap (fn [handler]
|
||||
(letfn [(transform-request [request key]
|
||||
(if-let [data (get request key)]
|
||||
(assoc request key (normalize-attrs data))
|
||||
request))
|
||||
(transform [request]
|
||||
(-> request
|
||||
(transform-request :query-params)
|
||||
(transform-request :multipart-params)))]
|
||||
(fn
|
||||
([request] (handler (transform request)))
|
||||
([request respond raise]
|
||||
(try
|
||||
(try
|
||||
(handler (transform request) respond raise)
|
||||
(catch Exception e
|
||||
(raise e))))))))})
|
||||
|
||||
(def ^:private multipart-params-middleware
|
||||
{:name ::multipart-params-middleware
|
||||
:wrap wrap-multipart-params})
|
||||
|
||||
(def ^:private parameters-validation-middleware
|
||||
(letfn [(prepare [parameters]
|
||||
(reduce-kv
|
||||
(fn [acc key spec]
|
||||
(let [newkey (case key
|
||||
:path :path-params
|
||||
:query :query-params
|
||||
:body :body-params
|
||||
:multipart :multipart-params
|
||||
(throw (ex-info "Not supported key on :parameters" {})))]
|
||||
(assoc acc newkey {:key key
|
||||
:fn #(st/validate spec %)})))
|
||||
{} parameters))
|
||||
|
||||
(validate [request parameters debug]
|
||||
(reduce-kv
|
||||
(fn [req key spec]
|
||||
(let [[errors, result] ((:fn spec) (get req key))]
|
||||
(if errors
|
||||
(ex/raise :type :validation
|
||||
:code (:key spec)
|
||||
:context errors
|
||||
:prop key
|
||||
:value (get req key)
|
||||
:message "Invalid data")
|
||||
(assoc-in req [:parameters (:key spec)] result))))
|
||||
request parameters))
|
||||
|
||||
(compile-struct [route opts parameters]
|
||||
(let [parameters (prepare parameters)]
|
||||
(fn [handler]
|
||||
(fn
|
||||
([request]
|
||||
(handler (validate request parameters)))
|
||||
([request respond raise]
|
||||
(try
|
||||
(handler (validate request parameters false) respond raise)
|
||||
(catch Exception e
|
||||
(raise e))))))))
|
||||
|
||||
(prepare-spec [parameters]
|
||||
(reduce-kv (fn [acc key s]
|
||||
(let [rk (case key
|
||||
:path :path-params
|
||||
:query :query-params
|
||||
:body :body-params
|
||||
:multipart :multipart-params
|
||||
(throw (ex-info "Not supported key on :parameters" {})))]
|
||||
(assoc acc rk {:key key
|
||||
:fn #(us/conform s %)})))
|
||||
{}
|
||||
parameters))
|
||||
|
||||
(validate-spec [request parameters]
|
||||
(reduce-kv
|
||||
(fn [req key spec]
|
||||
(let [[result errors] ((:fn spec) (get req key))]
|
||||
(if errors
|
||||
(ex/raise :type :validation
|
||||
:code :parameters
|
||||
:context {:problems (vec (::s/problems errors))
|
||||
:spec (::s/spec errors)
|
||||
:value (::s/value errors)})
|
||||
(assoc-in req [:parameters (:key spec)] result))))
|
||||
request parameters))
|
||||
|
||||
(compile-spec [route opts parameters]
|
||||
(let [parameters (prepare-spec parameters)]
|
||||
(fn [handler]
|
||||
(fn
|
||||
([request]
|
||||
(handler (validate-spec request parameters)))
|
||||
([request respond raise]
|
||||
(try
|
||||
(handler (validate-spec request parameters) respond raise)
|
||||
(catch Exception e
|
||||
(raise e))))))))
|
||||
|
||||
(compile [route opts]
|
||||
(when-let [parameters (:parameters route)]
|
||||
(if (= :spec (:validation route))
|
||||
(compile-spec route opts parameters)
|
||||
(compile-struct route opts parameters))))]
|
||||
{:name ::parameters-validation-middleware
|
||||
:compile compile}))
|
||||
|
||||
(def ^:private session-middleware
|
||||
(let [options {:store (cookie-store {:key "a 16-byte secret"})
|
||||
:cookie-name "session"
|
||||
:cookie-attrs {:same-site :lax
|
||||
:http-only false}}]
|
||||
{:name ::session-middleware
|
||||
:wrap #(wrap-session % options)}))
|
||||
|
||||
(def cors-conf
|
||||
{:origin #{"http://localhost:3449"}
|
||||
:max-age 3600
|
||||
:allow-credentials true
|
||||
:allow-methods #{:post :put :get :delete}
|
||||
:allow-headers #{:x-requested-with :content-type :cookie}})
|
||||
|
||||
(def ^:private cors-middleware
|
||||
{:name ::cors-middleware
|
||||
:wrap (fn [handler]
|
||||
(let [cors (:http-server-cors cfg/config)]
|
||||
(if (string? cors)
|
||||
(->> (assoc cors-conf :origin #{cors})
|
||||
(wrap-cors handler))
|
||||
handler)))})
|
||||
|
||||
(def ^:private etag-middleware
|
||||
{:name ::etag-middleware
|
||||
:wrap wrap-etag})
|
||||
|
||||
(def ^:private exception-middleware
|
||||
(exception/create-exception-middleware
|
||||
(assoc exception/default-handlers
|
||||
:muuntaja/decode errors/errors-handler
|
||||
::exception/default errors/errors-handler)))
|
||||
|
||||
(def authorization-middleware
|
||||
{:name ::authorization-middleware
|
||||
:wrap (fn [handler]
|
||||
(fn
|
||||
([request]
|
||||
(if-let [identity (get-in request [:session :user-id])]
|
||||
(handler (assoc request :identity identity :user identity))
|
||||
(rsp/forbidden nil)))
|
||||
([request respond raise]
|
||||
(if-let [identity (get-in request [:session :user-id])]
|
||||
(handler (assoc request :identity identity :user identity) respond raise)
|
||||
(respond (rsp/forbidden nil))))))})
|
||||
|
||||
(def format-response-middleware
|
||||
(letfn [(process-response [{:keys [body] :as rsp}]
|
||||
(if (coll? body)
|
||||
(let [body (t/encode body {:type :json-verbose})]
|
||||
(-> rsp
|
||||
(assoc :body body)
|
||||
(update :headers assoc "content-type" "application/transit+json")))
|
||||
rsp))]
|
||||
{:name ::format-response-middleware
|
||||
:wrap (fn [handler]
|
||||
(fn
|
||||
([request]
|
||||
(process-response (handler request)))
|
||||
([request respond raise]
|
||||
(handler request (fn [res] (respond (process-response res))) raise))))}))
|
||||
|
||||
(def parse-request-middleware
|
||||
(letfn [(get-content-type [request]
|
||||
(or (:content-type request)
|
||||
(get (:headers request) "content-type")))
|
||||
|
||||
(slurp-bytes [body]
|
||||
(with-open [input (io/input-stream body)
|
||||
output (java.io.ByteArrayOutputStream. (.available input))]
|
||||
(io/copy input output)
|
||||
(.toByteArray output)))
|
||||
|
||||
(parse-body [body]
|
||||
(let [^bytes body (slurp-bytes body)]
|
||||
(when (pos? (alength body))
|
||||
(t/decode body))))
|
||||
|
||||
(process-request [request]
|
||||
(let [ctype (get-content-type request)]
|
||||
(if (= "application/transit+json" ctype)
|
||||
(try
|
||||
(let [body (parse-body (:body request))]
|
||||
(assoc request :body-params body))
|
||||
(catch Exception e
|
||||
(ex/raise :type :parse
|
||||
:message "Unable to parse transit from request body."
|
||||
:cause e)))
|
||||
request)))]
|
||||
|
||||
{:name ::parse-request-middleware
|
||||
:wrap (fn [handler]
|
||||
(fn
|
||||
([request]
|
||||
(handler (process-request request)))
|
||||
([request respond raise]
|
||||
(let [^HttpInput body (:body request)]
|
||||
(try
|
||||
(handler (process-request request) respond raise)
|
||||
(catch Exception e
|
||||
(raise e)))))))}))
|
||||
|
||||
(def middleware
|
||||
[cors-middleware
|
||||
session-middleware
|
||||
|
||||
;; etag
|
||||
etag-middleware
|
||||
|
||||
parameters/parameters-middleware
|
||||
|
||||
;; Format the body into transit
|
||||
format-response-middleware
|
||||
|
||||
;; main exception handling
|
||||
exception-middleware
|
||||
|
||||
;; parse transit format from request body
|
||||
parse-request-middleware
|
||||
|
||||
;; multipart parsing
|
||||
multipart-params-middleware
|
||||
|
||||
;; parameters normalization
|
||||
normalize-params-middleware
|
||||
|
||||
;; parameters validation
|
||||
parameters-validation-middleware])
|
||||
|
||||
(defn handler
|
||||
[invar]
|
||||
(let [metadata (meta invar)
|
||||
hlrdata (-> metadata
|
||||
(dissoc :arglist :line :column :file :ns)
|
||||
(assoc :handler (transform-handler (var-get invar))
|
||||
:fullname (symbol (str (:ns metadata)) (str (:name metadata)))))]
|
||||
(cond-> hlrdata
|
||||
(:doc metadata) (assoc :description (:doc metadata)))))
|
||||
|
||||
(defn options-handler
|
||||
[request respond raise]
|
||||
(let [methods (->> request rr/get-match :result (keep (fn [[k v]] (if v k))))
|
||||
allow (->> methods (map (comp str/upper name)) (str/join ","))]
|
||||
(respond {:status 200, :body "", :headers {"Allow" allow}})))
|
|
@ -1,216 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http.response)
|
||||
|
||||
(defn response
|
||||
"Create a response instance."
|
||||
([body] (response body 200 {}))
|
||||
([body status] (response body status {}))
|
||||
([body status headers] {:body body :status status :headers headers}))
|
||||
|
||||
(defn response?
|
||||
[resp]
|
||||
(and (map? resp)
|
||||
(integer? (:status resp))
|
||||
(map? (:headers resp))))
|
||||
|
||||
(defn continue
|
||||
([body] (response body 100))
|
||||
([body headers] (response body 100 headers)))
|
||||
|
||||
(defn ok
|
||||
"HTTP 200 OK
|
||||
Should be used to indicate nonspecific success. Must not be used to
|
||||
communicate errors in the response body.
|
||||
|
||||
In most cases, 200 is the code the client hopes to see. It indicates that
|
||||
the REST API successfully carried out whatever action the client requested,
|
||||
and that no more specific code in the 2xx series is appropriate. Unlike
|
||||
the 204 status code, a 200 response should include a response body."
|
||||
([body] (response body 200))
|
||||
([body headers] (response body 200 headers)))
|
||||
|
||||
(defn created
|
||||
"HTTP 201 Created
|
||||
Must be used to indicate successful resource creation.
|
||||
|
||||
A REST API responds with the 201 status code whenever a collection creates,
|
||||
or a store adds, a new resource at the client's request. There may also be
|
||||
times when a new resource is created as a result of some controller action,
|
||||
in which case 201 would also be an appropriate response."
|
||||
([location] (response "" 201 {"location" location}))
|
||||
([location body] (response body 201 {"location" location}))
|
||||
([location body headers] (response body 201 (merge headers {"location" location}))))
|
||||
|
||||
(defn accepted
|
||||
"HTTP 202 Accepted
|
||||
Must be used to indicate successful start of an asynchronous action.
|
||||
|
||||
A 202 response indicates that the client's request will be handled
|
||||
asynchronously. This response status code tells the client that the request
|
||||
appears valid, but it still may have problems once it's finally processed.
|
||||
A 202 response is typically used for actions that take a long while to
|
||||
process."
|
||||
([body] (response body 202))
|
||||
([body headers] (response body 202 headers)))
|
||||
|
||||
(defn no-content
|
||||
"HTTP 204 No Content
|
||||
Should be used when the response body is intentionally empty.
|
||||
|
||||
The 204 status code is usually sent out in response to a PUT, POST, or
|
||||
DELETE request, when the REST API declines to send back any status message
|
||||
or representation in the response message's body. An API may also send 204
|
||||
in conjunction with a GET request to indicate that the requested resource
|
||||
exists, but has no state representation to include in the body."
|
||||
([] (response "" 204))
|
||||
([headers] (response "" 204 headers)))
|
||||
|
||||
(defn moved-permanently
|
||||
"301 Moved Permanently
|
||||
Should be used to relocate resources.
|
||||
|
||||
The 301 status code indicates that the REST API's resource model has been
|
||||
significantly redesigned and a new permanent URI has been assigned to the
|
||||
client's requested resource. The REST API should specify the new URI in
|
||||
the response's Location header."
|
||||
([location] (response "" 301 {"location" location}))
|
||||
([location body] (response body 301 {"location" location}))
|
||||
([location body headers] (response body 301 (merge headers {"location" location}))))
|
||||
|
||||
(defn found
|
||||
"HTTP 302 Found
|
||||
Should not be used.
|
||||
|
||||
The intended semantics of the 302 response code have been misunderstood
|
||||
by programmers and incorrectly implemented in programs since version 1.0
|
||||
of the HTTP protocol.
|
||||
The confusion centers on whether it is appropriate for a client to always
|
||||
automatically issue a follow-up GET request to the URI in response's
|
||||
Location header, regardless of the original request's method. For the
|
||||
record, the intent of 302 is that this automatic redirect behavior only
|
||||
applies if the client's original request used either the GET or HEAD
|
||||
method.
|
||||
|
||||
To clear things up, HTTP 1.1 introduced status codes 303 (\"See Other\")
|
||||
and 307 (\"Temporary Redirect\"), either of which should be used
|
||||
instead of 302."
|
||||
([location] (response "" 302 {"location" location}))
|
||||
([location body] (response body 302 {"location" location}))
|
||||
([location body headers] (response body 302 (merge headers {"location" location}))))
|
||||
|
||||
(defn see-other
|
||||
"HTTP 303 See Other
|
||||
Should be used to refer the client to a different URI.
|
||||
|
||||
A 303 response indicates that a controller resource has finished its work,
|
||||
but instead of sending a potentially unwanted response body, it sends the
|
||||
client the URI of a response resource. This can be the URI of a temporary
|
||||
status message, or the URI to some already existing, more permanent,
|
||||
resource.
|
||||
Generally speaking, the 303 status code allows a REST API to send a
|
||||
reference to a resource without forcing the client to download its state.
|
||||
Instead, the client may send a GET request to the value of the Location
|
||||
header."
|
||||
([location] (response "" 303 {"location" location}))
|
||||
([location body] (response body 303 {"location" location}))
|
||||
([location body headers] (response body 303 (merge headers {"location" location}))))
|
||||
|
||||
(defn temporary-redirect
|
||||
"HTTP 307 Temporary Redirect
|
||||
Should be used to tell clients to resubmit the request to another URI.
|
||||
|
||||
HTTP/1.1 introduced the 307 status code to reiterate the originally
|
||||
intended semantics of the 302 (\"Found\") status code. A 307 response
|
||||
indicates that the REST API is not going to process the client's request.
|
||||
Instead, the client should resubmit the request to the URI specified by
|
||||
the response message's Location header.
|
||||
|
||||
A REST API can use this status code to assign a temporary URI to the
|
||||
client's requested resource. For example, a 307 response can be used to
|
||||
shift a client request over to another host."
|
||||
([location] (response "" 307 {"location" location}))
|
||||
([location body] (response body 307 {"location" location}))
|
||||
([location body headers] (response body 307 (merge headers {"location" location}))))
|
||||
|
||||
(defn bad-request
|
||||
"HTTP 400 Bad Request
|
||||
May be used to indicate nonspecific failure.
|
||||
|
||||
400 is the generic client-side error status, used when no other 4xx error
|
||||
code is appropriate."
|
||||
([body] (response body 400))
|
||||
([body headers] (response body 400 headers)))
|
||||
|
||||
(defn unauthorized
|
||||
"HTTP 401 Unauthorized
|
||||
Must be used when there is a problem with the client credentials.
|
||||
|
||||
A 401 error response indicates that the client tried to operate on a
|
||||
protected resource without providing the proper authorization. It may have
|
||||
provided the wrong credentials or none at all."
|
||||
([body] (response body 401))
|
||||
([body headers] (response body 401 headers)))
|
||||
|
||||
(defn forbidden
|
||||
"HTTP 403 Forbidden
|
||||
Should be used to forbid access regardless of authorization state.
|
||||
|
||||
A 403 error response indicates that the client's request is formed
|
||||
correctly, but the REST API refuses to honor it. A 403 response is not a
|
||||
case of insufficient client credentials; that would be 401 (\"Unauthorized\").
|
||||
REST APIs use 403 to enforce application-level permissions. For example, a
|
||||
client may be authorized to interact with some, but not all of a REST API's
|
||||
resources. If the client attempts a resource interaction that is outside of
|
||||
its permitted scope, the REST API should respond with 403."
|
||||
([body] (response body 403))
|
||||
([body headers] (response body 403 headers)))
|
||||
|
||||
(defn not-found
|
||||
"HTTP 404 Not Found
|
||||
Must be used when a client's URI cannot be mapped to a resource.
|
||||
|
||||
The 404 error status code indicates that the REST API can't map the
|
||||
client's URI to a resource."
|
||||
([body] (response body 404))
|
||||
([body headers] (response body 404 headers)))
|
||||
|
||||
(defn method-not-allowed
|
||||
([body] (response body 405))
|
||||
([body headers] (response body 405 headers)))
|
||||
|
||||
(defn not-acceptable
|
||||
([body] (response body 406))
|
||||
([body headers] (response body 406 headers)))
|
||||
|
||||
(defn conflict
|
||||
([body] (response body 409))
|
||||
([body headers] (response body 409 headers)))
|
||||
|
||||
(defn gone
|
||||
([body] (response body 410))
|
||||
([body headers] (response body 410 headers)))
|
||||
|
||||
(defn precondition-failed
|
||||
([body] (response body 412))
|
||||
([body headers] (response body 412 headers)))
|
||||
|
||||
(defn unsupported-mediatype
|
||||
([body] (response body 415))
|
||||
([body headers] (response body 415 headers)))
|
||||
|
||||
(defn too-many-requests
|
||||
([body] (response body 429))
|
||||
([body headers] (response body 429 headers)))
|
||||
|
||||
(defn internal-server-error
|
||||
([body] (response body 500))
|
||||
([body headers] (response body 500 headers)))
|
||||
|
||||
(defn not-implemented
|
||||
([body] (response body 501))
|
||||
([body headers] (response body 501 headers)))
|
63
backend/src/uxbox/http/session.clj
Normal file
63
backend/src/uxbox/http/session.clj
Normal file
|
@ -0,0 +1,63 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.http.session
|
||||
(:require
|
||||
[promesa.core :as p]
|
||||
[sieppari.context :as spx]
|
||||
[vertx.core :as vc]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
;; --- Main API
|
||||
|
||||
(defn retrieve
|
||||
"Retrieves a user id associated with the provided auth token."
|
||||
[token]
|
||||
(let [sql "select user_id from sessions where id = $1"]
|
||||
(-> (db/query-one db/pool [sql token])
|
||||
(p/then' (fn [row] (when row (:user-id row)))))))
|
||||
|
||||
(defn create
|
||||
[user-id user-agent]
|
||||
(let [id (uuid/random)
|
||||
sql "insert into sessions (id, user_id, user_agent) values ($1, $2, $3)"]
|
||||
(-> (db/query-one db/pool [sql id user-id user-agent])
|
||||
(p/then (constantly (str id))))))
|
||||
|
||||
(defn delete
|
||||
[token]
|
||||
(let [sql "delete from sessions where id = $1"]
|
||||
(-> (db/query-one db/pool [sql token])
|
||||
(p/then' (constantly nil)))))
|
||||
|
||||
;; --- Interceptor
|
||||
|
||||
(defn parse-token
|
||||
[request]
|
||||
(try
|
||||
(when-let [token (get-in request [:cookies "auth-token"])]
|
||||
(uuid/from-string token))
|
||||
(catch java.lang.IllegalArgumentException e
|
||||
nil)))
|
||||
|
||||
(defn auth
|
||||
[]
|
||||
{:enter (fn [data]
|
||||
(let [token (parse-token (:request data))]
|
||||
(-> (retrieve token)
|
||||
(p/then' (fn [user-id]
|
||||
(if user-id
|
||||
(update data :request assoc :user user-id)
|
||||
(spx/terminate (assoc data ::unauthorized true)))))
|
||||
(vc/handle-on-context))))
|
||||
:leave (fn [data]
|
||||
(if (::unauthorized data)
|
||||
(update data :response
|
||||
assoc :status 403 :body {:type :authentication
|
||||
:code :unauthorized})
|
||||
data))})
|
|
@ -21,6 +21,8 @@
|
|||
org.im4java.core.ConvertCmd
|
||||
org.im4java.core.IMOperation))
|
||||
|
||||
;; TODO: make this module non-blocking
|
||||
|
||||
;; --- Thumbnails Generation
|
||||
|
||||
(s/def ::width integer?)
|
||||
|
|
|
@ -7,15 +7,15 @@
|
|||
(ns uxbox.locks
|
||||
"Advirsory locks for specific handling concurrent modifications
|
||||
on particular objects in the database."
|
||||
(:require [suricatta.core :as sc])
|
||||
#_(:require [suricatta.core :as sc])
|
||||
(:import clojure.lang.Murmur3))
|
||||
|
||||
(defn- uuid->long
|
||||
[v]
|
||||
(Murmur3/hashUnencodedChars (str v)))
|
||||
|
||||
(defn acquire!
|
||||
[conn v]
|
||||
(let [id (uuid->long v)]
|
||||
(sc/execute conn ["select pg_advisory_xact_lock(?);" id])
|
||||
nil))
|
||||
;; (defn acquire!
|
||||
;; [conn v]
|
||||
;; (let [id (uuid->long v)]
|
||||
;; (sc/execute conn ["select pg_advisory_xact_lock(?);" id])
|
||||
;; nil))
|
||||
|
|
|
@ -10,12 +10,11 @@
|
|||
[uxbox.migrations]
|
||||
[uxbox.db]
|
||||
[uxbox.http]
|
||||
[uxbox.scheduled-jobs])
|
||||
#_[uxbox.scheduled-jobs])
|
||||
(:gen-class))
|
||||
|
||||
;; --- Entry point (only for uberjar)
|
||||
|
||||
(defn -main
|
||||
[& args]
|
||||
(mount/start)
|
||||
(.join uxbox.http/server))
|
||||
(mount/start))
|
||||
|
|
|
@ -5,79 +5,52 @@
|
|||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.migrations
|
||||
(:require [mount.core :as mount :refer (defstate)]
|
||||
[migrante.core :as mg :refer (defmigration)]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.util.template :as tmpl]))
|
||||
(:require
|
||||
[mount.core :as mount :refer [defstate]]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.util.migrations :as mg]
|
||||
[uxbox.util.template :as tmpl]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Migrations
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; --- Migrations
|
||||
|
||||
(defmigration utils-0000
|
||||
"Create a initial version of txlog table."
|
||||
:up (mg/resource "migrations/0000.main.up.sql"))
|
||||
|
||||
(defmigration txlog-0001
|
||||
"Create a initial version of txlog table."
|
||||
:up (mg/resource "migrations/0001.txlog.up.sql"))
|
||||
|
||||
(defmigration auth-0002
|
||||
"Create initial auth related tables."
|
||||
:up (mg/resource "migrations/0002.auth.up.sql"))
|
||||
|
||||
(defmigration projects-0003
|
||||
"Create initial tables for projects."
|
||||
:up (mg/resource "migrations/0003.projects.up.sql"))
|
||||
|
||||
(defmigration pages-0004
|
||||
"Create initial tables for pages."
|
||||
:up (mg/resource "migrations/0004.pages.up.sql"))
|
||||
|
||||
(defmigration kvstore-0005
|
||||
"Create initial tables for kvstore."
|
||||
:up (mg/resource "migrations/0005.kvstore.up.sql"))
|
||||
|
||||
(defmigration emails-queue-0006
|
||||
"Create initial tables for emails queue."
|
||||
:up (mg/resource "migrations/0006.emails.up.sql"))
|
||||
|
||||
(defmigration images-0007
|
||||
"Create initial tables for image collections."
|
||||
:up (mg/resource "migrations/0007.images.up.sql"))
|
||||
|
||||
(defmigration icons-0008
|
||||
"Create initial tables for image collections."
|
||||
:up (mg/resource "migrations/0008.icons.up.sql"))
|
||||
|
||||
(defmigration history-0009
|
||||
"Add improvements on how history is managed for pages."
|
||||
:up (mg/resource "migrations/0009.history.improvements.up.sql"))
|
||||
(def migrations
|
||||
{:name "uxbox-main"
|
||||
:steps
|
||||
[{:desc "Initial triggers and utils."
|
||||
:name "0001-main"
|
||||
:fn (mg/resource "migrations/0001.main.up.sql")}
|
||||
{:desc "Initial auth related tables"
|
||||
:name "0002-auth"
|
||||
:fn (mg/resource "migrations/0002.auth.up.sql")}
|
||||
{:desc "Initial projects tables"
|
||||
:name "0003-projects"
|
||||
:fn (mg/resource "migrations/0003.projects.up.sql")}
|
||||
{:desc "Initial pages tables"
|
||||
:name "0004-pages"
|
||||
:fn (mg/resource "migrations/0004.pages.up.sql")}
|
||||
{:desc "Initial kvstore tables"
|
||||
:name "0005-kvstore"
|
||||
:fn (mg/resource "migrations/0005.kvstore.up.sql")}
|
||||
{:desc "Initial emails related tables"
|
||||
:name "0006-emails"
|
||||
:fn (mg/resource "migrations/0006.emails.up.sql")}
|
||||
{:desc "Initial images tables"
|
||||
:name "0007-images"
|
||||
:fn (mg/resource "migrations/0007.images.up.sql")}
|
||||
{:desc "Initial icons tables"
|
||||
:name "0008-icons"
|
||||
:fn (mg/resource "migrations/0008.icons.up.sql")}
|
||||
]})
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Entry point
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def +migrations+
|
||||
{:name :uxbox-main
|
||||
:steps [[:0000 utils-0000]
|
||||
[:0001 txlog-0001]
|
||||
[:0002 auth-0002]
|
||||
[:0003 projects-0003]
|
||||
[:0004 pages-0004]
|
||||
[:0005 kvstore-0005]
|
||||
[:0006 emails-queue-0006]
|
||||
[:0007 images-0007]
|
||||
[:0008 icons-0008]
|
||||
[:0009 history-0009]]})
|
||||
|
||||
(defn- migrate
|
||||
(defn migrate
|
||||
[]
|
||||
(let [options {:verbose (:migrations-verbose cfg/config true)}]
|
||||
(with-open [mctx (mg/context db/datasource options)]
|
||||
(mg/migrate mctx +migrations+)
|
||||
nil)))
|
||||
(with-open [ctx (mg/context db/pool)]
|
||||
@(mg/migrate ctx migrations)))
|
||||
|
||||
(defstate migrations
|
||||
:start (migrate))
|
||||
|
|
|
@ -7,107 +7,105 @@
|
|||
(ns uxbox.portation
|
||||
"Support for export/import operations of projects."
|
||||
(:refer-clojure :exclude [with-open])
|
||||
(:require [clojure.java.io :as io]
|
||||
#_(:require [clojure.java.io :as io]
|
||||
[suricatta.core :as sc]
|
||||
[datoteka.core :as fs]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[uxbox.util.closeable :refer (with-open)]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.snappy :as snappy]))
|
||||
[uxbox.util.transit :as t]))
|
||||
|
||||
;; --- Export
|
||||
;; ;; --- Export
|
||||
|
||||
(defn- write-project
|
||||
[conn writer id]
|
||||
(let [sql (sql/get-project-by-id {:id id})
|
||||
result (sc/fetch-one conn sql)]
|
||||
(when-not result
|
||||
(ex-info "No project found with specified id" {:id id}))
|
||||
(t/write! writer {::type ::project ::payload result})))
|
||||
;; (defn- write-project
|
||||
;; [conn writer id]
|
||||
;; (let [sql (sql/get-project-by-id {:id id})
|
||||
;; result (sc/fetch-one conn sql)]
|
||||
;; (when-not result
|
||||
;; (ex-info "No project found with specified id" {:id id}))
|
||||
;; (t/write! writer {::type ::project ::payload result})))
|
||||
|
||||
(defn- write-pages
|
||||
[conn writer id]
|
||||
(let [sql (sql/get-pages-for-project {:project id})
|
||||
results (sc/fetch conn sql)]
|
||||
(run! #(t/write! writer {::type ::page ::payload %}) results)))
|
||||
;; (defn- write-pages
|
||||
;; [conn writer id]
|
||||
;; (let [sql (sql/get-pages-for-project {:project id})
|
||||
;; results (sc/fetch conn sql)]
|
||||
;; (run! #(t/write! writer {::type ::page ::payload %}) results)))
|
||||
|
||||
(defn- write-pages-history
|
||||
[conn writer id]
|
||||
(let [sql (sql/get-page-history-for-project {:project id})
|
||||
results (sc/fetch conn sql)]
|
||||
(run! #(t/write! writer {::type ::page-history ::payload %}) results)))
|
||||
;; (defn- write-pages-history
|
||||
;; [conn writer id]
|
||||
;; (let [sql (sql/get-page-history-for-project {:project id})
|
||||
;; results (sc/fetch conn sql)]
|
||||
;; (run! #(t/write! writer {::type ::page-history ::payload %}) results)))
|
||||
|
||||
(defn- write-data
|
||||
[path id]
|
||||
(with-open [ostream (io/output-stream path)
|
||||
zstream (snappy/output-stream ostream)
|
||||
conn (db/connection)]
|
||||
(let [writer (t/writer zstream {:type :msgpack})]
|
||||
(sc/atomic conn
|
||||
(write-project conn writer id)
|
||||
(write-pages conn writer id)
|
||||
(write-pages-history conn writer id)))))
|
||||
;; (defn- write-data
|
||||
;; [path id]
|
||||
;; (with-open [ostream (io/output-stream path)
|
||||
;; zstream (snappy/output-stream ostream)
|
||||
;; conn (db/connection)]
|
||||
;; (let [writer (t/writer zstream {:type :msgpack})]
|
||||
;; (sc/atomic conn
|
||||
;; (write-project conn writer id)
|
||||
;; (write-pages conn writer id)
|
||||
;; (write-pages-history conn writer id)))))
|
||||
|
||||
(defn export
|
||||
"Given an id, returns a path to a temporal file with the exported
|
||||
bundle of the specified project."
|
||||
[id]
|
||||
(let [path (fs/create-tempfile)]
|
||||
(write-data path id)
|
||||
path))
|
||||
;; (defn export
|
||||
;; "Given an id, returns a path to a temporal file with the exported
|
||||
;; bundle of the specified project."
|
||||
;; [id]
|
||||
;; (let [path (fs/create-tempfile)]
|
||||
;; (write-data path id)
|
||||
;; path))
|
||||
|
||||
;; --- Import
|
||||
;; ;; --- Import
|
||||
|
||||
(defn- read-entry
|
||||
[reader]
|
||||
(try
|
||||
(t/read! reader)
|
||||
(catch RuntimeException e
|
||||
(let [cause (.getCause e)]
|
||||
(if (instance? java.io.EOFException cause)
|
||||
::eof
|
||||
(throw e))))))
|
||||
;; (defn- read-entry
|
||||
;; [reader]
|
||||
;; (try
|
||||
;; (t/read! reader)
|
||||
;; (catch RuntimeException e
|
||||
;; (let [cause (.getCause e)]
|
||||
;; (if (instance? java.io.EOFException cause)
|
||||
;; ::eof
|
||||
;; (throw e))))))
|
||||
|
||||
(defn- persist-project
|
||||
[conn project]
|
||||
(let [sql (sql/create-project project)]
|
||||
(sc/execute conn sql)))
|
||||
;; (defn- persist-project
|
||||
;; [conn project]
|
||||
;; (let [sql (sql/create-project project)]
|
||||
;; (sc/execute conn sql)))
|
||||
|
||||
(defn- persist-page
|
||||
[conn page]
|
||||
(let [sql (sql/create-page page)]
|
||||
(sc/execute conn sql)))
|
||||
;; (defn- persist-page
|
||||
;; [conn page]
|
||||
;; (let [sql (sql/create-page page)]
|
||||
;; (sc/execute conn sql)))
|
||||
|
||||
(defn- persist-page-history
|
||||
[conn history]
|
||||
(let [sql (sql/create-page-history history)]
|
||||
(sc/execute conn sql)))
|
||||
;; (defn- persist-page-history
|
||||
;; [conn history]
|
||||
;; (let [sql (sql/create-page-history history)]
|
||||
;; (sc/execute conn sql)))
|
||||
|
||||
(defn- persist-entry
|
||||
[conn entry]
|
||||
(let [payload (::payload entry)
|
||||
type (::type entry)]
|
||||
(case type
|
||||
::project (persist-project conn payload)
|
||||
::page (persist-page conn payload)
|
||||
::page-history (persist-page-history conn payload))))
|
||||
;; (defn- persist-entry
|
||||
;; [conn entry]
|
||||
;; (let [payload (::payload entry)
|
||||
;; type (::type entry)]
|
||||
;; (case type
|
||||
;; ::project (persist-project conn payload)
|
||||
;; ::page (persist-page conn payload)
|
||||
;; ::page-history (persist-page-history conn payload))))
|
||||
|
||||
(defn- read-data
|
||||
[conn reader]
|
||||
(loop [entry (read-entry reader)]
|
||||
(when (not= entry ::eof)
|
||||
(persist-entry conn entry)
|
||||
(recur (read-entry reader)))))
|
||||
;; (defn- read-data
|
||||
;; [conn reader]
|
||||
;; (loop [entry (read-entry reader)]
|
||||
;; (when (not= entry ::eof)
|
||||
;; (persist-entry conn entry)
|
||||
;; (recur (read-entry reader)))))
|
||||
|
||||
(defn import!
|
||||
"Given a path to the previously exported bundle, try to import it."
|
||||
[path]
|
||||
(with-open [istream (io/input-stream (fs/path path))
|
||||
zstream (snappy/input-stream istream)
|
||||
conn (db/connection)]
|
||||
(let [reader (t/reader zstream {:type :msgpack})]
|
||||
(sc/atomic conn
|
||||
(read-data conn reader)
|
||||
nil))))
|
||||
;; (defn import!
|
||||
;; "Given a path to the previously exported bundle, try to import it."
|
||||
;; [path]
|
||||
;; (with-open [istream (io/input-stream (fs/path path))
|
||||
;; zstream (snappy/input-stream istream)
|
||||
;; conn (db/connection)]
|
||||
;; (let [reader (t/reader zstream {:type :msgpack})]
|
||||
;; (sc/atomic conn
|
||||
;; (read-data conn reader)
|
||||
;; nil))))
|
||||
|
|
|
@ -1,23 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.scheduled-jobs
|
||||
"Time-based scheduled jobs."
|
||||
(:require [mount.core :as mount :refer (defstate)]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.db]
|
||||
[uxbox.util.quartz :as qtz]))
|
||||
|
||||
(defn- initialize
|
||||
[]
|
||||
(let [nss #{'uxbox.scheduled-jobs.garbage
|
||||
'uxbox.scheduled-jobs.emails}]
|
||||
(-> (qtz/scheduler)
|
||||
(qtz/start! {:search-on nss}))))
|
||||
|
||||
(defstate scheduler
|
||||
:start (initialize)
|
||||
:stop (qtz/stop! scheduler))
|
|
@ -1,133 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.scheduled-jobs.emails
|
||||
"Email sending async tasks."
|
||||
(:require [clojure.tools.logging :as log]
|
||||
[suricatta.core :as sc]
|
||||
[postal.core :as postal]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.util.quartz :as qtz]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.data :as data]))
|
||||
|
||||
;; --- Impl details
|
||||
|
||||
(defn- decode-email-data
|
||||
[{:keys [data] :as result}]
|
||||
(merge result (when data
|
||||
{:data (-> data blob/decode t/decode)})))
|
||||
|
||||
(defn- fetch-pending-emails
|
||||
[conn]
|
||||
(let [sqlv (sql/get-pending-emails)]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize-attrs)
|
||||
(map decode-email-data))))
|
||||
|
||||
(defn- fetch-immediate-emails
|
||||
[conn]
|
||||
(let [sqlv (sql/get-immediate-emails)]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize-attrs)
|
||||
(map decode-email-data))))
|
||||
|
||||
(defn- fetch-failed-emails
|
||||
[conn]
|
||||
(let [sqlv (sql/get-pending-emails)]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize-attrs)
|
||||
(map decode-email-data))))
|
||||
|
||||
(defn- mark-email-as-sent
|
||||
[conn id]
|
||||
(let [sqlv (sql/mark-email-as-sent {:id id})]
|
||||
(sc/execute conn sqlv)))
|
||||
|
||||
(defn- mark-email-as-failed
|
||||
[conn id]
|
||||
(let [sqlv (sql/mark-email-as-failed {:id id})]
|
||||
(sc/execute conn sqlv)))
|
||||
|
||||
(defn- send-email-to-console
|
||||
[{:keys [id data] :as entry}]
|
||||
(println "******** start email:" id "**********")
|
||||
(println (->> (:body data)
|
||||
(filter #(= (:uxbox.emails.core/type %) :text/plain))
|
||||
(first)
|
||||
(:content)))
|
||||
(println "********** end email:" id "**********")
|
||||
{:error :SUCCESS})
|
||||
|
||||
(defn- get-smtp-config
|
||||
[config]
|
||||
{:host (:smtp-host config)
|
||||
:port (:smtp-port config)
|
||||
:user (:smtp-user config)
|
||||
:pass (:smtp-password config)
|
||||
:ssl (:smtp-ssl config)
|
||||
:tls (:smtp-tls config)
|
||||
:noop (not (:smtp-enabled config))})
|
||||
|
||||
(defn- send-email
|
||||
[{:keys [id data] :as entry}]
|
||||
(let [config (get-smtp-config cfg/config)
|
||||
result (if (:noop config)
|
||||
(send-email-to-console entry)
|
||||
(postal/send-message config data))]
|
||||
(if (= (:error result) :SUCCESS)
|
||||
(log/debug "Message" id "sent successfully.")
|
||||
(log/warn "Message" id "failed with:" (:message result)))
|
||||
(if (= (:error result) :SUCCESS)
|
||||
true
|
||||
false)))
|
||||
|
||||
(defn- send-emails
|
||||
[conn entries]
|
||||
(loop [entries entries]
|
||||
(if-let [entry (first entries)]
|
||||
(do (if (send-email entry)
|
||||
(mark-email-as-sent conn (:id entry))
|
||||
(mark-email-as-failed conn (:id entry)))
|
||||
(recur (rest entries))))))
|
||||
|
||||
;; --- Jobs
|
||||
|
||||
(defn send-immediate-emails
|
||||
{::qtz/interval (* 60 1 1000) ;; every 1min
|
||||
::qtz/repeat? true
|
||||
::qtz/job true}
|
||||
[]
|
||||
(log/info "task-send-immediate-emails...")
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/atomic conn
|
||||
(->> (fetch-immediate-emails conn)
|
||||
(send-emails conn)))))
|
||||
|
||||
(defn send-pending-emails
|
||||
{::qtz/interval (* 60 5 1000) ;; every 5min
|
||||
::qtz/repeat? true
|
||||
::qtz/job true}
|
||||
[]
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/atomic conn
|
||||
(->> (fetch-pending-emails conn)
|
||||
(send-emails conn)))))
|
||||
|
||||
(defn send-failed-emails
|
||||
"Job that resends failed to send messages."
|
||||
{::qtz/interval (* 60 5 1000) ;; every 5min
|
||||
::qtz/repeat? true
|
||||
::qtz/job true}
|
||||
[]
|
||||
(log/info "task-send-failed-emails...")
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/atomic conn
|
||||
(->> (fetch-failed-emails conn)
|
||||
(send-emails conn)))))
|
|
@ -1,28 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.scheduled-jobs.garbage
|
||||
"Garbage Collector related tasks."
|
||||
(:require [suricatta.core :as sc]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.util.quartz :as qtz]))
|
||||
|
||||
;; --- Delete projects
|
||||
|
||||
;; TODO: move inline sql into resources/sql directory
|
||||
|
||||
(defn clean-deleted-projects
|
||||
"Task that cleans the deleted projects."
|
||||
{::qtz/repeat? true
|
||||
::qtz/interval (* 1000 3600 24)
|
||||
::qtz/job true}
|
||||
[]
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/atomic conn
|
||||
(let [sql (str "DELETE FROM projects "
|
||||
" WHERE deleted_at is not null AND "
|
||||
" (now()-deleted_at)::interval > '10 day'::interval;")]
|
||||
(sc/execute conn sql)))))
|
|
@ -1,61 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services
|
||||
"Main namespace for access to all uxbox services."
|
||||
(:require [suricatta.core :as sc]
|
||||
[executors.core :as exec]
|
||||
[promesa.core :as p]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.services.core :as core]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.blob :as blob]))
|
||||
|
||||
;; Load relevant subnamespaces with the implementation
|
||||
(load "services/auth")
|
||||
(load "services/projects")
|
||||
(load "services/pages")
|
||||
(load "services/images")
|
||||
(load "services/icons")
|
||||
(load "services/kvstore")
|
||||
|
||||
;; --- Implementation
|
||||
|
||||
(def ^:private encode (comp blob/encode t/encode))
|
||||
|
||||
(defn- insert-txlog
|
||||
[data]
|
||||
(with-open [conn (db/connection)]
|
||||
(let [sql (str "INSERT INTO txlog (payload) VALUES (?)")
|
||||
sqlv [sql (encode data)]]
|
||||
(sc/execute conn sqlv))))
|
||||
|
||||
(defn- handle-novelty
|
||||
[data]
|
||||
(let [rs (core/novelty data)
|
||||
rs (if (p/promise? rs) rs (p/resolved rs))]
|
||||
(p/map (fn [v]
|
||||
(insert-txlog data)
|
||||
v) rs)))
|
||||
|
||||
(defn- handle-query
|
||||
[data]
|
||||
(let [result (core/query data)]
|
||||
(if (p/promise? result)
|
||||
result
|
||||
(p/resolved result))))
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(defn novelty
|
||||
[data]
|
||||
(->> (exec/submit (partial handle-novelty data))
|
||||
(p/mapcat identity)))
|
||||
|
||||
(defn query
|
||||
[data]
|
||||
(->> (exec/submit (partial handle-query data))
|
||||
(p/mapcat identity)))
|
|
@ -2,30 +2,49 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services.auth
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[suricatta.core :as sc]
|
||||
[buddy.hashers :as hashers]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.services.core :as core]
|
||||
[uxbox.services.users :as users]
|
||||
[uxbox.util.exceptions :as ex]))
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[buddy.hashers :as hashers]
|
||||
[promesa.core :as p]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.services.core :as sc]
|
||||
[uxbox.services.users :as users]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.exceptions :as ex]))
|
||||
|
||||
(defn- check-user-password
|
||||
[user password]
|
||||
(hashers/check password (:password user)))
|
||||
(s/def ::username ::us/string)
|
||||
(s/def ::password ::us/string)
|
||||
(s/def ::scope ::us/string)
|
||||
|
||||
(defmethod core/novelty :login
|
||||
(s/def ::login-params
|
||||
(s/keys :req-un [::username ::password]
|
||||
:opt-un [::scope]))
|
||||
|
||||
(def ^:private user-by-username-sql
|
||||
"select id, password
|
||||
from users
|
||||
where username=$1 or email=$1
|
||||
and deleted_at is null")
|
||||
|
||||
(sc/defmutation :login
|
||||
{:doc "User login"
|
||||
:spec ::login-params}
|
||||
[{:keys [username password scope] :as params}]
|
||||
(with-open [conn (db/connection)]
|
||||
(let [user (users/find-user-by-username-or-email conn username)]
|
||||
(when-not user
|
||||
(ex/raise :type :validation
|
||||
:code ::wrong-credentials))
|
||||
(when-not (check-user-password user password)
|
||||
(ex/raise :type :validation
|
||||
:code ::wrong-credentials))
|
||||
user)))
|
||||
(letfn [(check-password [user password]
|
||||
(hashers/check password (:password user)))
|
||||
|
||||
(check-user [user]
|
||||
(when-not user
|
||||
(ex/raise :type :validation
|
||||
:code ::wrong-credentials))
|
||||
(when-not (check-password user password)
|
||||
(ex/raise :type :validation
|
||||
:code ::wrong-credentials))
|
||||
(:id user))]
|
||||
|
||||
(-> (db/query-one db/pool [user-by-username-sql username])
|
||||
(p/then' check-user))))
|
||||
|
|
|
@ -2,26 +2,70 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services.core
|
||||
(:require [clojure.walk :as walk]
|
||||
[cuerdas.core :as str]
|
||||
[uxbox.util.exceptions :as ex]))
|
||||
(:require
|
||||
[clojure.tools.logging :as log]
|
||||
[promesa.core :as p]
|
||||
[vertx.core :as vc]
|
||||
[uxbox.core :refer [system]]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[uxbox.util.dispatcher :as uds]
|
||||
[uxbox.util.exceptions :as ex])
|
||||
(:import
|
||||
java.util.Map
|
||||
java.util.List
|
||||
java.util.Map$Entry
|
||||
java.util.HashMap))
|
||||
|
||||
(defmulti novelty :type)
|
||||
(def context-interceptor
|
||||
{:enter (fn [data]
|
||||
(update data :request assoc ::ctx (vc/get-or-create-context system)))})
|
||||
|
||||
(defmulti query :type)
|
||||
(def logging-interceptor
|
||||
{:enter (fn [data]
|
||||
(let [type (get-in data [:request ::type])]
|
||||
(assoc data ::start-time (System/nanoTime))))
|
||||
:leave (fn [data]
|
||||
(let [elapsed (- (System/nanoTime) (::start-time data))
|
||||
elapsed (str (quot elapsed 1000000) "ms")
|
||||
type (get-in data [:request ::type])]
|
||||
(log/info "service" type "processed in" elapsed)
|
||||
data))})
|
||||
|
||||
(defmethod novelty :default
|
||||
[{:keys [type] :as data}]
|
||||
(ex/raise :code ::not-implemented
|
||||
:message-category :novelty
|
||||
:message-type type))
|
||||
|
||||
(defmethod query :default
|
||||
[{:keys [type] :as data}]
|
||||
(ex/raise :code ::not-implemented
|
||||
:message-category :query
|
||||
:message-type type))
|
||||
(uds/defservice query
|
||||
{:dispatch-by ::type
|
||||
:interceptors [uds/spec-interceptor
|
||||
logging-interceptor
|
||||
#_context-interceptor]})
|
||||
|
||||
(uds/defservice mutation
|
||||
{:dispatch-by ::type
|
||||
:interceptors [uds/spec-interceptor
|
||||
#_context-interceptor]})
|
||||
|
||||
;; --- Helpers
|
||||
|
||||
(defmacro defmutation
|
||||
[key & rest]
|
||||
`(uds/defmethod mutation ~key ~@rest))
|
||||
|
||||
(defmacro defquery
|
||||
[key & rest]
|
||||
`(uds/defmethod query ~key ~@rest))
|
||||
|
||||
(defn raise-not-found-if-nil
|
||||
[v]
|
||||
(if (nil? v)
|
||||
(ex/raise :type :not-found
|
||||
:hint "Object doest not exists.")
|
||||
v))
|
||||
|
||||
(def constantly-nil (constantly nil))
|
||||
|
||||
(defn handle-on-context
|
||||
[p]
|
||||
(->> (vc/get-or-create-context system)
|
||||
(vc/handle-on-context p)))
|
||||
|
|
|
@ -2,226 +2,236 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services.icons
|
||||
"Icons library related services."
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[suricatta.core :as sc]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.services.core :as core]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.data :as data])
|
||||
(:import org.apache.commons.io.FilenameUtils))
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.services.core :as sv]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
;; --- Helpers & Specs
|
||||
|
||||
(s/def ::user uuid?)
|
||||
(s/def ::collection (s/nilable uuid?))
|
||||
(s/def ::width (s/and number? pos?))
|
||||
(s/def ::height (s/and number? pos?))
|
||||
(s/def ::view-box (s/and (s/coll-of number?)
|
||||
#(= 4 (count %))
|
||||
vector?))
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::name ::us/string)
|
||||
(s/def ::user ::us/uuid)
|
||||
(s/def ::collection-id (s/nilable ::us/uuid))
|
||||
(s/def ::width ::us/integer)
|
||||
(s/def ::height ::us/integer)
|
||||
|
||||
(s/def ::view-box
|
||||
(s/and (s/coll-of number?)
|
||||
#(= 4 (count %))
|
||||
vector?))
|
||||
|
||||
(s/def ::content ::us/string)
|
||||
(s/def ::mimetype ::us/string)
|
||||
|
||||
(s/def ::content string?)
|
||||
(s/def ::mimetype string?)
|
||||
(s/def ::metadata
|
||||
(s/keys :opt-un [::width ::height ::view-box ::mimetype]))
|
||||
|
||||
(defn decode-metadata
|
||||
[{:keys [metadata] :as data}]
|
||||
(if metadata
|
||||
(assoc data :metadata (-> metadata blob/decode t/decode))
|
||||
data))
|
||||
(defn- decode-icon-row
|
||||
[{:keys [metadata] :as row}]
|
||||
(when row
|
||||
(cond-> row
|
||||
metadata (assoc :metadata (blob/decode metadata)))))
|
||||
|
||||
;; --- Create Collection
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Queries
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn create-collection
|
||||
[conn {:keys [id user name]}]
|
||||
(let [id (or id (uuid/random))
|
||||
params {:id id :user user :name name}
|
||||
sqlv (sql/create-icon-collection params)]
|
||||
(-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize))))
|
||||
;; --- Query: Collections
|
||||
|
||||
(s/def ::create-icon-collection
|
||||
(s/keys :req-un [::user ::us/name]
|
||||
:opt-un [::us/id]))
|
||||
(def ^:private icons-collections-sql
|
||||
"select *,
|
||||
(select count(*) from icons where collection_id = ic.id) as num_icons
|
||||
from icons_collections as ic
|
||||
where (ic.user_id = $1 or
|
||||
ic.user_id = '00000000-0000-0000-0000-000000000000'::uuid)
|
||||
and ic.deleted_at is null
|
||||
order by ic.created_at desc")
|
||||
|
||||
(defmethod core/novelty :create-icon-collection
|
||||
[params]
|
||||
(s/assert ::create-icon-collection params)
|
||||
(with-open [conn (db/connection)]
|
||||
(create-collection conn params)))
|
||||
(s/def ::icons-collections
|
||||
(s/keys :req-un [::user]))
|
||||
|
||||
;; --- Update Collection
|
||||
|
||||
(defn update-collection
|
||||
[conn {:keys [id user name version]}]
|
||||
(let [sqlv (sql/update-icon-collection {:id id
|
||||
:user user
|
||||
:name name
|
||||
:version version})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize))))
|
||||
|
||||
(s/def ::update-icon-collection
|
||||
(s/keys :req-un [::user ::us/name ::us/version]
|
||||
:opt-un [::us/id]))
|
||||
|
||||
(defmethod core/novelty :update-icon-collection
|
||||
[params]
|
||||
(s/assert ::update-icon-collection params)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn update-collection params)))
|
||||
|
||||
;; --- Copy Icon
|
||||
|
||||
(s/def ::copy-icon
|
||||
(s/keys :req-un [:us/id ::collection ::user]))
|
||||
|
||||
(defn- retrieve-icon
|
||||
[conn {:keys [user id]}]
|
||||
(let [sqlv (sql/get-icon {:user user :id id})]
|
||||
(some->> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
|
||||
(declare create-icon)
|
||||
|
||||
(defn- copy-icon
|
||||
[conn {:keys [user id collection]}]
|
||||
(let [icon (retrieve-icon conn {:id id :user user})]
|
||||
(when-not icon
|
||||
(ex/raise :type :validation
|
||||
:code ::icon-does-not-exists))
|
||||
(let [params (dissoc icon :id)]
|
||||
(create-icon conn params))))
|
||||
|
||||
(defmethod core/novelty :copy-icon
|
||||
[params]
|
||||
(s/assert ::copy-icon params)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn copy-icon params)))
|
||||
|
||||
;; --- List Collections
|
||||
|
||||
(defn get-collections-by-user
|
||||
[conn user]
|
||||
(let [sqlv (sql/get-icon-collections {:user user})]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize))))
|
||||
|
||||
(defmethod core/query :list-icon-collections
|
||||
(sv/defquery :icons-collections
|
||||
{:doc "Retrieve all icons collections for current user."
|
||||
:spec ::icons-collections}
|
||||
[{:keys [user] :as params}]
|
||||
(s/assert ::user user)
|
||||
(with-open [conn (db/connection)]
|
||||
(get-collections-by-user conn user)))
|
||||
|
||||
;; --- Delete Collection
|
||||
|
||||
(defn delete-collection
|
||||
[conn {:keys [id user]}]
|
||||
(let [sqlv (sql/delete-icon-collection {:id id :user user})]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
|
||||
(s/def ::delete-icon-collection
|
||||
(s/keys :req-un [::user]
|
||||
:opt-un [::us/id]))
|
||||
|
||||
(defmethod core/novelty :delete-icon-collection
|
||||
[params]
|
||||
(s/assert ::delete-icon-collection params)
|
||||
(with-open [conn (db/connection)]
|
||||
(delete-collection conn params)))
|
||||
|
||||
;; --- Create Icon (Upload)
|
||||
|
||||
(defn create-icon
|
||||
[conn {:keys [id user name collection
|
||||
metadata content] :as params}]
|
||||
(let [id (or id (uuid/random))
|
||||
params {:id id
|
||||
:name name
|
||||
:content content
|
||||
:metadata (-> metadata t/encode blob/encode)
|
||||
:collection collection
|
||||
:user user}
|
||||
sqlv (sql/create-icon params)]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize)
|
||||
(decode-metadata))))
|
||||
|
||||
(s/def ::create-icon
|
||||
(s/keys :req-un [::user ::us/name ::metadata ::content]
|
||||
:opt-un [::us/id ::collection]))
|
||||
|
||||
(defmethod core/novelty :create-icon
|
||||
[params]
|
||||
(s/assert ::create-icon params)
|
||||
(with-open [conn (db/connection)]
|
||||
(create-icon conn params)))
|
||||
|
||||
;; --- Update Icon
|
||||
|
||||
(defn update-icon
|
||||
[conn {:keys [id name version user collection]}]
|
||||
(let [sqlv (sql/update-icon {:id id
|
||||
:collection collection
|
||||
:name name
|
||||
:user user
|
||||
:version version})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize)
|
||||
(decode-metadata))))
|
||||
|
||||
(s/def ::update-icon
|
||||
(s/keys :req-un [::us/id ::user ::us/name ::us/version ::collection]))
|
||||
|
||||
(defmethod core/novelty :update-icon
|
||||
[params]
|
||||
(s/assert ::update-icon params)
|
||||
(with-open [conn (db/connection)]
|
||||
(update-icon conn params)))
|
||||
|
||||
;; --- Delete Icon
|
||||
|
||||
(defn delete-icon
|
||||
[conn {:keys [user id]}]
|
||||
(let [sqlv (sql/delete-icon {:id id :user user})]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
|
||||
(s/def ::delete-icon
|
||||
(s/keys :req-un [::user]
|
||||
:opt-un [::us/id]))
|
||||
|
||||
(defmethod core/novelty :delete-icon
|
||||
[params]
|
||||
(s/assert ::delete-icon params)
|
||||
(with-open [conn (db/connection)]
|
||||
(delete-icon conn params)))
|
||||
(let [sqlv [icons-collections-sql user]]
|
||||
(db/query db/pool sqlv)))
|
||||
|
||||
;; --- List Icons
|
||||
|
||||
(defn get-icons-by-user
|
||||
[conn user collection]
|
||||
(let [sqlv (if collection
|
||||
(sql/get-icons-by-collection {:user user :collection collection})
|
||||
(sql/get-icons {:user user}))]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize)
|
||||
(map decode-metadata))))
|
||||
(def ^:private icons-by-collection-sql
|
||||
"select *
|
||||
from icons as i
|
||||
where (i.user_id = $1 or
|
||||
i.user_id = '00000000-0000-0000-0000-000000000000'::uuid)
|
||||
and i.deleted_at is null
|
||||
and case when $2::uuid is null then i.collection_id is null
|
||||
else i.collection_id = $2::uuid
|
||||
end
|
||||
order by i.created_at desc")
|
||||
|
||||
(s/def ::list-icons
|
||||
(s/keys :req-un [::user ::collection]))
|
||||
(s/def ::icons-by-collection
|
||||
(s/keys :req-un [::user]
|
||||
:opt-un [::collection-id]))
|
||||
|
||||
(defmethod core/query :list-icons
|
||||
[{:keys [user collection] :as params}]
|
||||
(s/assert ::list-icons params)
|
||||
(with-open [conn (db/connection)]
|
||||
(get-icons-by-user conn user collection)))
|
||||
(sv/defquery :icons-by-collection
|
||||
{:doc "Retrieve icons for specified collection."
|
||||
:spec ::icons-by-collection}
|
||||
[{:keys [user collection-id] :as params}]
|
||||
(let [sqlv [icons-by-collection-sql user collection-id]]
|
||||
(-> (db/query db/pool sqlv)
|
||||
(p/then' #(mapv decode-icon-row %)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Mutations
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- Mutation: Create Collection
|
||||
|
||||
(s/def ::create-icons-collection
|
||||
(s/keys :req-un [::user ::name]
|
||||
:opt-un [::id]))
|
||||
|
||||
(sv/defmutation :create-icons-collection
|
||||
{:doc "Create a new collection of icons."
|
||||
:spec ::create-icons-collection}
|
||||
[{:keys [id user name] :as params}]
|
||||
(let [id (or id (uuid/next))
|
||||
sql "insert into icons_collections (id, user_id, name)
|
||||
values ($1, $2, $3) returning *"]
|
||||
(db/query-one db/pool [sql id user name])))
|
||||
|
||||
;; --- Mutation: Update Collection
|
||||
|
||||
(s/def ::update-icons-collection
|
||||
(s/keys :req-un [::user ::name ::id]))
|
||||
|
||||
(sv/defmutation :update-icons-collection
|
||||
{:doc "Update a collection of icons."
|
||||
:spec ::update-icons-collection}
|
||||
[{:keys [id user name] :as params}]
|
||||
(let [sql "update icons_collections
|
||||
set name = $3
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
returning *"]
|
||||
(-> (db/query-one db/pool [sql id user name])
|
||||
(p/then' sv/raise-not-found-if-nil))))
|
||||
|
||||
;; --- Copy Icon
|
||||
|
||||
(declare create-icon)
|
||||
|
||||
(defn- retrieve-icon
|
||||
[conn {:keys [user id]}]
|
||||
(let [sql "select * from icons
|
||||
where id = $1
|
||||
and deleted_at is null
|
||||
and (user_id = $2 or
|
||||
user_id = '00000000-0000-0000-0000-000000000000'::uuid)"]
|
||||
(-> (db/query-one conn [sql id user])
|
||||
(p/then' sv/raise-not-found-if-nil))))
|
||||
|
||||
(s/def ::copy-icon
|
||||
(s/keys :req-un [:us/id ::collection-id ::user]))
|
||||
|
||||
(sv/defmutation :copy-icon
|
||||
{:doc "Copy an icon from one collection to other."
|
||||
:spec ::copy-icon}
|
||||
[{:keys [user id collection-id] :as params}]
|
||||
(db/with-atomic [conn db/pool]
|
||||
(-> (retrieve-icon conn {:user user :id id})
|
||||
(p/then (fn [icon]
|
||||
(let [icon (-> (dissoc icon :id)
|
||||
(assoc :collection-id collection-id))]
|
||||
(create-icon conn icon)))))))
|
||||
|
||||
;; --- Delete Collection
|
||||
|
||||
(s/def ::delete-icons-collection
|
||||
(s/keys :req-un [::user ::id]))
|
||||
|
||||
(sv/defmutation :delete-icons-collection
|
||||
{:doc "Delete a collection of icons."
|
||||
:spec ::delete-icons-collection}
|
||||
[{:keys [user id] :as params}]
|
||||
(let [sql "update icons_collections
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
returning id"]
|
||||
(-> (db/query-one db/pool [sql id user])
|
||||
(p/then' sv/raise-not-found-if-nil)
|
||||
(p/then' sv/constantly-nil))))
|
||||
|
||||
;; --- Mutation: Create Icon (Upload)
|
||||
|
||||
(def ^:private create-icon-sql
|
||||
"insert into icons (user_id, name, collection_id, content, metadata)
|
||||
values ($1, $2, $3, $4, $5) returning *")
|
||||
|
||||
(defn create-icon
|
||||
[conn {:keys [id user name collection-id metadata content]}]
|
||||
(let [id (or id (uuid/next))
|
||||
sqlv [create-icon-sql user name
|
||||
collection-id
|
||||
content
|
||||
(blob/encode metadata)]]
|
||||
(-> (db/query-one conn sqlv)
|
||||
(p/then' decode-icon-row))))
|
||||
|
||||
(s/def ::create-icon
|
||||
(s/keys :req-un [::user ::name ::metadata ::content]
|
||||
:opt-un [::id ::collection-id]))
|
||||
|
||||
(sv/defmutation :create-icon
|
||||
{:doc "Create (upload) a new icon."
|
||||
:spec ::create-icon}
|
||||
[params]
|
||||
(create-icon db/pool params))
|
||||
|
||||
;; --- Mutation: Update Icon
|
||||
|
||||
(s/def ::update-icon
|
||||
(s/keys :req-un [::id ::user ::name ::collection-id]))
|
||||
|
||||
(sv/defmutation :update-icon
|
||||
{:doc "Update an icon entry."
|
||||
:spec ::update-icon}
|
||||
[{:keys [id name user collection-id] :as params}]
|
||||
(let [sql "update icons
|
||||
set name = $1,
|
||||
collection_id = $2
|
||||
where id = $3
|
||||
and user_id = $4
|
||||
returning *"]
|
||||
(-> (db/query-one db/pool [sql name collection-id id user])
|
||||
(p/then' sv/raise-not-found-if-nil))))
|
||||
|
||||
;; --- Mutation: Delete Icon
|
||||
|
||||
(s/def ::delete-icon
|
||||
(s/keys :req-un [::user ::id]))
|
||||
|
||||
(sv/defmutation :delete-icon
|
||||
{:doc "Delete an icon entry."
|
||||
:spec ::delete-icon}
|
||||
[{:keys [id user] :as params}]
|
||||
(let [sql "update icons
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
returning id"]
|
||||
(-> (db/query-one db/pool [sql id user])
|
||||
(p/then' sv/raise-not-found-if-nil)
|
||||
(p/then' sv/constantly-nil))))
|
||||
|
|
|
@ -2,241 +2,274 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services.images
|
||||
"Images library related services."
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[suricatta.core :as sc]
|
||||
[datoteka.storages :as st]
|
||||
[datoteka.core :as fs]
|
||||
[uxbox.config :as ucfg]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.services.core :as core]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[uxbox.util.data :as data])
|
||||
(:import org.apache.commons.io.FilenameUtils))
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[datoteka.core :as fs]
|
||||
[datoteka.storages :as ds]
|
||||
[promesa.core :as p]
|
||||
[promesa.exec :as px]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.images :as images]
|
||||
[uxbox.services.core :as sc]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.data :as data]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[vertx.core :as vc]))
|
||||
|
||||
(s/def ::width integer?)
|
||||
(s/def ::height integer?)
|
||||
(s/def ::mimetype string?)
|
||||
(s/def ::user uuid?)
|
||||
(s/def ::path string?)
|
||||
(s/def ::collection (s/nilable uuid?))
|
||||
(def +thumbnail-options+
|
||||
{:src :path
|
||||
:dst :thumbnail
|
||||
:width 300
|
||||
:height 100
|
||||
:quality 92
|
||||
:format "webp"})
|
||||
|
||||
(defn- populate-thumbnail
|
||||
[row]
|
||||
(let [opts +thumbnail-options+]
|
||||
(-> (px/submit! #(images/populate-thumbnails row opts))
|
||||
(sc/handle-on-context))))
|
||||
|
||||
(defn- populate-thumbnails
|
||||
[rows]
|
||||
(if (empty? rows)
|
||||
rows
|
||||
(p/all (map populate-thumbnail rows))))
|
||||
|
||||
(defn- populate-urls
|
||||
[row]
|
||||
(images/populate-urls row media/images-storage :path :url))
|
||||
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::name ::us/string)
|
||||
(s/def ::user ::us/uuid)
|
||||
(s/def ::collection-id (s/nilable ::us/uuid))
|
||||
|
||||
;; --- Create Collection
|
||||
|
||||
(defn create-collection
|
||||
[conn {:keys [id user name]}]
|
||||
(let [id (or id (uuid/random))
|
||||
params {:id id :user user :name name}
|
||||
sqlv (sql/create-image-collection params)]
|
||||
(-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
|
||||
(s/def ::create-image-collection
|
||||
(s/keys :req-un [::user ::us/name]
|
||||
:opt-un [::us/id]))
|
||||
:opt-un [::id]))
|
||||
|
||||
(defmethod core/novelty :create-image-collection
|
||||
[params]
|
||||
(s/assert ::create-image-collection params)
|
||||
(with-open [conn (db/connection)]
|
||||
(create-collection conn params)))
|
||||
(sc/defmutation :create-image-collection
|
||||
{:doc "Create image collection"
|
||||
:spec ::create-image-collection}
|
||||
[{:keys [id user name] :as params}]
|
||||
(let [sql "insert into images_collections (id, user_id, name)
|
||||
values ($1, $2, $3) returning *;"]
|
||||
(db/query-one db/pool [sql (or id (uuid/next)) user name])))
|
||||
|
||||
;; --- Update Collection
|
||||
|
||||
(defn update-collection
|
||||
[conn {:keys [id user name version]}]
|
||||
(let [sqlv (sql/update-image-collection {:id id
|
||||
:user user
|
||||
:name name
|
||||
:version version})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
(s/def ::update-images-collection
|
||||
(s/keys :req-un [::id ::user ::us/name]))
|
||||
|
||||
(s/def ::update-image-collection
|
||||
(s/keys :req-un [::user ::us/name ::us/version]
|
||||
:opt-un [::us/id]))
|
||||
|
||||
(defmethod core/novelty :update-image-collection
|
||||
[params]
|
||||
(s/assert ::update-image-collection params)
|
||||
(with-open [conn (db/connection)]
|
||||
(update-collection conn params)))
|
||||
(sc/defmutation :update-images-collection
|
||||
{:doc "Update image collection."
|
||||
:spec ::update-images-collection}
|
||||
[{:keys [id user name] :as params}]
|
||||
(let [sql "update images_collections
|
||||
set name = $3
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
returning *;"]
|
||||
(db/query-one db/pool [sql id user name])))
|
||||
|
||||
;; --- List Collections
|
||||
|
||||
(defn get-collections-by-user
|
||||
[conn user]
|
||||
(let [sqlv (sql/get-image-collections {:user user})]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize-attrs))))
|
||||
(def ^:private images-collections-sql
|
||||
"select *,
|
||||
(select count(*) from images where collection_id = ic.id) as num_images
|
||||
from images_collections as ic
|
||||
where (ic.user_id = $1 or
|
||||
ic.user_id = '00000000-0000-0000-0000-000000000000'::uuid)
|
||||
and ic.deleted_at is null
|
||||
order by ic.created_at desc;")
|
||||
|
||||
(defmethod core/query :list-image-collections
|
||||
(sc/defquery :images-collections
|
||||
{:doc "Retrieve image collections for the current logged user"}
|
||||
[{:keys [user] :as params}]
|
||||
(s/assert ::user user)
|
||||
(with-open [conn (db/connection)]
|
||||
(get-collections-by-user conn user)))
|
||||
(db/query db/pool [images-collections-sql user]))
|
||||
|
||||
;; --- Delete Collection
|
||||
|
||||
(defn delete-collection
|
||||
[conn {:keys [id user]}]
|
||||
(let [sqlv (sql/delete-image-collection {:id id :user user})]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
(s/def ::delete-images-collection
|
||||
(s/keys :req-un [::user ::id]))
|
||||
|
||||
(s/def ::delete-image-collection
|
||||
(s/keys :req-un [::user]
|
||||
:opt-un [::us/id]))
|
||||
|
||||
(defmethod core/novelty :delete-image-collection
|
||||
[params]
|
||||
(s/assert ::delete-image-collection params)
|
||||
(with-open [conn (db/connection)]
|
||||
(delete-collection conn params)))
|
||||
(sc/defmutation :delete-images-collection
|
||||
{:doc "Delete an image collection"
|
||||
:spec ::delete-images-collection}
|
||||
[{:keys [id user] :as params}]
|
||||
(let [sql "update images_collections
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
returning id"]
|
||||
(-> (db/query-one db/pool [sql id user])
|
||||
(p/then' sc/raise-not-found-if-nil))))
|
||||
|
||||
;; --- Retrieve Image
|
||||
|
||||
(defn retrieve-image
|
||||
[conn {:keys [id]}]
|
||||
(let [sqlv (sql/get-image {:id id})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
[conn id]
|
||||
(let [sql "select * from images
|
||||
where id = $1
|
||||
and deleted_at is null;"]
|
||||
(db/query-one conn [sql id])))
|
||||
|
||||
(s/def ::retrieve-image
|
||||
(s/keys :req-un [::user ::us/id]))
|
||||
;; (s/def ::retrieve-image
|
||||
;; (s/keys :req-un [::user ::us/id]))
|
||||
|
||||
(defmethod core/query :retrieve-image
|
||||
[params]
|
||||
(s/assert ::retrieve-image params)
|
||||
(with-open [conn (db/connection)]
|
||||
(retrieve-image conn params)))
|
||||
;; (defmethod core/query :retrieve-image
|
||||
;; [params]
|
||||
;; (s/assert ::retrieve-image params)
|
||||
;; (with-open [conn (db/connection)]
|
||||
;; (retrieve-image conn params)))
|
||||
|
||||
;; --- Create Image (Upload)
|
||||
|
||||
(defn create-image
|
||||
[conn {:keys [id user name path collection
|
||||
height width mimetype]}]
|
||||
(let [id (or id (uuid/random))
|
||||
sqlv (sql/create-image {:id id
|
||||
:name name
|
||||
:mimetype mimetype
|
||||
:path path
|
||||
:width width
|
||||
:height height
|
||||
:collection collection
|
||||
:user user})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
(defn- store-image-in-fs
|
||||
[{:keys [name path] :as upload}]
|
||||
(prn "store-image-in-fs" upload)
|
||||
(let [filename (fs/name name)
|
||||
storage media/images-storage]
|
||||
(-> (ds/save storage filename path)
|
||||
(vc/handle-on-context))))
|
||||
|
||||
(def ^:private create-image-sql
|
||||
"insert into images (user_id, name, collection_id, path, width, height, mimetype)
|
||||
values ($1, $2, $3, $4, $5, $6, $7) returning *")
|
||||
|
||||
(defn- store-image-in-db
|
||||
[conn {:keys [id user name path collection-id height width mimetype]}]
|
||||
(let [sqlv [create-image-sql user name collection-id
|
||||
path width height mimetype]]
|
||||
(-> (db/query-one conn sqlv)
|
||||
(p/then populate-thumbnail)
|
||||
(p/then populate-urls))))
|
||||
|
||||
(def valid-image-types?
|
||||
#{"image/jpeg", "image/png", "image/webp"})
|
||||
|
||||
(s/def ::file ::us/upload)
|
||||
(s/def ::width ::us/integer)
|
||||
(s/def ::height ::us/integer)
|
||||
(s/def ::mimetype valid-image-types?)
|
||||
|
||||
(s/def ::create-image
|
||||
(s/keys :req-un [::user ::us/name ::path ::width ::height ::mimetype]
|
||||
:opt-un [::us/id]))
|
||||
(s/keys :req-un [::user ::name ::file ::width ::height ::mimetype]
|
||||
:opt-un [::id ::collection-id]))
|
||||
|
||||
(defmethod core/novelty :create-image
|
||||
[params]
|
||||
(s/assert ::create-image params)
|
||||
(with-open [conn (db/connection)]
|
||||
(create-image conn params)))
|
||||
(sc/defmutation :create-image
|
||||
{:doc "Create (upload) new image."
|
||||
:spec ::create-image}
|
||||
[{:keys [file] :as params}]
|
||||
(when-not (valid-image-types? (:mtype file))
|
||||
(ex/raise :type :validation
|
||||
:code :image-type-not-allowed
|
||||
:hint "Seems like you are uploading an invalid image."))
|
||||
(-> (store-image-in-fs file)
|
||||
(p/then (fn [path]
|
||||
(store-image-in-db db/pool (assoc params :path (str path)))))))
|
||||
|
||||
;; --- Update Image
|
||||
|
||||
(defn update-image
|
||||
[conn {:keys [id name version user collection]}]
|
||||
(let [sqlv (sql/update-image {:id id
|
||||
:collection collection
|
||||
:name name
|
||||
:user user
|
||||
:version version})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
|
||||
(s/def ::update-image
|
||||
(s/keys :req-un [::user ::us/name ::us/version ::collection]
|
||||
:opt-un [::us/id]))
|
||||
(s/keys :req-un [::id ::user ::name ::collection-id]))
|
||||
|
||||
(defmethod core/novelty :update-image
|
||||
[params]
|
||||
(s/assert ::update-image params)
|
||||
(with-open [conn (db/connection)]
|
||||
(update-image conn params)))
|
||||
(def ^:private update-image-sql
|
||||
"update images
|
||||
set name = $3,
|
||||
collection_id = $2
|
||||
where id = $1
|
||||
and user_id = $4
|
||||
returning *;")
|
||||
|
||||
(sc/defmutation :update-image
|
||||
{:doc "Update a image entry."
|
||||
:spec ::update-image}
|
||||
[{:keys [id name user collection-id] :as params}]
|
||||
(let [sql update-image-sql]
|
||||
(db/query-one db/pool [sql id collection-id name user])))
|
||||
|
||||
;; --- Copy Image
|
||||
|
||||
(s/def ::copy-image
|
||||
(s/keys :req-un [::us/id ::collection ::user]))
|
||||
|
||||
(declare retrieve-image)
|
||||
|
||||
(defn- copy-image
|
||||
[conn {:keys [user id collection]}]
|
||||
(let [image (retrieve-image conn {:id id :user user})
|
||||
storage media/images-storage]
|
||||
(when-not image
|
||||
(ex/raise :type :validation
|
||||
:code ::image-does-not-exists))
|
||||
(let [path @(st/lookup storage (:path image))
|
||||
filename (fs/name path)
|
||||
path @(st/save storage filename path)
|
||||
image (assoc image
|
||||
:path (str path)
|
||||
:collection collection)
|
||||
image (dissoc image :id)]
|
||||
(create-image conn image))))
|
||||
(s/def ::copy-image
|
||||
(s/keys :req-un [::id ::collection-id ::user]))
|
||||
|
||||
(defmethod core/novelty :copy-image
|
||||
[params]
|
||||
(s/assert ::copy-image params)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn copy-image params)))
|
||||
(sc/defmutation :copy-image
|
||||
{:doc "Copy image from one collection to an other."
|
||||
:spec ::copy-image}
|
||||
[{:keys [user id collection-id] :as params}]
|
||||
(letfn [(copy-image [conn {:keys [path] :as image}]
|
||||
(-> (ds/lookup media/images-storage (:path image))
|
||||
(p/then (fn [path] (ds/save media/images-storage (fs/name path) path)))
|
||||
(p/then (fn [path]
|
||||
(-> image
|
||||
(assoc :path (str path) :collection-id collection-id)
|
||||
(dissoc :id))))
|
||||
(p/then (partial store-image-in-db conn))))]
|
||||
|
||||
(db/with-atomic [conn db/pool]
|
||||
(-> (retrieve-image conn {:id id :user user})
|
||||
(p/then sc/raise-not-found-if-nil)
|
||||
(p/then (partial copy-image conn))))))
|
||||
|
||||
;; --- Delete Image
|
||||
|
||||
(defn- delete-image-from-storage
|
||||
[{:keys [path] :as image}]
|
||||
(when @(st/exists? media/images-storage path)
|
||||
@(st/delete media/images-storage path))
|
||||
(when @(st/exists? media/thumbnails-storage path)
|
||||
@(st/delete media/thumbnails-storage path)))
|
||||
|
||||
(defn delete-image
|
||||
[conn {:keys [user id]}]
|
||||
(let [sqlv (sql/delete-image {:id id :user user})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(delete-image-from-storage))))
|
||||
;; TODO: this need to be performed in the GC process
|
||||
;; (defn- delete-image-from-storage
|
||||
;; [{:keys [path] :as image}]
|
||||
;; (when @(ds/exists? media/images-storage path)
|
||||
;; @(ds/delete media/images-storage path))
|
||||
;; (when @(ds/exists? media/thumbnails-storage path)
|
||||
;; @(ds/delete media/thumbnails-storage path)))
|
||||
|
||||
(s/def ::delete-image
|
||||
(s/keys :req-un [::id ::user]))
|
||||
|
||||
(sc/defmutation :delete-image
|
||||
{:doc "Delete image entry."
|
||||
:spec ::delete-image}
|
||||
[{:keys [user id] :as params}]
|
||||
(let [sql "update images
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
returning *"]
|
||||
(db/query-one db/pool [sql id user])))
|
||||
|
||||
;; --- Query Images by Collection (id)
|
||||
|
||||
(def images-by-collection-sql
|
||||
"select * from images
|
||||
where (user_id = $1 or
|
||||
user_id = '00000000-0000-0000-0000-000000000000'::uuid)
|
||||
and deleted_at is null
|
||||
and case when $2::uuid is null then collection_id is null
|
||||
else collection_id = $2::uuid
|
||||
end
|
||||
order by created_at desc;")
|
||||
|
||||
(s/def ::images-by-collection-query
|
||||
(s/keys :req-un [::user]
|
||||
:opt-un [::us/id]))
|
||||
:opt-un [::collection-id]))
|
||||
|
||||
(defmethod core/novelty :delete-image
|
||||
[params]
|
||||
(s/assert ::delete-image params)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn delete-image params)))
|
||||
(sc/defquery :images-by-collection
|
||||
{:doc "Get all images of a collection"
|
||||
:spec ::images-by-collection-query}
|
||||
[{:keys [user collection-id] :as params}]
|
||||
(let [sqlv [images-by-collection-sql user collection-id]]
|
||||
(-> (db/query db/pool sqlv)
|
||||
(p/then populate-thumbnails)
|
||||
(p/then #(mapv populate-urls %)))))
|
||||
|
||||
;; --- List Images
|
||||
|
||||
(defn get-images-by-user
|
||||
[conn user collection]
|
||||
(let [sqlv (if collection
|
||||
(sql/get-images-by-collection {:user user :collection collection})
|
||||
(sql/get-images {:user user}))]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize-attrs))))
|
||||
|
||||
(s/def ::list-images
|
||||
(s/keys :req-un [::user ::collection]))
|
||||
|
||||
(defmethod core/query :list-images
|
||||
[{:keys [user collection] :as params}]
|
||||
(s/assert ::list-images params)
|
||||
(with-open [conn (db/connection)]
|
||||
(get-images-by-user conn user collection)))
|
||||
|
|
|
@ -2,86 +2,75 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services.kvstore
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[suricatta.core :as sc]
|
||||
[buddy.core.codecs :as codecs]
|
||||
[uxbox.config :as ucfg]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.services.core :as core]
|
||||
[uxbox.util.time :as dt]
|
||||
[uxbox.util.data :as data]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.services.core :as sv]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.data :as data]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.time :as dt]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(s/def ::version integer?)
|
||||
(s/def ::key string?)
|
||||
(s/def ::value any?)
|
||||
(s/def ::user uuid?)
|
||||
|
||||
(defn decode-value
|
||||
[{:keys [value] :as data}]
|
||||
(if value
|
||||
(assoc data :value (-> value blob/decode t/decode))
|
||||
data))
|
||||
(defn- decode-row
|
||||
[{:keys [value] :as row}]
|
||||
(when row
|
||||
(cond-> row
|
||||
value (assoc :value (blob/decode value)))))
|
||||
|
||||
;; --- Update KVStore
|
||||
|
||||
(s/def ::update-kvstore
|
||||
(s/keys :req-un [::key ::value ::user ::version]))
|
||||
(s/def ::user ::us/uuid)
|
||||
(s/def ::key ::us/string)
|
||||
(s/def ::value any?)
|
||||
|
||||
(defn update-kvstore
|
||||
[conn {:keys [user key value version] :as data}]
|
||||
(let [opts {:user user
|
||||
:key key
|
||||
:version version
|
||||
:value (-> value t/encode blob/encode)}
|
||||
sqlv (sql/update-kvstore opts)]
|
||||
(some->> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(decode-value))))
|
||||
(s/def ::upsert-kvstore
|
||||
(s/keys :req-un [::key ::value ::user]))
|
||||
|
||||
(defmethod core/novelty :update-kvstore
|
||||
[params]
|
||||
(s/assert ::update-kvstore params)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn update-kvstore params)))
|
||||
(sv/defmutation :upsert-kvstore
|
||||
{:doc "Update or insert kvstore entry."
|
||||
:spec ::upsert-kvstore}
|
||||
[{:keys [key value user] :as params}]
|
||||
(let [sql "insert into kvstore (key, value, user_id)
|
||||
values ($1, $2, $3)
|
||||
on conflict (user_id, key)
|
||||
do update set value = $2"
|
||||
val (blob/encode value)]
|
||||
(-> (db/query-one db/pool [sql key val user])
|
||||
(p/then' sv/constantly-nil))))
|
||||
|
||||
;; --- Retrieve KVStore
|
||||
|
||||
(s/def ::retrieve-kvstore
|
||||
(s/def ::kvstore-entry
|
||||
(s/keys :req-un [::key ::user]))
|
||||
|
||||
(defn retrieve-kvstore
|
||||
[conn {:keys [user key] :as params}]
|
||||
(let [sqlv (sql/retrieve-kvstore params)]
|
||||
(some->> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(decode-value))))
|
||||
|
||||
(defmethod core/query :retrieve-kvstore
|
||||
[params]
|
||||
(s/assert ::retrieve-kvstore params)
|
||||
(with-open [conn (db/connection)]
|
||||
(retrieve-kvstore conn params)))
|
||||
(sv/defquery :kvstore-entry
|
||||
{:doc "Retrieve kvstore entry."
|
||||
:spec ::kvstore-entry}
|
||||
[{:keys [key user]}]
|
||||
(let [sql "select kv.*
|
||||
from kvstore as kv
|
||||
where kv.user_id = $2
|
||||
and kv.key = $1"]
|
||||
(-> (db/query-one db/pool [sql key user])
|
||||
(p/then' sv/raise-not-found-if-nil)
|
||||
(p/then' decode-row))))
|
||||
|
||||
;; --- Delete KVStore
|
||||
|
||||
(s/def ::delete-kvstore
|
||||
(s/keys :req-un [::key ::user]))
|
||||
|
||||
(defn delete-kvstore
|
||||
[conn {:keys [user key] :as params}]
|
||||
(let [sqlv (sql/delete-kvstore params)]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
|
||||
(defmethod core/novelty :delete-kvstore
|
||||
[params]
|
||||
(s/assert ::delete-kvstore params)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn delete-kvstore params)))
|
||||
(sv/defmutation :delete-kvstore
|
||||
{:doc "Delete kvstore entry."
|
||||
:spec ::delete-kvstore}
|
||||
[{:keys [user key] :as params}]
|
||||
(let [sql "delete from kvstore
|
||||
where user_id = $2
|
||||
and key = $1"]
|
||||
(-> (db/query-one db/pool [sql key user])
|
||||
(p/then' sv/constantly-nil))))
|
||||
|
|
|
@ -2,225 +2,221 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services.pages
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[suricatta.core :as sc]
|
||||
[buddy.core.codecs :as codecs]
|
||||
[uxbox.config :as ucfg]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.services.core :as core]
|
||||
[uxbox.services.auth :as usauth]
|
||||
[uxbox.util.time :as dt]
|
||||
[uxbox.util.data :as data]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.services.core :as sv]
|
||||
[uxbox.util.time :as dt]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(declare decode-page-data)
|
||||
(declare decode-page-metadata)
|
||||
(declare encode-data)
|
||||
;; --- Helpers & Specs
|
||||
|
||||
(declare decode-row)
|
||||
|
||||
;; TODO: validate `:data` and `:metadata`
|
||||
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::name ::us/string)
|
||||
(s/def ::data any?)
|
||||
(s/def ::user uuid?)
|
||||
(s/def ::project uuid?)
|
||||
(s/def ::user ::us/uuid)
|
||||
(s/def ::project-id ::us/uuid)
|
||||
(s/def ::metadata any?)
|
||||
(s/def ::max integer?)
|
||||
(s/def ::pinned boolean?)
|
||||
(s/def ::since integer?)
|
||||
|
||||
;; --- Create Page
|
||||
|
||||
(defn create-page
|
||||
[conn {:keys [id user project name data metadata] :as params}]
|
||||
(let [opts {:id (or id (uuid/random))
|
||||
:user user
|
||||
:project project
|
||||
:name name
|
||||
:data (-> data t/encode blob/encode)
|
||||
:metadata (-> metadata t/encode blob/encode)}
|
||||
sqlv (sql/create-page opts)]
|
||||
(->> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(decode-page-data)
|
||||
(decode-page-metadata))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Queries
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- Query: Pages by Project
|
||||
|
||||
(s/def ::pages-by-project
|
||||
(s/keys :req-un [::user ::project-id]))
|
||||
|
||||
(sv/defquery :pages-by-project
|
||||
{:doc "List pages by project id."
|
||||
:spec ::pages-by-project}
|
||||
[{:keys [user project-id] :as params}]
|
||||
(let [sql "select pg.*,
|
||||
pg.data,
|
||||
pg.metadata
|
||||
from pages as pg
|
||||
where pg.user_id = $2
|
||||
and pg.project_id = $1
|
||||
and pg.deleted_at is null
|
||||
order by pg.created_at asc;"]
|
||||
(-> (db/query db/pool [sql project-id user])
|
||||
(p/then #(mapv decode-row %)))))
|
||||
|
||||
|
||||
;; --- Query: Page History
|
||||
|
||||
;; (def ^:private page-history-sql
|
||||
;; "select ph.*
|
||||
;; from pages_history as ph
|
||||
;; where ph.user_id = $1
|
||||
;; and ph.page_id = $2
|
||||
;; and ph.version < $3
|
||||
;; order by ph.version desc
|
||||
;; limit $4")
|
||||
|
||||
;; (defn get-page-history
|
||||
;; [{:keys [id page-id user since max pinned]
|
||||
;; :or {since Long/MAX_VALUE max 10}}]
|
||||
;; (let [sqlv [page-history-sql user page-id since
|
||||
;; (let [sqlv (sql/get-page-history {:user user
|
||||
;; :page id
|
||||
;; :since since
|
||||
;; :max max
|
||||
;; :pinned pinned})]
|
||||
;; (->> (db/fetch conn sqlv)
|
||||
;; ;; TODO
|
||||
;; (map decode-row))))
|
||||
|
||||
;; (s/def ::max ::us/integer)
|
||||
;; (s/def ::pinned ::us/boolean)
|
||||
;; (s/def ::since ::us/integer)
|
||||
|
||||
;; (s/def ::page-history
|
||||
;; (s/keys :req-un [::us/id ::user]
|
||||
;; :opt-un [::max ::pinned ::since]))
|
||||
|
||||
;; (sv/defquery :page-history
|
||||
;; {:doc "Retrieve page history."
|
||||
;; :spec ::page-history}
|
||||
;; [params]
|
||||
;; (with-open [conn (db/connection)]
|
||||
;; (get-page-history conn params)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Mutations
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- Mutation: Create Page
|
||||
|
||||
(s/def ::create-page
|
||||
(s/keys :req-un [::data ::user ::project ::us/name ::metadata]
|
||||
:opt-un [::us/id]))
|
||||
(s/keys :req-un [::data ::user ::project-id ::name ::metadata]
|
||||
:opt-un [::id]))
|
||||
|
||||
(defmethod core/novelty :create-page
|
||||
[params]
|
||||
(s/assert ::create-page params)
|
||||
(with-open [conn (db/connection)]
|
||||
(create-page conn params)))
|
||||
(sv/defmutation :create-page
|
||||
{:doc "Create a new page."
|
||||
:spec ::create-page}
|
||||
[{:keys [id user project-id name data metadata]}]
|
||||
(let [sql "insert into pages (id, user_id, project_id, name, data, metadata)
|
||||
values ($1, $2, $3, $4, $5, $6) returning *"
|
||||
id (or id (uuid/next))
|
||||
data (blob/encode data)
|
||||
mdata (blob/encode metadata)]
|
||||
(-> (db/query-one db/pool [sql id user project-id name data mdata])
|
||||
(p/then' decode-row))))
|
||||
|
||||
;; --- Update Page
|
||||
|
||||
(defn update-page
|
||||
[conn {:keys [id user project name
|
||||
data version metadata] :as params}]
|
||||
(let [opts {:id (or id (uuid/random))
|
||||
:user user
|
||||
:project project
|
||||
:name name
|
||||
:version version
|
||||
:data (-> data t/encode blob/encode)
|
||||
:metadata (-> metadata t/encode blob/encode)}
|
||||
sqlv (sql/update-page opts)]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(decode-page-data)
|
||||
(decode-page-metadata))))
|
||||
;; --- Mutation: Update Page
|
||||
|
||||
(s/def ::update-page
|
||||
(s/merge ::create-page (s/keys :req-un [::us/version])))
|
||||
(s/keys :req-un [::data ::user ::project-id ::name ::data ::metadata ::id]))
|
||||
|
||||
(defmethod core/novelty :update-page
|
||||
[params]
|
||||
(s/assert ::update-page params)
|
||||
(with-open [conn (db/connection)]
|
||||
(update-page conn params)))
|
||||
(sv/defmutation :update-page
|
||||
{:doc "Update an existing page."
|
||||
:spec ::update-page}
|
||||
[{:keys [id user project-id name data metadata]}]
|
||||
(let [sql "update pages
|
||||
set name = $1,
|
||||
data = $2,
|
||||
metadata = $3
|
||||
where id = $4
|
||||
and user_id = $5
|
||||
and deleted_at is null
|
||||
returning *"
|
||||
data (blob/encode data)
|
||||
mdata (blob/encode metadata)]
|
||||
(-> (db/query-one db/pool [sql name data mdata id user])
|
||||
(p/then' decode-row))))
|
||||
|
||||
;; --- Update Page Metadata
|
||||
|
||||
(defn update-page-metadata
|
||||
[conn {:keys [id user project name
|
||||
version metadata] :as params}]
|
||||
(let [opts {:id (or id (uuid/random))
|
||||
:user user
|
||||
:project project
|
||||
:name name
|
||||
:version version
|
||||
:metadata (-> metadata t/encode blob/encode)}
|
||||
sqlv (sql/update-page-metadata opts)]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(decode-page-data)
|
||||
(decode-page-metadata))))
|
||||
;; --- Mutation: Update Page Metadata
|
||||
|
||||
(s/def ::update-page-metadata
|
||||
(s/keys :req-un [::user ::project ::us/name ::us/version ::metadata]
|
||||
:opt-un [::us/id ::data]))
|
||||
(s/keys :req-un [::data ::user ::project-id ::name ::metadata ::id]))
|
||||
|
||||
(defmethod core/novelty :update-page-metadata
|
||||
[params]
|
||||
(s/assert ::update-page-metadata params)
|
||||
(with-open [conn (db/connection)]
|
||||
(update-page-metadata conn params)))
|
||||
(sv/defmutation :update-page-metadata
|
||||
{:doc "Update an existing page."
|
||||
:spec ::update-page-metadata}
|
||||
[{:keys [id user project-id name metadata]}]
|
||||
(let [sql "update pages
|
||||
set name = $3,
|
||||
metadata = $4
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
and deleted_at is null
|
||||
returning *"
|
||||
mdata (blob/encode metadata)]
|
||||
(-> (db/query-one db/pool [sql id user name mdata])
|
||||
(p/then' decode-row))))
|
||||
|
||||
;; --- Delete Page
|
||||
|
||||
(defn delete-page
|
||||
[conn {:keys [id user] :as params}]
|
||||
(let [sqlv (sql/delete-page {:id id :user user})]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
;; --- Mutation: Delete Page
|
||||
|
||||
(s/def ::delete-page
|
||||
(s/keys :req-un [::user ::us/id]))
|
||||
(s/keys :req-un [::user ::id]))
|
||||
|
||||
(defmethod core/novelty :delete-page
|
||||
[params]
|
||||
(s/assert ::delete-page params)
|
||||
(with-open [conn (db/connection)]
|
||||
(delete-page conn params)))
|
||||
(sv/defmutation :delete-page
|
||||
{:doc "Delete existing page."
|
||||
:spec ::delete-page}
|
||||
[{:keys [id user]}]
|
||||
(let [sql "update pages
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
and deleted_at is null
|
||||
returning id"]
|
||||
(-> (db/query-one db/pool [sql id user])
|
||||
(p/then sv/raise-not-found-if-nil)
|
||||
(p/then sv/constantly-nil))))
|
||||
|
||||
;; --- List Pages by Project
|
||||
;; ;; --- Update Page History
|
||||
|
||||
(defn get-pages-for-project
|
||||
[conn project]
|
||||
(let [sqlv (sql/get-pages-for-project {:project project})]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize-attrs)
|
||||
(map decode-page-data)
|
||||
(map decode-page-metadata))))
|
||||
;; (defn update-page-history
|
||||
;; [conn {:keys [user id label pinned]}]
|
||||
;; (let [sqlv (sql/update-page-history {:user user
|
||||
;; :id id
|
||||
;; :label label
|
||||
;; :pinned pinned})]
|
||||
;; (some-> (db/fetch-one conn sqlv)
|
||||
;; (decode-row))))
|
||||
|
||||
(defn get-pages-for-user-and-project
|
||||
[conn {:keys [user project]}]
|
||||
(let [sqlv (sql/get-pages-for-user-and-project
|
||||
{:user user :project project})]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize-attrs)
|
||||
(map decode-page-data)
|
||||
(map decode-page-metadata))))
|
||||
;; (s/def ::label ::us/string)
|
||||
;; (s/def ::update-page-history
|
||||
;; (s/keys :req-un [::user ::id ::pinned ::label]))
|
||||
|
||||
(s/def ::list-pages-by-project
|
||||
(s/keys :req-un [::user ::project]))
|
||||
|
||||
(defmethod core/query :list-pages-by-project
|
||||
[params]
|
||||
(s/assert ::list-pages-by-project params)
|
||||
(with-open [conn (db/connection)]
|
||||
(get-pages-for-user-and-project conn params)))
|
||||
|
||||
;; --- Page History (Query)
|
||||
|
||||
(defn get-page-history
|
||||
[conn {:keys [id user since max pinned]
|
||||
:or {since Long/MAX_VALUE max 10}}]
|
||||
(let [sqlv (sql/get-page-history {:user user
|
||||
:page id
|
||||
:since since
|
||||
:max max
|
||||
:pinned pinned})]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize-attrs)
|
||||
(map decode-page-data))))
|
||||
|
||||
(s/def ::list-page-history
|
||||
(s/keys :req-un [::us/id ::user]
|
||||
:opt-un [::max ::pinned ::since]))
|
||||
|
||||
(defmethod core/query :list-page-history
|
||||
[params]
|
||||
(s/assert ::list-page-history params)
|
||||
(with-open [conn (db/connection)]
|
||||
(get-page-history conn params)))
|
||||
|
||||
;; --- Update Page History
|
||||
|
||||
(defn update-page-history
|
||||
[conn {:keys [user id label pinned]}]
|
||||
(let [sqlv (sql/update-page-history {:user user
|
||||
:id id
|
||||
:label label
|
||||
:pinned pinned})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(decode-page-data))))
|
||||
|
||||
(s/def ::label string?)
|
||||
(s/def ::update-page-history
|
||||
(s/keys :req-un [::user ::us/id ::pinned ::label]))
|
||||
|
||||
(defmethod core/novelty :update-page-history
|
||||
[params]
|
||||
(s/assert ::update-page-history params)
|
||||
(with-open [conn (db/connection)]
|
||||
(update-page-history conn params)))
|
||||
;; (sv/defmutation :update-page-history
|
||||
;; {:doc "Update page history"
|
||||
;; :spec ::update-page-history}
|
||||
;; [params]
|
||||
;; (with-open [conn (db/connection)]
|
||||
;; (update-page-history conn params)))
|
||||
|
||||
;; --- Helpers
|
||||
|
||||
(defn- decode-page-metadata
|
||||
[{:keys [metadata] :as result}]
|
||||
(s/assert ::us/bytes metadata)
|
||||
(merge result (when metadata
|
||||
{:metadata (-> metadata blob/decode t/decode)})))
|
||||
(defn- decode-row
|
||||
[{:keys [data metadata] :as row}]
|
||||
(when row
|
||||
(cond-> row
|
||||
data (assoc :data (blob/decode data))
|
||||
metadata (assoc :metadata (blob/decode metadata)))))
|
||||
|
||||
(defn- decode-page-data
|
||||
[{:keys [data] :as result}]
|
||||
(s/assert ::us/bytes data)
|
||||
(merge result (when data
|
||||
{:data (-> data blob/decode t/decode)})))
|
||||
;; select pg.* from pages as pg
|
||||
;; where pg.id = :id
|
||||
;; and pg.deleted_at is null;
|
||||
|
||||
(defn get-page-by-id
|
||||
[conn id]
|
||||
(s/assert ::us/id id)
|
||||
(let [sqlv (sql/get-page-by-id {:id id})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(decode-page-data)
|
||||
(decode-page-metadata))))
|
||||
;; (defn get-page-by-id
|
||||
;; [conn id]
|
||||
;; (s/assert ::us/id id)
|
||||
;; (let [sqlv (sql/get-page-by-id {:id id})]
|
||||
;; (some-> (db/fetch-one conn sqlv)
|
||||
;; (decode-row))))
|
||||
|
|
|
@ -2,142 +2,126 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services.projects
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[suricatta.core :as sc]
|
||||
[buddy.core.codecs :as codecs]
|
||||
[uxbox.config :as ucfg]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.services.core :as core]
|
||||
[uxbox.services.pages :as pages]
|
||||
[uxbox.util.data :as data]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.services.core :as sv]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.uuid :as uuid]))
|
||||
|
||||
(s/def ::token string?)
|
||||
(s/def ::data string?)
|
||||
(s/def ::user uuid?)
|
||||
(s/def ::project uuid?)
|
||||
;; --- Helpers & Specs
|
||||
|
||||
;; --- Create Project
|
||||
(s/def ::id ::us/uuid)
|
||||
(s/def ::name ::us/string)
|
||||
(s/def ::token ::us/string)
|
||||
(s/def ::user ::us/uuid)
|
||||
|
||||
(defn create-project
|
||||
[conn {:keys [id user name] :as data}]
|
||||
(let [id (or id (uuid/random))
|
||||
sqlv (sql/create-project {:id id :user user :name name})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize))))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Queries
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- Query: Projects
|
||||
|
||||
(s/def ::projects-query
|
||||
(s/keys :req-un [::user]))
|
||||
|
||||
(sv/defquery :projects
|
||||
{:doc "Query all projects"
|
||||
:spec ::projects-query}
|
||||
[{:keys [user] :as params}]
|
||||
(let [sql "select pr.*,
|
||||
ps.token as share_token
|
||||
from projects as pr
|
||||
inner join project_shares as ps
|
||||
on (ps.project = pr.id)
|
||||
where pr.deleted_at is null
|
||||
and pr.user_id = $1
|
||||
order by pr.created_at asc"]
|
||||
(db/query db/pool [sql user])))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Mutations
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- Mutation: Create Project
|
||||
|
||||
(s/def ::create-project
|
||||
(s/keys :req-un [::user ::us/name]
|
||||
:opt-un [::us/id]))
|
||||
(s/keys :req-un [::user ::name]
|
||||
:opt-un [::id]))
|
||||
|
||||
(defmethod core/novelty :create-project
|
||||
[params]
|
||||
(s/assert ::create-project params)
|
||||
(with-open [conn (db/connection)]
|
||||
(create-project conn params)))
|
||||
(sv/defmutation :create-project
|
||||
{:doc "Create a project."
|
||||
:spec ::create-project}
|
||||
[{:keys [id user name] :as params}]
|
||||
(let [id (or id (uuid/next))
|
||||
sql "insert into projects (id, user_id, name)
|
||||
values ($1, $2, $3) returning *"]
|
||||
(db/query-one db/pool [sql id user name])))
|
||||
|
||||
;; --- Update Project
|
||||
|
||||
(defn- update-project
|
||||
[conn {:keys [name version id user] :as data}]
|
||||
(let [sqlv (sql/update-project {:name name
|
||||
:version version
|
||||
:id id
|
||||
:user user})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize))))
|
||||
;; --- Mutation: Update Project
|
||||
|
||||
(s/def ::update-project
|
||||
(s/merge ::create-project (s/keys :req-un [::us/version])))
|
||||
(s/keys :req-un [::user ::name ::id]))
|
||||
|
||||
(defmethod core/novelty :update-project
|
||||
[params]
|
||||
(s/assert ::update-project params)
|
||||
(with-open [conn (db/connection)]
|
||||
(update-project conn params)))
|
||||
(sv/defmutation :update-project
|
||||
{:doc "Update project."
|
||||
:spec ::update-project}
|
||||
[{:keys [id name user] :as params}]
|
||||
(let [sql "update projects
|
||||
set name = $3
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
and deleted_at is null
|
||||
returning *"]
|
||||
(db/query-one db/pool [sql id user name])))
|
||||
|
||||
;; --- Delete Project
|
||||
|
||||
(defn- delete-project
|
||||
[conn {:keys [id user] :as data}]
|
||||
(let [sqlv (sql/delete-project {:id id :user user})]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
;; --- Mutation: Delete Project
|
||||
|
||||
(s/def ::delete-project
|
||||
(s/keys :req-un [::us/id ::user]))
|
||||
(s/keys :req-un [::id ::user]))
|
||||
|
||||
(defmethod core/novelty :delete-project
|
||||
[params]
|
||||
(s/assert ::delete-project params)
|
||||
(with-open [conn (db/connection)]
|
||||
(delete-project conn params)))
|
||||
(sv/defmutation :delete-project
|
||||
{:doc "Delete project"
|
||||
:spec ::delete-project}
|
||||
[{:keys [id user] :as params}]
|
||||
(let [sql "update projects
|
||||
set deleted_at = clock_timestamp()
|
||||
where id = $1
|
||||
and user_id = $2
|
||||
and deleted_at is null
|
||||
returning id"]
|
||||
(-> (db/query-one db/pool [sql id user])
|
||||
(p/then' sv/raise-not-found-if-nil)
|
||||
(p/then' sv/constantly-nil))))
|
||||
|
||||
;; --- List Projects
|
||||
|
||||
(declare decode-page-metadata)
|
||||
(declare decode-page-data)
|
||||
|
||||
(defn get-projects
|
||||
[conn user]
|
||||
(let [sqlv (sql/get-projects {:user user})]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize)
|
||||
|
||||
;; This is because the project comes with
|
||||
;; the first page preloaded and it need
|
||||
;; to be decoded.
|
||||
(map decode-page-metadata)
|
||||
(map decode-page-data))))
|
||||
|
||||
(defmethod core/query :list-projects
|
||||
[{:keys [user] :as params}]
|
||||
(s/assert ::user user)
|
||||
(with-open [conn (db/connection)]
|
||||
(get-projects conn user)))
|
||||
|
||||
;; --- Retrieve Project by share token
|
||||
|
||||
(defn- get-project-by-share-token
|
||||
[conn token]
|
||||
(let [sqlv (sql/get-project-by-share-token {:token token})
|
||||
project (some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize))]
|
||||
(when-let [id (:id project)]
|
||||
(let [pages (vec (pages/get-pages-for-project conn id))]
|
||||
(assoc project :pages pages)))))
|
||||
;; (defn- get-project-by-share-token
|
||||
;; [conn token]
|
||||
;; (let [sqlv (sql/get-project-by-share-token {:token token})
|
||||
;; project (some-> (db/fetch-one conn sqlv)
|
||||
;; (data/normalize))]
|
||||
;; (when-let [id (:id project)]
|
||||
;; (let [pages (vec (pages/get-pages-for-project conn id))]
|
||||
;; (assoc project :pages pages)))))
|
||||
|
||||
(defmethod core/query :retrieve-project-by-share-token
|
||||
[{:keys [token]}]
|
||||
(s/assert ::token token)
|
||||
(with-open [conn (db/connection)]
|
||||
(get-project-by-share-token conn token)))
|
||||
;; (defmethod core/query :retrieve-project-by-share-token
|
||||
;; [{:keys [token]}]
|
||||
;; (s/assert ::token token)
|
||||
;; (with-open [conn (db/connection)]
|
||||
;; (get-project-by-share-token conn token)))
|
||||
|
||||
;; --- Retrieve share tokens
|
||||
|
||||
(defn get-share-tokens-for-project
|
||||
[conn project]
|
||||
(s/assert ::project project)
|
||||
(let [sqlv (sql/get-share-tokens-for-project {:project project})]
|
||||
(->> (sc/fetch conn sqlv)
|
||||
(map data/normalize))))
|
||||
|
||||
;; Helpers
|
||||
|
||||
(defn- decode-page-metadata
|
||||
[{:keys [page-metadata] :as result}]
|
||||
(merge result (when page-metadata
|
||||
{:page-metadata (-> page-metadata blob/decode t/decode)})))
|
||||
|
||||
(defn- decode-page-data
|
||||
[{:keys [page-data] :as result}]
|
||||
(merge result (when page-data
|
||||
{:page-data (-> page-data blob/decode t/decode)})))
|
||||
|
||||
;; (defn get-share-tokens-for-project
|
||||
;; [conn project]
|
||||
;; (s/assert ::project project)
|
||||
;; (let [sqlv (sql/get-share-tokens-for-project {:project project})]
|
||||
;; (db/fetch conn sqlv)))
|
||||
|
||||
|
|
|
@ -13,87 +13,87 @@
|
|||
(:import org.jsoup.Jsoup
|
||||
java.io.InputStream))
|
||||
|
||||
(s/def ::content string?)
|
||||
(s/def ::width number?)
|
||||
(s/def ::height number?)
|
||||
(s/def ::name string?)
|
||||
(s/def ::view-box (s/coll-of number? :min-count 4 :max-count 4))
|
||||
(s/def ::svg-entity (s/keys :req-un [::content ::width ::height ::view-box]
|
||||
:opt-un [::name]))
|
||||
;; (s/def ::content string?)
|
||||
;; (s/def ::width number?)
|
||||
;; (s/def ::height number?)
|
||||
;; (s/def ::name string?)
|
||||
;; (s/def ::view-box (s/coll-of number? :min-count 4 :max-count 4))
|
||||
;; (s/def ::svg-entity (s/keys :req-un [::content ::width ::height ::view-box]
|
||||
;; :opt-un [::name]))
|
||||
|
||||
;; --- Implementation
|
||||
;; ;; --- Implementation
|
||||
|
||||
(defn- parse-double
|
||||
[data]
|
||||
{:pre [(string? data)]}
|
||||
(Double/parseDouble data))
|
||||
;; (defn- parse-double
|
||||
;; [data]
|
||||
;; {:pre [(string? data)]}
|
||||
;; (Double/parseDouble data))
|
||||
|
||||
(defn- parse-viewbox
|
||||
[data]
|
||||
{:pre [(string? data)]}
|
||||
(mapv parse-double (str/split data #"\s+")))
|
||||
;; (defn- parse-viewbox
|
||||
;; [data]
|
||||
;; {:pre [(string? data)]}
|
||||
;; (mapv parse-double (str/split data #"\s+")))
|
||||
|
||||
(defn- assoc-attr
|
||||
[acc attr]
|
||||
(let [key (.getKey attr)
|
||||
val (.getValue attr)]
|
||||
(case key
|
||||
"width" (assoc acc :width (parse-double val))
|
||||
"height" (assoc acc :height (parse-double val))
|
||||
"viewbox" (assoc acc :view-box (parse-viewbox val))
|
||||
"sodipodi:docname" (assoc acc :name val)
|
||||
acc)))
|
||||
;; (defn- assoc-attr
|
||||
;; [acc attr]
|
||||
;; (let [key (.getKey attr)
|
||||
;; val (.getValue attr)]
|
||||
;; (case key
|
||||
;; "width" (assoc acc :width (parse-double val))
|
||||
;; "height" (assoc acc :height (parse-double val))
|
||||
;; "viewbox" (assoc acc :view-box (parse-viewbox val))
|
||||
;; "sodipodi:docname" (assoc acc :name val)
|
||||
;; acc)))
|
||||
|
||||
(defn- parse-attrs
|
||||
[element]
|
||||
(let [attrs (.attributes element)]
|
||||
(reduce assoc-attr {} attrs)))
|
||||
;; (defn- parse-attrs
|
||||
;; [element]
|
||||
;; (let [attrs (.attributes element)]
|
||||
;; (reduce assoc-attr {} attrs)))
|
||||
|
||||
(defn- parse-svg
|
||||
[data]
|
||||
(try
|
||||
(let [document (Jsoup/parse data)
|
||||
svgelement (some-> (.body document)
|
||||
(.getElementsByTag "svg")
|
||||
(first))
|
||||
innerxml (.html svgelement)
|
||||
attrs (parse-attrs svgelement)]
|
||||
(merge {:content innerxml} attrs))
|
||||
(catch java.lang.IllegalArgumentException e
|
||||
(ex/raise :type :validation
|
||||
:code ::invalid-input
|
||||
:message "Input does not seems to be a valid svg."))
|
||||
(catch java.lang.NullPointerException e
|
||||
(ex/raise :type :validation
|
||||
:code ::invalid-input
|
||||
:message "Input does not seems to be a valid svg."))
|
||||
;; (defn- parse-svg
|
||||
;; [data]
|
||||
;; (try
|
||||
;; (let [document (Jsoup/parse data)
|
||||
;; svgelement (some-> (.body document)
|
||||
;; (.getElementsByTag "svg")
|
||||
;; (first))
|
||||
;; innerxml (.html svgelement)
|
||||
;; attrs (parse-attrs svgelement)]
|
||||
;; (merge {:content innerxml} attrs))
|
||||
;; (catch java.lang.IllegalArgumentException e
|
||||
;; (ex/raise :type :validation
|
||||
;; :code ::invalid-input
|
||||
;; :message "Input does not seems to be a valid svg."))
|
||||
;; (catch java.lang.NullPointerException e
|
||||
;; (ex/raise :type :validation
|
||||
;; :code ::invalid-input
|
||||
;; :message "Input does not seems to be a valid svg."))
|
||||
|
||||
(catch org.jsoup.UncheckedIOException e
|
||||
(ex/raise :type :validation
|
||||
:code ::invalid-input
|
||||
:message "Input does not seems to be a valid svg."))
|
||||
;; (catch org.jsoup.UncheckedIOException e
|
||||
;; (ex/raise :type :validation
|
||||
;; :code ::invalid-input
|
||||
;; :message "Input does not seems to be a valid svg."))
|
||||
|
||||
(catch Exception e
|
||||
(ex/raise :code ::unexpected))))
|
||||
;; (catch Exception e
|
||||
;; (ex/raise :code ::unexpected))))
|
||||
|
||||
;; --- Public Api
|
||||
;; ;; --- Public Api
|
||||
|
||||
(defn parse-string
|
||||
"Parse SVG from a string."
|
||||
[data]
|
||||
{:pre [(string? data)]}
|
||||
(let [result (parse-svg data)]
|
||||
(if (s/valid? ::svg-entity result)
|
||||
result
|
||||
(ex/raise :type :validation
|
||||
:code ::invalid-result
|
||||
:message "The result does not conform valid svg entity."))))
|
||||
;; (defn parse-string
|
||||
;; "Parse SVG from a string."
|
||||
;; [data]
|
||||
;; {:pre [(string? data)]}
|
||||
;; (let [result (parse-svg data)]
|
||||
;; (if (s/valid? ::svg-entity result)
|
||||
;; result
|
||||
;; (ex/raise :type :validation
|
||||
;; :code ::invalid-result
|
||||
;; :message "The result does not conform valid svg entity."))))
|
||||
|
||||
(defn parse
|
||||
[data]
|
||||
(parse-string (slurp data)))
|
||||
;; (defn parse
|
||||
;; [data]
|
||||
;; (parse-string (slurp data)))
|
||||
|
||||
(defmethod core/query :parse-svg
|
||||
[{:keys [data] :as params}]
|
||||
{:pre [(string? data)]}
|
||||
(parse-string data))
|
||||
;; (defmethod core/query :parse-svg
|
||||
;; [{:keys [data] :as params}]
|
||||
;; {:pre [(string? data)]}
|
||||
;; (parse-string data))
|
||||
|
|
|
@ -5,318 +5,377 @@
|
|||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.services.users
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[mount.core :as mount :refer (defstate)]
|
||||
[suricatta.core :as sc]
|
||||
[buddy.hashers :as hashers]
|
||||
[buddy.sign.jwe :as jwe]
|
||||
[uxbox.sql :as sql]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.emails :as emails]
|
||||
[uxbox.services.core :as core]
|
||||
[uxbox.util.transit :as t]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.data :as data]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[uxbox.util.token :as token]))
|
||||
(:require
|
||||
[buddy.hashers :as hashers]
|
||||
[clojure.spec.alpha :as s]
|
||||
[datoteka.core :as fs]
|
||||
[datoteka.storages :as ds]
|
||||
[promesa.core :as p]
|
||||
[promesa.exec :as px]
|
||||
[uxbox.config :as cfg]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.emails :as emails]
|
||||
[uxbox.images :as images]
|
||||
[uxbox.media :as media]
|
||||
[uxbox.services.core :as sv]
|
||||
[uxbox.util.blob :as blob]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.token :as token]
|
||||
[uxbox.util.uuid :as uuid]
|
||||
[vertx.core :as vc]))
|
||||
|
||||
(declare decode-user-data)
|
||||
(declare trim-user-attrs)
|
||||
(declare find-user-by-id)
|
||||
(declare find-full-user-by-id)
|
||||
(declare find-user-by-username-or-email)
|
||||
;; --- Helpers & Specs
|
||||
|
||||
(s/def ::user uuid?)
|
||||
(s/def ::fullname string?)
|
||||
(declare decode-profile-row)
|
||||
(declare strip-private-attrs)
|
||||
|
||||
(s/def ::email ::us/email)
|
||||
(s/def ::fullname ::us/string)
|
||||
(s/def ::metadata any?)
|
||||
(s/def ::old-password string?)
|
||||
(s/def ::path string?)
|
||||
(s/def ::old-password ::us/string)
|
||||
(s/def ::password ::us/string)
|
||||
(s/def ::path ::us/string)
|
||||
(s/def ::user ::us/uuid)
|
||||
(s/def ::username ::us/string)
|
||||
|
||||
;; --- Retrieve User Profile (own)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Queries
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defmethod core/query :retrieve-profile
|
||||
;; --- Query: Profile (own)
|
||||
|
||||
(defn- resolve-thumbnail
|
||||
[user]
|
||||
(let [opts {:src :photo
|
||||
:dst :photo
|
||||
:size [100 100]
|
||||
:quality 90
|
||||
:format "jpg"}]
|
||||
(-> (px/submit! #(images/populate-thumbnails user opts))
|
||||
(sv/handle-on-context))))
|
||||
|
||||
(defn- get-profile
|
||||
[conn id]
|
||||
(let [sql "select * from users where id=$1 and deleted_at is null"]
|
||||
(-> (db/query-one db/pool [sql id])
|
||||
(p/then' decode-profile-row))))
|
||||
|
||||
(s/def ::profile
|
||||
(s/keys :req-un [::user]))
|
||||
|
||||
(sv/defquery :profile
|
||||
{:doc "Retrieve the user profile."
|
||||
:spec ::profile}
|
||||
[{:keys [user] :as params}]
|
||||
(s/assert ::user user)
|
||||
(with-open [conn (db/connection)]
|
||||
(some-> (find-user-by-id conn (:user params))
|
||||
(decode-user-data))))
|
||||
(-> (get-profile db/pool user)
|
||||
(p/then' strip-private-attrs)))
|
||||
|
||||
;; --- Update User Profile (own)
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Mutations
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- check-profile-existence!
|
||||
[conn {:keys [id username email]}]
|
||||
(let [sqlv1 (sql/user-with-email-exists? {:id id :email email})
|
||||
sqlv2 (sql/user-with-username-exists? {:id id :username username})]
|
||||
(when (:val (sc/fetch-one conn sqlv1))
|
||||
(ex/raise :type :validation
|
||||
:code ::email-already-exists))
|
||||
(when (:val (sc/fetch-one conn sqlv2))
|
||||
(ex/raise :type :validation
|
||||
:code ::username-already-exists))))
|
||||
;; --- Mutation: Update Profile (own)
|
||||
|
||||
(defn- check-username-and-email!
|
||||
[conn {:keys [id username email] :as params}]
|
||||
(let [sql1 "select exists
|
||||
(select * from users
|
||||
where username = $2
|
||||
and id != $1
|
||||
) as val"
|
||||
sql2 "select exists
|
||||
(select * from users
|
||||
where email = $2
|
||||
and id != $1
|
||||
) as val"]
|
||||
(p/let [res1 (db/query-one conn [sql1 id username])
|
||||
res2 (db/query-one conn [sql2 id email])]
|
||||
(when (:val res1)
|
||||
(ex/raise :type :validation
|
||||
:code ::username-already-exists))
|
||||
(when (:val res2)
|
||||
(ex/raise :type :validation
|
||||
:code ::email-already-exists))
|
||||
params)))
|
||||
|
||||
(defn- update-profile
|
||||
[conn {:keys [id username email fullname metadata] :as params}]
|
||||
(check-profile-existence! conn params)
|
||||
(let [metadata (-> metadata t/encode blob/encode)
|
||||
sqlv (sql/update-profile {:username username
|
||||
:fullname fullname
|
||||
:metadata metadata
|
||||
:email email
|
||||
:id id})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(trim-user-attrs)
|
||||
(decode-user-data)
|
||||
(dissoc :password))))
|
||||
(let [sql "update users
|
||||
set username = $2,
|
||||
email = $3,
|
||||
fullname = $4,
|
||||
metadata = $5
|
||||
where id = $1
|
||||
and deleted_at is null
|
||||
returning *"]
|
||||
(-> (db/query-one conn [sql id username email fullname (blob/encode metadata)])
|
||||
(p/then' sv/raise-not-found-if-nil)
|
||||
(p/then' decode-profile-row)
|
||||
(p/then' strip-private-attrs))))
|
||||
|
||||
(s/def ::update-profile
|
||||
(s/keys :req-un [::us/id ::us/username ::us/email ::fullname ::metadata]))
|
||||
(s/keys :req-un [::id ::username ::email ::fullname ::metadata]))
|
||||
|
||||
(defmethod core/novelty :update-profile
|
||||
(sv/defmutation :update-profile
|
||||
{:doc "Update self profile."
|
||||
:spec ::update-profile}
|
||||
[params]
|
||||
(s/assert ::update-profile params)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn update-profile params)))
|
||||
(db/with-atomic [conn db/pool]
|
||||
(-> (p/resolved params)
|
||||
(p/then (partial check-username-and-email! conn))
|
||||
(p/then (partial update-profile conn)))))
|
||||
|
||||
;; --- Update Password
|
||||
;; --- Mutation: Update Password
|
||||
|
||||
(defn- validate-password
|
||||
[conn {:keys [user old-password] :as params}]
|
||||
(p/let [profile (get-profile conn user)]
|
||||
(when-not (hashers/check old-password (:password profile))
|
||||
(ex/raise :type :validation
|
||||
:code ::old-password-not-match))
|
||||
params))
|
||||
|
||||
(defn update-password
|
||||
[conn {:keys [user password]}]
|
||||
(let [password (hashers/encrypt password)
|
||||
sqlv (sql/update-profile-password {:id user :password password})]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
|
||||
(defn- validate-old-password
|
||||
[conn {:keys [user old-password] :as params}]
|
||||
(let [user (find-full-user-by-id conn user)]
|
||||
(when-not (hashers/check old-password (:password user))
|
||||
(ex/raise :type :validation
|
||||
:code ::old-password-not-match))
|
||||
params))
|
||||
(let [sql "update users
|
||||
set password = $2
|
||||
where id = $1
|
||||
and deleted_at is null
|
||||
returning id"]
|
||||
(-> (db/query-one conn [sql user password])
|
||||
(p/then' sv/raise-not-found-if-nil)
|
||||
(p/then' sv/constantly-nil))))
|
||||
|
||||
(s/def ::update-password
|
||||
(s/keys :req-un [::user ::us/password ::old-password]))
|
||||
|
||||
(defmethod core/novelty :update-profile-password
|
||||
(sv/defmutation :update-password
|
||||
{:doc "Update self password."
|
||||
:spec ::update-password}
|
||||
[params]
|
||||
(s/assert ::update-password params)
|
||||
(with-open [conn (db/connection)]
|
||||
(->> params
|
||||
(validate-old-password conn)
|
||||
(update-password conn))))
|
||||
(db/with-atomic [conn db/pool]
|
||||
(-> (p/resolved params)
|
||||
(p/then (partial validate-password conn))
|
||||
(p/then (partial update-password conn)))))
|
||||
|
||||
;; --- Update Photo
|
||||
;; --- Mutation: Update Photo
|
||||
|
||||
(defn update-photo
|
||||
[conn {:keys [user path]}]
|
||||
(let [sqlv (sql/update-profile-photo {:id user :photo path})]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
(s/def ::file ::us/upload)
|
||||
(s/def ::update-profile-photo
|
||||
(s/keys :req-un [::user ::file]))
|
||||
|
||||
(s/def ::update-photo
|
||||
(s/keys :req-un [::user ::path]))
|
||||
(def valid-image-types?
|
||||
#{"image/jpeg", "image/png", "image/webp"})
|
||||
|
||||
(defmethod core/novelty :update-profile-photo
|
||||
[params]
|
||||
(s/assert ::update-photo params)
|
||||
(with-open [conn (db/connection)]
|
||||
(update-photo conn params)))
|
||||
(sv/defmutation :update-profile-photo
|
||||
{:doc "Update profile photo."
|
||||
:spec ::update-profile-photo}
|
||||
[{:keys [user file] :as params}]
|
||||
(letfn [(store-photo [{:keys [name path] :as upload}]
|
||||
(let [filename (fs/name name)
|
||||
storage media/images-storage]
|
||||
(-> (ds/save storage filename path)
|
||||
#_(sv/handle-on-context))))
|
||||
|
||||
;; --- Create User
|
||||
(update-user-photo [path]
|
||||
(let [sql "update users
|
||||
set photo = $1
|
||||
where id = $2
|
||||
and deleted_at is null
|
||||
returning *"]
|
||||
(-> (db/query-one db/pool [sql (str path) user])
|
||||
(p/then' sv/raise-not-found-if-nil)
|
||||
(p/then' strip-private-attrs)
|
||||
(p/then resolve-thumbnail))))]
|
||||
|
||||
(s/def ::create-user
|
||||
(s/keys :req-un [::metadata ::fullname ::us/email ::us/password]
|
||||
:opt-un [::us/id]))
|
||||
|
||||
(defn create-user
|
||||
[conn {:keys [id username password email fullname metadata] :as data}]
|
||||
(s/assert ::create-user data)
|
||||
(let [id (or id (uuid/random))
|
||||
metadata (-> metadata t/encode blob/encode)
|
||||
password (hashers/encrypt password)
|
||||
sqlv (sql/create-profile {:id id
|
||||
:fullname fullname
|
||||
:username username
|
||||
:email email
|
||||
:password password
|
||||
:metadata metadata})]
|
||||
(->> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(trim-user-attrs)
|
||||
(decode-user-data))))
|
||||
|
||||
;; --- Register User
|
||||
|
||||
(defn- check-user-registred!
|
||||
"Check if the user identified by username or by email
|
||||
is already registred in the platform."
|
||||
[conn {:keys [username email]}]
|
||||
(let [sqlv1 (sql/user-with-email-exists? {:email email})
|
||||
sqlv2 (sql/user-with-username-exists? {:username username})]
|
||||
(when (:val (sc/fetch-one conn sqlv1))
|
||||
(when-not (valid-image-types? (:mtype file))
|
||||
(ex/raise :type :validation
|
||||
:code ::email-already-exists))
|
||||
(when (:val (sc/fetch-one conn sqlv2))
|
||||
(ex/raise :type :validation
|
||||
:code ::username-already-exists))))
|
||||
:code :image-type-not-allowed
|
||||
:hint "Seems like you are uploading an invalid image."))
|
||||
(-> (store-photo file)
|
||||
(p/then update-user-photo))))
|
||||
|
||||
(defn- register-user
|
||||
;; --- Mutation: Register Profile
|
||||
|
||||
(def ^:private create-user-sql
|
||||
"insert into users (id, fullname, username, email, password, metadata, photo)
|
||||
values ($1, $2, $3, $4, $5, $6, '') returning *")
|
||||
|
||||
(defn- check-profile-existence!
|
||||
[conn {:keys [username email] :as params}]
|
||||
(let [sql "select exists
|
||||
(select * from users
|
||||
where username = $1
|
||||
or email = $2
|
||||
) as val"]
|
||||
(-> (db/query-one conn [sql username email])
|
||||
(p/then (fn [result]
|
||||
(when (:val result)
|
||||
(ex/raise :type :validation
|
||||
:code ::username-or-email-already-exists))
|
||||
params)))))
|
||||
|
||||
(defn- register-profile
|
||||
"Create the user entry on the database with limited input
|
||||
filling all the other fields with defaults."
|
||||
[conn {:keys [username fullname email password] :as params}]
|
||||
(check-user-registred! conn params)
|
||||
(let [metadata (-> nil t/encode blob/encode)
|
||||
(let [metadata (blob/encode {})
|
||||
password (hashers/encrypt password)
|
||||
sqlv (sql/create-profile {:id (uuid/random)
|
||||
:fullname fullname
|
||||
:username username
|
||||
:email email
|
||||
:password password
|
||||
:metadata metadata})]
|
||||
(sc/execute conn sqlv)
|
||||
(emails/send! {:email/name :users/register
|
||||
:email/to (:email params)
|
||||
:email/priority :high
|
||||
:name (:fullname params)})
|
||||
nil))
|
||||
sqlv [create-user-sql
|
||||
(uuid/next)
|
||||
fullname
|
||||
username
|
||||
email
|
||||
password
|
||||
metadata]]
|
||||
(-> (db/query-one conn sqlv)
|
||||
(p/then' decode-profile-row)
|
||||
(p/then' strip-private-attrs)
|
||||
#_(p/then (fn [profile]
|
||||
(-> (emails/send! {::emails/id :users/register
|
||||
::emails/to (:email params)
|
||||
::emails/priority :high
|
||||
:name (:fullname params)})
|
||||
(p/then' (constantly profile))))))))
|
||||
|
||||
(s/def ::register
|
||||
(s/keys :req-un [::us/username ::us/email ::us/password ::fullname]))
|
||||
(s/def ::register-profile
|
||||
(s/keys :req-un [::username ::email ::password ::fullname]))
|
||||
|
||||
(defmethod core/novelty :register-profile
|
||||
(sv/defmutation :register-profile
|
||||
{:doc "Register new user."
|
||||
:spec ::register-profile}
|
||||
[params]
|
||||
(s/assert ::register params)
|
||||
(if (= (:registration-enabled cfg/config) true)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn register-user params))
|
||||
(ex/raise :type :validation
|
||||
:code ::registration-disabled)))
|
||||
(when-not (:registration-enabled cfg/config)
|
||||
(ex/raise :type :restriction
|
||||
:code :registration-disabled))
|
||||
(db/with-atomic [conn db/pool]
|
||||
(-> (p/resolved params)
|
||||
(p/then (partial check-profile-existence! conn))
|
||||
(p/then (partial register-profile conn)))))
|
||||
|
||||
;; --- Password Recover
|
||||
|
||||
(defn- recovery-token-exists?
|
||||
"Checks if the token exists in the system. Just
|
||||
return `true` or `false`."
|
||||
[conn token]
|
||||
(let [sqlv (sql/recovery-token-exists? {:token token})
|
||||
result (sc/fetch-one conn sqlv)]
|
||||
(:token_exists result)))
|
||||
;; (defn- recovery-token-exists?
|
||||
;; "Checks if the token exists in the system. Just
|
||||
;; return `true` or `false`."
|
||||
;; [conn token]
|
||||
;; (let [sqlv (sql/recovery-token-exists? {:token token})
|
||||
;; result (db/fetch-one conn sqlv)]
|
||||
;; (:token_exists result)))
|
||||
|
||||
(defn- retrieve-user-for-recovery-token
|
||||
"Retrieve a user id (uuid) for the given token. If
|
||||
no user is found, an exception is raised."
|
||||
[conn token]
|
||||
(let [sqlv (sql/get-recovery-token {:token token})
|
||||
data (sc/fetch-one conn sqlv)]
|
||||
(or (:user data)
|
||||
(ex/raise :type :validation
|
||||
:code ::invalid-token))))
|
||||
;; (defn- retrieve-user-for-recovery-token
|
||||
;; "Retrieve a user id (uuid) for the given token. If
|
||||
;; no user is found, an exception is raised."
|
||||
;; [conn token]
|
||||
;; (let [sqlv (sql/get-recovery-token {:token token})
|
||||
;; data (db/fetch-one conn sqlv)]
|
||||
;; (or (:user data)
|
||||
;; (ex/raise :type :validation
|
||||
;; :code ::invalid-token))))
|
||||
|
||||
(defn- mark-token-as-used
|
||||
[conn token]
|
||||
(let [sqlv (sql/mark-recovery-token-used {:token token})]
|
||||
(pos? (sc/execute conn sqlv))))
|
||||
;; (defn- mark-token-as-used
|
||||
;; [conn token]
|
||||
;; (let [sqlv (sql/mark-recovery-token-used {:token token})]
|
||||
;; (pos? (db/execute conn sqlv))))
|
||||
|
||||
(defn- recover-password
|
||||
"Given a token and password, resets the password
|
||||
to corresponding user or raise an exception."
|
||||
[conn {:keys [token password]}]
|
||||
(let [user (retrieve-user-for-recovery-token conn token)]
|
||||
(update-password conn {:user user :password password})
|
||||
(mark-token-as-used conn token)
|
||||
nil))
|
||||
;; (defn- recover-password
|
||||
;; "Given a token and password, resets the password
|
||||
;; to corresponding user or raise an exception."
|
||||
;; [conn {:keys [token password]}]
|
||||
;; (let [user (retrieve-user-for-recovery-token conn token)]
|
||||
;; (update-password conn {:user user :password password})
|
||||
;; (mark-token-as-used conn token)
|
||||
;; nil))
|
||||
|
||||
(defn- create-recovery-token
|
||||
"Creates a new recovery token for specified user and return it."
|
||||
[conn userid]
|
||||
(let [token (token/random)
|
||||
sqlv (sql/create-recovery-token {:user userid
|
||||
:token token})]
|
||||
(sc/execute conn sqlv)
|
||||
token))
|
||||
;; (defn- create-recovery-token
|
||||
;; "Creates a new recovery token for specified user and return it."
|
||||
;; [conn userid]
|
||||
;; (let [token (token/random)
|
||||
;; sqlv (sql/create-recovery-token {:user userid
|
||||
;; :token token})]
|
||||
;; (db/execute conn sqlv)
|
||||
;; token))
|
||||
|
||||
(defn- retrieve-user-for-password-recovery
|
||||
[conn username]
|
||||
(let [user (find-user-by-username-or-email conn username)]
|
||||
(when-not user
|
||||
(ex/raise :type :validation :code ::user-does-not-exists))
|
||||
user))
|
||||
;; (defn- retrieve-user-for-password-recovery
|
||||
;; [conn username]
|
||||
;; (let [user (find-user-by-username-or-email conn username)]
|
||||
;; (when-not user
|
||||
;; (ex/raise :type :validation :code ::user-does-not-exists))
|
||||
;; user))
|
||||
|
||||
(defn- request-password-recovery
|
||||
"Creates a new recovery password token and sends it via email
|
||||
to the correspondig to the given username or email address."
|
||||
[conn username]
|
||||
(let [user (retrieve-user-for-password-recovery conn username)
|
||||
token (create-recovery-token conn (:id user))]
|
||||
(emails/send! {:email/name :users/password-recovery
|
||||
:email/to (:email user)
|
||||
:name (:fullname user)
|
||||
:token token})
|
||||
token))
|
||||
;; (defn- request-password-recovery
|
||||
;; "Creates a new recovery password token and sends it via email
|
||||
;; to the correspondig to the given username or email address."
|
||||
;; [conn username]
|
||||
;; (let [user (retrieve-user-for-password-recovery conn username)
|
||||
;; token (create-recovery-token conn (:id user))]
|
||||
;; (emails/send! {:email/name :users/password-recovery
|
||||
;; :email/to (:email user)
|
||||
;; :name (:fullname user)
|
||||
;; :token token})
|
||||
;; token))
|
||||
|
||||
(defmethod core/query :validate-profile-password-recovery-token
|
||||
[{:keys [token]}]
|
||||
(s/assert ::us/token token)
|
||||
(with-open [conn (db/connection)]
|
||||
(recovery-token-exists? conn token)))
|
||||
;; (defmethod core/query :validate-profile-password-recovery-token
|
||||
;; [{:keys [token]}]
|
||||
;; (s/assert ::us/token token)
|
||||
;; (with-open [conn (db/connection)]
|
||||
;; (recovery-token-exists? conn token)))
|
||||
|
||||
(defmethod core/novelty :request-profile-password-recovery
|
||||
[{:keys [username]}]
|
||||
(s/assert ::us/username username)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/atomic conn
|
||||
(request-password-recovery conn username))))
|
||||
;; (defmethod core/novelty :request-profile-password-recovery
|
||||
;; [{:keys [username]}]
|
||||
;; (s/assert ::us/username username)
|
||||
;; (with-open [conn (db/connection)]
|
||||
;; (db/atomic conn
|
||||
;; (request-password-recovery conn username))))
|
||||
|
||||
(s/def ::recover-password
|
||||
(s/keys :req-un [::us/token ::us/password]))
|
||||
;; (s/def ::recover-password
|
||||
;; (s/keys :req-un [::us/token ::us/password]))
|
||||
|
||||
(defmethod core/novelty :recover-profile-password
|
||||
[params]
|
||||
(s/assert ::recover-password params)
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/apply-atomic conn recover-password params)))
|
||||
;; (defmethod core/novelty :recover-profile-password
|
||||
;; [params]
|
||||
;; (s/assert ::recover-password params)
|
||||
;; (with-open [conn (db/connection)]
|
||||
;; (db/apply-atomic conn recover-password params)))
|
||||
|
||||
;; --- Query Helpers
|
||||
|
||||
(defn find-full-user-by-id
|
||||
"Find user by its id. This function is for internal
|
||||
use only because it returns a lot of sensitive information.
|
||||
If no user is found, `nil` is returned."
|
||||
[conn id]
|
||||
(let [sqlv (sql/get-profile {:id id})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs))))
|
||||
;; (defn find-full-user-by-id
|
||||
;; "Find user by its id. This function is for internal
|
||||
;; use only because it returns a lot of sensitive information.
|
||||
;; If no user is found, `nil` is returned."
|
||||
;; [conn id]
|
||||
;; (let [sqlv (sql/get-profile {:id id})]
|
||||
;; (some-> (db/fetch-one conn sqlv)
|
||||
;; (data/normalize-attrs))))
|
||||
|
||||
(defn find-user-by-id
|
||||
"Find user by its id. If no user is found, `nil` is returned."
|
||||
[conn id]
|
||||
(let [sqlv (sql/get-profile {:id id})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(trim-user-attrs)
|
||||
(dissoc :password))))
|
||||
;; (defn find-user-by-id
|
||||
;; "Find user by its id. If no user is found, `nil` is returned."
|
||||
;; [conn id]
|
||||
;; (let [sqlv (sql/get-profile {:id id})]
|
||||
;; (some-> (db/fetch-one conn sqlv)
|
||||
;; (data/normalize-attrs)
|
||||
;; (trim-user-attrs)
|
||||
;; (dissoc :password))))
|
||||
|
||||
(defn find-user-by-username-or-email
|
||||
"Finds a user in the database by username and email. If no
|
||||
user is found, `nil` is returned."
|
||||
[conn username]
|
||||
(let [sqlv (sql/get-profile-by-username {:username username})]
|
||||
(some-> (sc/fetch-one conn sqlv)
|
||||
(data/normalize-attrs)
|
||||
(trim-user-attrs))))
|
||||
;; (defn find-user-by-username-or-email
|
||||
;; "Finds a user in the database by username and email. If no
|
||||
;; user is found, `nil` is returned."
|
||||
;; [conn username]
|
||||
;; (let [sqlv (sql/get-profile-by-username {:username username})]
|
||||
;; (some-> (db/fetch-one conn sqlv)
|
||||
;; (trim-user-attrs))))
|
||||
|
||||
;; --- Attrs Helpers
|
||||
|
||||
(defn- decode-user-data
|
||||
[{:keys [metadata] :as result}]
|
||||
(merge result (when metadata
|
||||
{:metadata (-> metadata blob/decode t/decode)})))
|
||||
(defn- decode-profile-row
|
||||
[{:keys [metadata] :as row}]
|
||||
(when row
|
||||
(cond-> row
|
||||
metadata (assoc :metadata (blob/decode metadata)))))
|
||||
|
||||
(defn trim-user-attrs
|
||||
(defn strip-private-attrs
|
||||
"Only selects a publicy visible user attrs."
|
||||
[user]
|
||||
(select-keys user [:id :username :fullname
|
||||
:password :metadata :email
|
||||
:created-at :photo]))
|
||||
[profile]
|
||||
(select-keys profile [:id :username :fullname :metadata
|
||||
:email :created-at :photo]))
|
||||
|
|
|
@ -1,18 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.sql
|
||||
(:require [hugsql.core :as hugsql]))
|
||||
|
||||
(hugsql/def-sqlvec-fns "sql/projects.sql" {:quoting :ansi :fn-suffix ""})
|
||||
(hugsql/def-sqlvec-fns "sql/pages.sql" {:quoting :ansi :fn-suffix ""})
|
||||
(hugsql/def-sqlvec-fns "sql/users.sql" {:quoting :ansi :fn-suffix ""})
|
||||
(hugsql/def-sqlvec-fns "sql/emails.sql" {:quoting :ansi :fn-suffix ""})
|
||||
(hugsql/def-sqlvec-fns "sql/images.sql" {:quoting :ansi :fn-suffix ""})
|
||||
(hugsql/def-sqlvec-fns "sql/icons.sql" {:quoting :ansi :fn-suffix ""})
|
||||
(hugsql/def-sqlvec-fns "sql/kvstore.sql" {:quoting :ansi :fn-suffix ""})
|
||||
(hugsql/def-sqlvec-fns "sql/workers.sql" {:quoting :ansi :fn-suffix ""})
|
||||
|
|
@ -7,15 +7,93 @@
|
|||
(ns uxbox.util.blob
|
||||
"A generic blob storage encoding. Mainly used for
|
||||
page data, page options and txlog payload storage."
|
||||
(:require [uxbox.util.snappy :as snappy]))
|
||||
(:require [uxbox.util.transit :as t])
|
||||
(:import
|
||||
io.vertx.core.buffer.Buffer
|
||||
java.io.ByteArrayInputStream
|
||||
java.io.ByteArrayOutputStream
|
||||
java.io.DataInputStream
|
||||
java.io.DataOutputStream
|
||||
org.xerial.snappy.Snappy))
|
||||
|
||||
(defprotocol IDataToBytes
|
||||
(->bytes [data] "convert data to bytes"))
|
||||
|
||||
(extend-protocol IDataToBytes
|
||||
(Class/forName "[B")
|
||||
(->bytes [data] data)
|
||||
|
||||
Buffer
|
||||
(->bytes [data] (.getBytes ^Buffer data))
|
||||
|
||||
;; org.jooq.JSONB
|
||||
;; (->bytes [data] (->bytes (.toString data)))
|
||||
|
||||
String
|
||||
(->bytes [data] (.getBytes ^String data "UTF-8")))
|
||||
|
||||
(defn str->bytes
|
||||
"Convert string to byte array."
|
||||
([^String s]
|
||||
(str->bytes s "UTF-8"))
|
||||
([^String s, ^String encoding]
|
||||
(.getBytes s encoding)))
|
||||
|
||||
(defn bytes->str
|
||||
"Convert byte array to String."
|
||||
([^bytes data]
|
||||
(bytes->str data "UTF-8"))
|
||||
([^bytes data, ^String encoding]
|
||||
(String. data encoding)))
|
||||
|
||||
(defn buffer
|
||||
[^bytes data]
|
||||
(Buffer/buffer data))
|
||||
|
||||
(defn encode-with-json
|
||||
"A function used for encode data for transfer it to frontend."
|
||||
([data] (encode-with-json data false))
|
||||
([data verbose?]
|
||||
(let [type (if verbose? :json-verbose :json)]
|
||||
(-> (t/encode data {:type type})
|
||||
(Buffer/buffer)))))
|
||||
|
||||
(defn decode-from-json
|
||||
"A function used for parse data coming from frontend."
|
||||
[data]
|
||||
(-> (->bytes data)
|
||||
(t/decode {:type :json})))
|
||||
|
||||
(defn encode
|
||||
"Encode data into compressed blob."
|
||||
"A function used for encode data for persist in the database."
|
||||
[data]
|
||||
(snappy/compress data))
|
||||
(let [data (t/encode data {:type :json})
|
||||
data-len (alength ^bytes data)
|
||||
cdata (Snappy/compress ^bytes data)]
|
||||
(with-open [^ByteArrayOutputStream baos (ByteArrayOutputStream. (+ (alength cdata) 2 4))
|
||||
^DataOutputStream dos (DataOutputStream. baos)]
|
||||
(.writeShort dos (short 1)) ;; version number
|
||||
(.writeInt dos (int data-len))
|
||||
(.write dos ^bytes cdata (int 0) (alength cdata))
|
||||
(-> (.toByteArray baos)
|
||||
(buffer)))))
|
||||
|
||||
(declare decode-v1)
|
||||
|
||||
(defn decode
|
||||
"Decode blob into string."
|
||||
[^bytes data]
|
||||
(snappy/uncompress data))
|
||||
"A function used for decode persisted blobs in the database."
|
||||
[data]
|
||||
(let [data (->bytes data)]
|
||||
(with-open [bais (ByteArrayInputStream. data)
|
||||
dis (DataInputStream. bais)]
|
||||
(let [version (.readShort dis)
|
||||
udata-len (.readInt dis)]
|
||||
(when (not= version 1)
|
||||
(throw (ex-info "unsupported version" {:version version})))
|
||||
(decode-v1 data udata-len)))))
|
||||
|
||||
(defn- decode-v1
|
||||
[data udata-len]
|
||||
(let [^bytes output-ba (byte-array udata-len)]
|
||||
(Snappy/uncompress data 6 (- (alength data) 6) output-ba 0)
|
||||
(t/decode output-ba {:type :json})))
|
||||
|
|
88
backend/src/uxbox/util/dispatcher.clj
Normal file
88
backend/src/uxbox/util/dispatcher.clj
Normal file
|
@ -0,0 +1,88 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.dispatcher
|
||||
"A generic service dispatcher implementation."
|
||||
(:refer-clojure :exclude [defmethod])
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[expound.alpha :as expound]
|
||||
[sieppari.core :as sp]
|
||||
[sieppari.context :as spx]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.exceptions :as ex])
|
||||
(:import
|
||||
java.util.Map
|
||||
java.util.List
|
||||
java.util.Map$Entry
|
||||
java.util.HashMap))
|
||||
|
||||
(definterface IDispatcher
|
||||
(^void add [key f metadata]))
|
||||
|
||||
(deftype Dispatcher [reg attr interceptors]
|
||||
IDispatcher
|
||||
(add [this key f metadata]
|
||||
(.put ^Map reg key (Map/entry f metadata))
|
||||
nil)
|
||||
|
||||
clojure.lang.IFn
|
||||
(invoke [_ params]
|
||||
(let [key (get params attr)
|
||||
entry (.get ^Map reg key)]
|
||||
(if (nil? entry)
|
||||
(p/rejected (ex/error :type :not-found
|
||||
:code :method-not-found
|
||||
:hint "No method found for the current request."))
|
||||
(let [f (.getKey ^Map$Entry entry)
|
||||
m (.getValue ^Map$Entry entry)
|
||||
d (p/deferred)]
|
||||
|
||||
(sp/execute (conj interceptors f)
|
||||
(with-meta params m)
|
||||
#(p/resolve! d %)
|
||||
#(p/reject! d %))
|
||||
d)))))
|
||||
|
||||
(defn dispatcher?
|
||||
[v]
|
||||
(instance? Dispatcher v))
|
||||
|
||||
(defmacro defservice
|
||||
[sname {:keys [dispatch-by interceptors]}]
|
||||
`(defonce ~sname (Dispatcher. (HashMap.)
|
||||
~dispatch-by
|
||||
~interceptors)))
|
||||
|
||||
(defmacro defmethod
|
||||
[sname key metadata args & rest]
|
||||
(s/assert symbol? sname)
|
||||
(s/assert keyword? key)
|
||||
(s/assert map? metadata)
|
||||
(s/assert vector? args)
|
||||
(let [f `(fn ~args ~@rest)]
|
||||
`(do
|
||||
(s/assert dispatcher? ~sname)
|
||||
(.add ~sname ~key ~f ~metadata)
|
||||
~sname)))
|
||||
|
||||
(def spec-interceptor
|
||||
"An interceptor that conforms the request with the user provided
|
||||
spec."
|
||||
{:enter (fn [{:keys [request] :as data}]
|
||||
(let [{:keys [spec]} (meta request)]
|
||||
(if spec
|
||||
(let [result (s/conform spec request)]
|
||||
(if (not= result ::s/invalid)
|
||||
(assoc data :request result)
|
||||
(let [data (s/explain-data spec request)]
|
||||
(ex/raise :type :validation
|
||||
:code :spec-validation
|
||||
:explain (with-out-str
|
||||
(expound/printer data))
|
||||
:data data))))
|
||||
data)))})
|
103
backend/src/uxbox/util/emails.clj
Normal file
103
backend/src/uxbox/util/emails.clj
Normal file
|
@ -0,0 +1,103 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.emails
|
||||
(:require
|
||||
[clojure.java.io :as io]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[instaparse.core :as insta]
|
||||
[uxbox.util.exceptions :as ex]
|
||||
[uxbox.util.spec :as us]
|
||||
[uxbox.util.template :as tmpl]))
|
||||
|
||||
;; --- Impl.
|
||||
|
||||
(def ^:private grammar
|
||||
(str "message = part*"
|
||||
"part = begin header body end; "
|
||||
"header = tag* eol; "
|
||||
"tag = space keyword; "
|
||||
"body = line*; "
|
||||
"begin = #'--\\s+begin\\s+'; "
|
||||
"end = #'--\\s+end\\s*' eol*; "
|
||||
"keyword = #':[\\w\\-]+'; "
|
||||
"space = #'\\s*'; "
|
||||
"line = #'.*\\n'; "
|
||||
"eol = ('\\n' | '\\r\\n'); "))
|
||||
|
||||
(def ^:private parse-fn (insta/parser grammar))
|
||||
(def ^:private email-path "emails/%(lang)s/%(id)s.mustache")
|
||||
|
||||
(defn- parse-template
|
||||
[content]
|
||||
(loop [state {}
|
||||
parts (drop 1 (parse-fn content))]
|
||||
(if-let [[_ _ header body] (first parts)]
|
||||
(let [type (get-in header [1 2 1])
|
||||
type (keyword (str/slice type 1))
|
||||
content (apply str (map second (rest body)))]
|
||||
(recur (assoc state type (str/trim content " \n"))
|
||||
(rest parts)))
|
||||
state)))
|
||||
|
||||
(s/def ::subject ::us/string)
|
||||
(s/def ::body-text ::us/string)
|
||||
(s/def ::body-html ::us/string)
|
||||
|
||||
(s/def ::parsed-email
|
||||
(s/keys :req-un [::subject ::body-html ::body-html]))
|
||||
|
||||
(defn- build-base-email
|
||||
[data context]
|
||||
(when-not (s/valid? ::parsed-email data)
|
||||
(ex/raise :type :internal
|
||||
:code :template-parse-error
|
||||
:hint "Seems like the email template has invalid data."
|
||||
:contex data))
|
||||
{:subject (:subject data)
|
||||
:body [:alternatives
|
||||
{:type "text/plain; charset=utf-8"
|
||||
:contex (:body-text data)}
|
||||
{:type "text/html; charset=utf-8"
|
||||
:contex (:body-html data)}]})
|
||||
|
||||
(defn- impl-build-email
|
||||
[id context]
|
||||
(let [lang (:lang context :en)
|
||||
path (str/format email-path {:id (name id) :lang (name lang)})]
|
||||
(-> (tmpl/render path context)
|
||||
(parse-template)
|
||||
(build-base-email context))))
|
||||
|
||||
;; --- Public API
|
||||
|
||||
(s/def ::priority #{:high :low})
|
||||
(s/def ::to ::us/email)
|
||||
(s/def ::from ::us/email)
|
||||
(s/def ::reply-to ::us/email)
|
||||
(s/def ::lang ::us/string)
|
||||
|
||||
(s/def ::context
|
||||
(s/keys :req-un [::to]
|
||||
:opt-un [::reply-to ::from ::lang ::priority]))
|
||||
|
||||
(defn build
|
||||
([id] (build id {}))
|
||||
([id extra-context]
|
||||
(s/assert keyword? id)
|
||||
(fn [context]
|
||||
(s/assert ::context context)
|
||||
(let [context (merge extra-context context)
|
||||
email (impl-build-email id context)]
|
||||
(when-not email
|
||||
(ex/raise :type :internal
|
||||
:code :email-template-does-not-exists
|
||||
:hint "seems like the template is wrong or does not exists."
|
||||
::id id))
|
||||
(cond-> (assoc email :id id)
|
||||
(:from context) (assoc :from (:from context))
|
||||
(:reply-to context) (assoc :reply-to (:reply-to context)))))))
|
104
backend/src/uxbox/util/migrations.clj
Normal file
104
backend/src/uxbox/util/migrations.clj
Normal file
|
@ -0,0 +1,104 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.migrations
|
||||
(:require
|
||||
[clojure.java.io :as io]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[promesa.core :as p]
|
||||
[uxbox.util.pgsql :as pg]))
|
||||
|
||||
(s/def ::name string?)
|
||||
(s/def ::step (s/keys :req-un [::name ::desc ::fn]))
|
||||
(s/def ::steps (s/every ::step :kind vector?))
|
||||
(s/def ::migrations
|
||||
(s/keys :req-un [::name ::steps]))
|
||||
|
||||
;; --- Implementation
|
||||
|
||||
(defn- registered?
|
||||
"Check if concrete migration is already registred."
|
||||
[pool modname stepname]
|
||||
(let [sql "select * from migrations where module=$1 and step=$2"]
|
||||
(-> (pg/query pool [sql modname stepname])
|
||||
(p/then' (fn [rows]
|
||||
(pos? (count rows)))))))
|
||||
|
||||
(defn- register!
|
||||
"Register a concrete migration into local migrations database."
|
||||
[pool modname stepname]
|
||||
(let [sql "insert into migrations (module, step) values ($1, $2)"]
|
||||
(-> (pg/query pool [sql modname stepname])
|
||||
(p/then' (constantly nil)))))
|
||||
|
||||
|
||||
(defn- setup!
|
||||
"Initialize the database if it is not initialized."
|
||||
[pool]
|
||||
(let [sql (str "create table if not exists migrations ("
|
||||
" module text,"
|
||||
" step text,"
|
||||
" created_at timestamp DEFAULT current_timestamp,"
|
||||
" unique(module, step)"
|
||||
");")]
|
||||
(-> (pg/query pool sql)
|
||||
(p/then' (constantly nil)))))
|
||||
|
||||
(defn- impl-migrate-single
|
||||
[pool modname {:keys [name] :as migration}]
|
||||
(letfn [(execute []
|
||||
(p/do! (register! pool modname name)
|
||||
((:fn migration) pool)))]
|
||||
(-> (registered? pool modname (:name migration))
|
||||
(p/then (fn [registered?]
|
||||
(when-not registered?
|
||||
(println (str/format "applying migration - %s: %s" modname name))
|
||||
(execute)))))))
|
||||
|
||||
(defn- impl-migrate
|
||||
[pool migrations {:keys [fake] :or {fake false}}]
|
||||
(s/assert ::migrations migrations)
|
||||
(let [mname (:name migrations)
|
||||
steps (:steps migrations)]
|
||||
;; (println (str/format "Applying migrations for `%s`:" mname))
|
||||
(pg/with-atomic [conn pool]
|
||||
(p/run! #(impl-migrate-single conn mname %) steps))))
|
||||
|
||||
(defprotocol IMigrationContext
|
||||
(-migrate [_ migration options]))
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(defn context
|
||||
"Create new instance of migration context."
|
||||
([pool] (context pool nil))
|
||||
([pool opts]
|
||||
@(setup! pool)
|
||||
(reify
|
||||
java.lang.AutoCloseable
|
||||
(close [_] #_(.close pool))
|
||||
|
||||
IMigrationContext
|
||||
(-migrate [_ migration options]
|
||||
(impl-migrate pool migration options)))))
|
||||
|
||||
(defn migrate
|
||||
"Main entry point for apply a migration."
|
||||
([ctx migrations]
|
||||
(migrate ctx migrations nil))
|
||||
([ctx migrations options]
|
||||
(-migrate ctx migrations options)))
|
||||
|
||||
(defn resource
|
||||
"Helper for setup migration functions
|
||||
just using a simple path to sql file
|
||||
located in the class path."
|
||||
[path]
|
||||
(fn [pool]
|
||||
(let [sql (slurp (io/resource path))]
|
||||
(-> (pg/query pool sql)
|
||||
(p/then' (constantly true))))))
|
150
backend/src/uxbox/util/pgsql.clj
Normal file
150
backend/src/uxbox/util/pgsql.clj
Normal file
|
@ -0,0 +1,150 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.pgsql
|
||||
"Asynchronous posgresql client."
|
||||
(:require
|
||||
[promesa.core :as p])
|
||||
(:import
|
||||
clojure.lang.IDeref
|
||||
java.util.function.Supplier
|
||||
java.lang.ThreadLocal
|
||||
io.vertx.core.Vertx
|
||||
io.vertx.core.Handler
|
||||
io.vertx.core.AsyncResult
|
||||
io.vertx.core.buffer.Buffer
|
||||
io.vertx.pgclient.PgPool
|
||||
io.vertx.sqlclient.impl.ArrayTuple
|
||||
io.vertx.sqlclient.RowSet
|
||||
io.vertx.sqlclient.PoolOptions))
|
||||
|
||||
(declare impl-execute)
|
||||
(declare impl-query)
|
||||
(declare impl-handler)
|
||||
(declare impl-transact)
|
||||
(declare seqable->tuple)
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(defn vertx?
|
||||
[v]
|
||||
(instance? Vertx v))
|
||||
|
||||
(defn pool?
|
||||
[v]
|
||||
(instance? PgPool v))
|
||||
|
||||
(defn bytes->buffer
|
||||
[data]
|
||||
(Buffer/buffer ^bytes data))
|
||||
|
||||
(defn pool
|
||||
([uri] (pool uri {}))
|
||||
([uri {:keys [system max-size] :or {max-size 5}}]
|
||||
(let [^PoolOptions poptions (PoolOptions.)]
|
||||
(when max-size (.setMaxSize poptions max-size))
|
||||
(if (vertx? system)
|
||||
(PgPool/pool ^Vertx system ^String uri poptions)
|
||||
(PgPool/pool ^String uri poptions)))))
|
||||
|
||||
(defn tl-pool
|
||||
"Thread local based connection pool."
|
||||
([uri] (tl-pool uri {}))
|
||||
([uri options]
|
||||
(let [state (ThreadLocal/withInitial (reify Supplier
|
||||
(get [_]
|
||||
(pool uri options))))]
|
||||
(reify IDeref
|
||||
(deref [_]
|
||||
(.get state))))))
|
||||
|
||||
(defn query
|
||||
([conn sqlv] (query conn sqlv {}))
|
||||
([conn sqlv opts]
|
||||
(cond
|
||||
(vector? sqlv)
|
||||
(impl-query conn (first sqlv) (rest sqlv) opts)
|
||||
|
||||
(string? sqlv)
|
||||
(impl-query conn sqlv nil opts)
|
||||
|
||||
:else
|
||||
(throw (ex-info "Invalid arguments" {:sqlv sqlv})))))
|
||||
|
||||
(defn query-one
|
||||
[& args]
|
||||
(p/map first (apply query args)))
|
||||
|
||||
(defn row->map
|
||||
[row]
|
||||
(reduce (fn [acc index]
|
||||
(let [cname (.getColumnName row index)]
|
||||
(assoc acc cname (.getValue row index))))
|
||||
{}
|
||||
(range (.size row))))
|
||||
|
||||
(defmacro with-atomic
|
||||
[[bsym psym] & body]
|
||||
`(impl-transact ~psym (fn [c#] (let [~bsym c#] ~@body))))
|
||||
|
||||
;; --- Implementation
|
||||
|
||||
(defn- seqable->tuple
|
||||
[v]
|
||||
(let [res (ArrayTuple. (count v))]
|
||||
(run! #(.addValue res %) v)
|
||||
res))
|
||||
|
||||
(defn- impl-handler
|
||||
[resolve reject]
|
||||
(reify Handler
|
||||
(handle [_ ar]
|
||||
(if (.failed ar)
|
||||
(reject (.cause ar))
|
||||
(resolve (.result ar))))))
|
||||
|
||||
(defn- impl-execute
|
||||
[conn sql params]
|
||||
(if (seq params)
|
||||
(p/create #(.preparedQuery conn sql (seqable->tuple params) (impl-handler %1 %2)))
|
||||
(p/create #(.query conn sql (impl-handler %1 %2)))))
|
||||
|
||||
(defn- impl-query
|
||||
[conn sql params {:keys [xfm] :as opts}]
|
||||
(let [conn (if (instance? IDeref conn) @conn conn)]
|
||||
(->> (impl-execute conn sql params)
|
||||
(p/map (fn [rows]
|
||||
(if xfm
|
||||
(into [] xfm rows)
|
||||
(into [] (map vec) rows)))))))
|
||||
|
||||
(defn impl-transact
|
||||
[pool f]
|
||||
(let [pool (if (instance? IDeref pool) @pool pool)]
|
||||
(letfn [(commit [tx]
|
||||
(p/create #(.commit tx (impl-handler %1 %2))))
|
||||
(rollback [tx]
|
||||
(p/create #(.rollback tx (impl-handler %1 %2))))
|
||||
(on-connect [conn]
|
||||
(let [tx (.begin conn)
|
||||
df (p/deferred)]
|
||||
(-> (f conn)
|
||||
(p/finally (fn [v e]
|
||||
(if e
|
||||
(-> (rollback tx)
|
||||
(p/finally (fn [& args]
|
||||
(.close conn)
|
||||
(p/reject! df e))))
|
||||
(-> (commit tx)
|
||||
(p/finally (fn [_ e']
|
||||
(.close conn)
|
||||
(if e'
|
||||
(p/reject! df e')
|
||||
(p/resolve! df v)))))))))
|
||||
df))]
|
||||
(-> (p/create #(.getConnection pool (impl-handler %1 %2)))
|
||||
(p/bind on-connect)))))
|
||||
|
|
@ -1,139 +0,0 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.quartz
|
||||
"A lightweight abstraction layer for quartz job scheduling library."
|
||||
(:import java.util.Properties
|
||||
org.quartz.Scheduler
|
||||
org.quartz.SchedulerException
|
||||
org.quartz.impl.StdSchedulerFactory
|
||||
org.quartz.Job
|
||||
org.quartz.JobBuilder
|
||||
org.quartz.JobDataMap
|
||||
org.quartz.JobExecutionContext
|
||||
org.quartz.TriggerBuilder
|
||||
org.quartz.CronScheduleBuilder
|
||||
org.quartz.SimpleScheduleBuilder
|
||||
org.quartz.PersistJobDataAfterExecution
|
||||
org.quartz.DisallowConcurrentExecution))
|
||||
|
||||
;; --- Implementation
|
||||
|
||||
(defn- map->props
|
||||
[data]
|
||||
(let [p (Properties.)]
|
||||
(run! (fn [[k v]] (.setProperty p (name k) (str v))) (seq data))
|
||||
p))
|
||||
|
||||
(deftype JobImpl []
|
||||
Job
|
||||
(execute [_ context]
|
||||
(let [^JobDataMap data (.. context getJobDetail getJobDataMap)
|
||||
args (.get data "arguments")
|
||||
state (.get data "state")
|
||||
callable (.get data "callable")]
|
||||
(if state
|
||||
(apply callable state args)
|
||||
(apply callable args)))))
|
||||
|
||||
(defn- resolve-var
|
||||
[sym]
|
||||
(let [ns (symbol (namespace sym))
|
||||
func (symbol (name sym))]
|
||||
(require ns)
|
||||
(resolve func)))
|
||||
|
||||
(defn- build-trigger
|
||||
[opts]
|
||||
(let [repeat? (::repeat? opts true)
|
||||
interval (::interval opts 1000)
|
||||
cron (::cron opts)
|
||||
group (::group opts "uxbox")
|
||||
schdl (if cron
|
||||
(CronScheduleBuilder/cronSchedule cron)
|
||||
(let [schdl (SimpleScheduleBuilder/simpleSchedule)
|
||||
schdl (if (number? repeat?)
|
||||
(.withRepeatCount schdl repeat?)
|
||||
(.repeatForever schdl))]
|
||||
(.withIntervalInMilliseconds schdl interval)))
|
||||
name (str (:name opts) "-trigger")
|
||||
bldr (doto (TriggerBuilder/newTrigger)
|
||||
(.startNow)
|
||||
(.withIdentity name group)
|
||||
(.withSchedule schdl))]
|
||||
(.build bldr)))
|
||||
|
||||
(defn- build-job-detail
|
||||
[fvar args]
|
||||
(let [opts (meta fvar)
|
||||
state (::state opts)
|
||||
group (::group opts "uxbox")
|
||||
name (str (:name opts))
|
||||
data {"callable" @fvar
|
||||
"arguments" (into [] args)
|
||||
"state" (if state (atom state) nil)}
|
||||
bldr (doto (JobBuilder/newJob JobImpl)
|
||||
(.storeDurably false)
|
||||
(.usingJobData (JobDataMap. data))
|
||||
(.withIdentity name group))]
|
||||
(.build bldr)))
|
||||
|
||||
(defn- make-scheduler-props
|
||||
[{:keys [name daemon? threads thread-priority]
|
||||
:or {name "uxbox-scheduler"
|
||||
daemon? true
|
||||
threads 1
|
||||
thread-priority Thread/MIN_PRIORITY}}]
|
||||
(map->props
|
||||
{"org.quartz.threadPool.threadCount" threads
|
||||
"org.quartz.threadPool.threadPriority" thread-priority
|
||||
"org.quartz.threadPool.makeThreadsDaemons" (if daemon? "true" "false")
|
||||
"org.quartz.scheduler.instanceName" name
|
||||
"org.quartz.scheduler.makeSchedulerThreadDaemon" (if daemon? "true" "false")}))
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(defn scheduler
|
||||
"Create a new scheduler instance."
|
||||
([] (scheduler nil))
|
||||
([opts]
|
||||
(let [props (make-scheduler-props opts)
|
||||
factory (StdSchedulerFactory. props)]
|
||||
(.getScheduler factory))))
|
||||
|
||||
(declare schedule!)
|
||||
|
||||
(defn start!
|
||||
([schd]
|
||||
(start! schd nil))
|
||||
([schd {:keys [delay search-on]}]
|
||||
;; Start the scheduler
|
||||
(if (number? delay)
|
||||
(.startDelayed schd (int delay))
|
||||
(.start schd))
|
||||
|
||||
(when (coll? search-on)
|
||||
(run! (fn [ns]
|
||||
(require ns)
|
||||
(doseq [v (vals (ns-publics ns))]
|
||||
(when (::job (meta v))
|
||||
(schedule! schd v))))
|
||||
search-on))
|
||||
schd))
|
||||
|
||||
(defn stop!
|
||||
[scheduler]
|
||||
(.shutdown ^Scheduler scheduler true))
|
||||
|
||||
;; TODO: add proper handling of `:delay` option that should allow
|
||||
;; execute a task firstly delayed until some milliseconds or at certain time.
|
||||
|
||||
(defn schedule!
|
||||
[schd f & args]
|
||||
(let [vf (if (symbol? f) (resolve-var f) f)
|
||||
job (build-job-detail vf args)
|
||||
trigger (build-trigger (meta vf))]
|
||||
(.scheduleJob ^Scheduler schd job trigger)))
|
|
@ -2,30 +2,28 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.snappy
|
||||
"A lightweight abstraction layer for snappy compression library."
|
||||
(:require [buddy.core.codecs :as codecs])
|
||||
(:import org.xerial.snappy.Snappy
|
||||
org.xerial.snappy.SnappyFramedInputStream
|
||||
org.xerial.snappy.SnappyFramedOutputStream
|
||||
|
||||
java.io.OutputStream
|
||||
java.io.InputStream))
|
||||
|
||||
(:import
|
||||
java.io.ByteArrayInputStream
|
||||
java.io.ByteArrayOutputStream
|
||||
java.io.InputStream
|
||||
java.io.OutputStream
|
||||
org.xerial.snappy.Snappy
|
||||
org.xerial.snappy.SnappyFramedInputStream
|
||||
org.xerial.snappy.SnappyFramedOutputStream))
|
||||
|
||||
(defn compress
|
||||
"Compress data unsing snappy compression algorithm."
|
||||
[data]
|
||||
(-> (codecs/to-bytes data)
|
||||
(Snappy/compress)))
|
||||
[^bytes data]
|
||||
(Snappy/compress data))
|
||||
|
||||
(defn uncompress
|
||||
"Uncompress data using snappy compression algorithm."
|
||||
[data]
|
||||
(-> (codecs/to-bytes data)
|
||||
(Snappy/uncompress)))
|
||||
[^bytes data]
|
||||
(Snappy/uncompress data))
|
||||
|
||||
(defn input-stream
|
||||
"Create a Snappy framed input stream."
|
||||
|
|
|
@ -6,9 +6,11 @@
|
|||
|
||||
(ns uxbox.util.spec
|
||||
(:refer-clojure :exclude [keyword uuid vector boolean map set])
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[uxbox.util.exceptions :as ex])
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
[datoteka.core :as fs]
|
||||
[uxbox.util.exceptions :as ex])
|
||||
(:import java.time.Instant))
|
||||
|
||||
;; --- Constants
|
||||
|
@ -95,8 +97,16 @@
|
|||
[v]
|
||||
(if v "true" "false"))
|
||||
|
||||
(defn path-conformer
|
||||
[v]
|
||||
(cond
|
||||
(string? v) (fs/path v)
|
||||
(fs/path? v) v
|
||||
:else ::s/invalid))
|
||||
|
||||
;; --- Default Specs
|
||||
|
||||
(s/def ::string string?)
|
||||
(s/def ::integer (s/conformer integer-conformer str))
|
||||
(s/def ::uuid (s/conformer uuid-conformer str))
|
||||
(s/def ::boolean (s/conformer boolean-conformer boolean-unformer))
|
||||
|
@ -104,14 +114,19 @@
|
|||
(s/def ::negative neg?)
|
||||
(s/def ::uploaded-file any?)
|
||||
(s/def ::bytes bytes?)
|
||||
(s/def ::path path?)
|
||||
(s/def ::email email?)
|
||||
(s/def ::file any?)
|
||||
|
||||
(s/def ::name ::string)
|
||||
(s/def ::path (s/conformer path-conformer str))
|
||||
(s/def ::size ::integer)
|
||||
(s/def ::mtype ::string)
|
||||
(s/def ::upload
|
||||
(s/keys :req-un [::name ::path ::size ::mtype]))
|
||||
|
||||
;; TODO: deprecated
|
||||
(s/def ::id ::uuid)
|
||||
(s/def ::name string?)
|
||||
(s/def ::username string?)
|
||||
(s/def ::password string?)
|
||||
(s/def ::version integer?)
|
||||
(s/def ::token string?)
|
||||
(s/def ::username ::string)
|
||||
(s/def ::password ::string)
|
||||
(s/def ::token ::string)
|
||||
|
||||
|
|
251
backend/src/uxbox/util/sql.clj
Normal file
251
backend/src/uxbox/util/sql.clj
Normal file
|
@ -0,0 +1,251 @@
|
|||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
;; All rights reserved.
|
||||
;;
|
||||
;; Redistribution and use in source and binary forms, with or without
|
||||
;; modification, are permitted provided that the following conditions are met:
|
||||
;;
|
||||
;; * Redistributions of source code must retain the above copyright notice, this
|
||||
;; list of conditions and the following disclaimer.
|
||||
;;
|
||||
;; * Redistributions in binary form must reproduce the above copyright notice,
|
||||
;; this list of conditions and the following disclaimer in the documentation
|
||||
;; and/or other materials provided with the distribution.
|
||||
;;
|
||||
;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
;; AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
;; DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
||||
(ns uxbox.util.sql
|
||||
"A composable sql helpers."
|
||||
(:refer-clojure :exclude [test update set format])
|
||||
(:require [clojure.core :as c]))
|
||||
|
||||
(defn- query?
|
||||
[m]
|
||||
(::query m))
|
||||
|
||||
(defn select
|
||||
[]
|
||||
{::query true
|
||||
::type ::select})
|
||||
|
||||
(defn update
|
||||
([table]
|
||||
(update table nil))
|
||||
([table alias]
|
||||
{::query true
|
||||
::type ::update
|
||||
::table [table alias]}))
|
||||
|
||||
(defn delete
|
||||
[]
|
||||
{::query true
|
||||
::type ::delete})
|
||||
|
||||
(defn insert
|
||||
[table fields]
|
||||
{::query true
|
||||
::table table
|
||||
::fields fields
|
||||
::type ::insert})
|
||||
|
||||
(defn from
|
||||
([m name]
|
||||
(from m name nil))
|
||||
([m name alias]
|
||||
{:pre [(query? m)]}
|
||||
(c/update m ::from (fnil conj []) [name alias])))
|
||||
|
||||
(defn field
|
||||
([m name]
|
||||
(field m name nil))
|
||||
([m name alias]
|
||||
(c/update m ::fields (fnil conj []) [name alias])))
|
||||
|
||||
(defn fields
|
||||
[m & fields]
|
||||
(reduce (fn [acc item]
|
||||
(if (vector? item)
|
||||
(apply field acc item)
|
||||
(field acc item)))
|
||||
m
|
||||
fields))
|
||||
|
||||
(defn limit
|
||||
[m n]
|
||||
{:pre [(= (::type m) ::select)
|
||||
(query? m)]}
|
||||
(assoc m ::limit n))
|
||||
|
||||
(defn offset
|
||||
[m n]
|
||||
{:pre [(= (::type m) ::select)
|
||||
(query? m)]}
|
||||
(assoc m ::offset n))
|
||||
|
||||
(defn- join*
|
||||
[m type table alias condition]
|
||||
{:pre [(= (::type m) ::select)
|
||||
(query? m)]}
|
||||
(c/update m ::joins (fnil conj [])
|
||||
{:type type
|
||||
:name table
|
||||
:alias alias
|
||||
:condition condition}))
|
||||
|
||||
(defn join
|
||||
([m table condition]
|
||||
(join m table nil condition))
|
||||
([m table alias condition]
|
||||
{:pre [(= (::type m) ::select)
|
||||
(query? m)]}
|
||||
(join* m :inner table alias condition)))
|
||||
|
||||
(defn left-join
|
||||
([m table condition]
|
||||
(left-join m table nil condition))
|
||||
([m table alias condition]
|
||||
{:pre [(= (::type m) ::select)
|
||||
(query? m)]}
|
||||
(join* m :left table alias condition)))
|
||||
|
||||
(defn where
|
||||
[m condition & params]
|
||||
{:pre [(query? m)]}
|
||||
(-> m
|
||||
(c/update ::where (fnil conj []) condition)
|
||||
(cond-> (seq params)
|
||||
(c/update ::params (fnil into []) params))))
|
||||
|
||||
(defn set
|
||||
[m field value]
|
||||
{:pre [(query? m)]}
|
||||
(-> m
|
||||
(c/update ::assignations (fnil conj []) field)
|
||||
(c/update ::params (fnil conj []) value)))
|
||||
|
||||
(defn values
|
||||
[m values]
|
||||
{:pre [(query? m)]}
|
||||
(assoc ::values values))
|
||||
|
||||
(defn raw
|
||||
[m sql & params]
|
||||
(-> m
|
||||
(c/update ::raw (fnil conj []) sql)
|
||||
(c/update ::params (fnil into []) params)))
|
||||
|
||||
(defmulti format ::type)
|
||||
|
||||
(defn fmt
|
||||
[m]
|
||||
(into [(format m)] (::params m)))
|
||||
|
||||
;; --- Formating
|
||||
|
||||
(defn- format-fields
|
||||
[fields]
|
||||
(letfn [(transform [[name alias]]
|
||||
(if (string? alias)
|
||||
(str name " " alias)
|
||||
name))]
|
||||
(apply str (->> (map transform fields)
|
||||
(interpose ", ")))))
|
||||
|
||||
(defn- format-join
|
||||
[{:keys [type name alias condition]}]
|
||||
(str (case type
|
||||
:inner "INNER JOIN "
|
||||
:left "LEFT JOIN ")
|
||||
(if alias
|
||||
(str name " " alias)
|
||||
name)
|
||||
" ON (" condition ")"))
|
||||
|
||||
(defn- format-joins
|
||||
[clauses]
|
||||
(apply str (->> (map format-join clauses)
|
||||
(interpose " "))))
|
||||
|
||||
(defn- format-where
|
||||
[conditions]
|
||||
(when (seq conditions)
|
||||
(str "WHERE (" (apply str (interpose ") AND (" conditions)) ")")))
|
||||
|
||||
|
||||
|
||||
(defn- format-assignations
|
||||
[assignations]
|
||||
(apply str (->> (map #(str % " = ?") assignations)
|
||||
(interpose ", "))))
|
||||
|
||||
(defn- format-raw
|
||||
[items]
|
||||
(when (seq items)
|
||||
(apply str (interpose " " items))))
|
||||
|
||||
(defmethod format ::select
|
||||
[{:keys [::fields ::from ::joins ::where]}]
|
||||
(str "SELECT "
|
||||
(format-fields fields)
|
||||
" FROM "
|
||||
(format-fields from)
|
||||
" "
|
||||
(format-joins joins)
|
||||
" "
|
||||
(format-where where)))
|
||||
|
||||
(defmethod format ::update
|
||||
[{:keys [::table ::assignations ::where]}]
|
||||
(str "UPDATE "
|
||||
(format-fields [table])
|
||||
" SET "
|
||||
(format-assignations assignations)
|
||||
" "
|
||||
(format-where where)))
|
||||
|
||||
(defmethod format ::delete
|
||||
[{:keys [::from ::where]}]
|
||||
(str "DELETE FROM "
|
||||
(format-fields from)
|
||||
" "
|
||||
(format-where where)))
|
||||
|
||||
(defmethod format ::insert
|
||||
[{:keys [::table ::fields ::values ::raw]}]
|
||||
(let [fsize (count fields)
|
||||
pholder (str "(" (apply str (->> (map (constantly "?") fields)
|
||||
(interpose ", "))) ")")]
|
||||
|
||||
(str "INSERT INTO " table "(" (apply str (interpose ", " fields)) ")"
|
||||
" VALUES " (apply str (->> (map (constantly pholder) values)
|
||||
(interpose ", ")))
|
||||
" "
|
||||
(format-raw raw))))
|
||||
|
||||
;; (defn test-update
|
||||
;; []
|
||||
;; (-> (update "users" "u")
|
||||
;; (set "u.username" "foobar")
|
||||
;; (set "u.email" "niwi@niwi.nz")
|
||||
;; (where "u.id = ? AND u.deleted_at IS null" 555)))
|
||||
|
||||
;; (defn test-delete
|
||||
;; []
|
||||
;; (-> (delete)
|
||||
;; (from "users" "u")
|
||||
;; (where "u.id = ? AND u.deleted_at IS null" 555)))
|
||||
|
||||
;; (defn test-insert
|
||||
;; []
|
||||
;; (-> (insert "users" ["id", "username"])
|
||||
;; (values [[1 "niwinz"] [2 "niwibe"]])
|
||||
;; (raw "RETURNING *")))
|
||||
|
|
@ -1,3 +0,0 @@
|
|||
(ns uxbox.util.struct
|
||||
(:refer-clojure :exclude [keyword uuid vector boolean long map set])
|
||||
(:require [struct.core :as st]))
|
|
@ -2,55 +2,63 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.template
|
||||
"A lightweight abstraction over mustache.java template engine.
|
||||
The documentation can be found: http://mustache.github.io/mustache.5.html"
|
||||
(:require [clojure.walk :as walk]
|
||||
[clojure.java.io :as io])
|
||||
(:import java.io.StringReader
|
||||
java.io.StringWriter
|
||||
java.util.HashMap
|
||||
com.github.mustachejava.DefaultMustacheFactory
|
||||
com.github.mustachejava.Mustache))
|
||||
(:require
|
||||
[clojure.walk :as walk]
|
||||
[clojure.java.io :as io]
|
||||
[uxbox.util.exceptions :as ex])
|
||||
(:import
|
||||
java.io.StringReader
|
||||
java.util.HashMap
|
||||
java.util.function.Function;
|
||||
com.github.mustachejava.DefaultMustacheFactory
|
||||
com.github.mustachejava.Mustache))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Impl
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(def ^DefaultMustacheFactory +mustache-factory+ (DefaultMustacheFactory.))
|
||||
|
||||
(def ^:private
|
||||
^DefaultMustacheFactory
|
||||
+mustache-factory+ (DefaultMustacheFactory.))
|
||||
(defn- adapt-context
|
||||
[data]
|
||||
(walk/postwalk (fn [x]
|
||||
(cond
|
||||
(instance? clojure.lang.Named x)
|
||||
(name x)
|
||||
|
||||
(defprotocol ITemplate
|
||||
"A basic template rendering abstraction."
|
||||
(-render [template context]))
|
||||
(instance? clojure.lang.MapEntry x)
|
||||
x
|
||||
|
||||
(extend-type Mustache
|
||||
ITemplate
|
||||
(-render [template context]
|
||||
(with-out-str
|
||||
(let [scope (HashMap. (walk/stringify-keys context))]
|
||||
(.execute template *out* scope)))))
|
||||
(fn? x)
|
||||
(reify Function
|
||||
(apply [this content]
|
||||
(x content)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Public Api
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(or (vector? x) (list? x))
|
||||
(java.util.ArrayList. x)
|
||||
|
||||
(map? x)
|
||||
(java.util.HashMap. x)
|
||||
|
||||
(set? x)
|
||||
(java.util.HashSet. x)
|
||||
|
||||
:else
|
||||
x))
|
||||
data))
|
||||
|
||||
(defn render-string
|
||||
"Render string as mustache template."
|
||||
([^String template]
|
||||
(render-string template {}))
|
||||
([^String template context]
|
||||
(let [reader (StringReader. template)
|
||||
template (.compile +mustache-factory+ reader "example")]
|
||||
(-render template context))))
|
||||
|
||||
(defn render
|
||||
"Load a file from the class path and render
|
||||
it using mustache template."
|
||||
([^String path]
|
||||
(render path {}))
|
||||
([^String path context]
|
||||
(render-string (slurp (io/resource path)) context)))
|
||||
[path context]
|
||||
(try
|
||||
(let [context (adapt-context context)
|
||||
template (.compile +mustache-factory+ path)]
|
||||
(with-out-str
|
||||
(let [scope (HashMap. (walk/stringify-keys context))]
|
||||
(.execute ^Mustache template *out* scope))))
|
||||
(catch Exception cause
|
||||
(ex/raise :type :internal
|
||||
:code :template-render-error
|
||||
:cause cause))))
|
||||
|
||||
|
|
|
@ -5,10 +5,12 @@
|
|||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.time
|
||||
(:require [suricatta.proto :as sp]
|
||||
[suricatta.impl :as si]
|
||||
[cognitect.transit :as t])
|
||||
(:require
|
||||
#_[suricatta.proto :as sp]
|
||||
#_[suricatta.impl :as si]
|
||||
[cognitect.transit :as t])
|
||||
(:import java.time.Instant
|
||||
java.time.OffsetDateTime
|
||||
java.sql.Timestamp))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -17,11 +19,16 @@
|
|||
|
||||
(declare from-string)
|
||||
|
||||
(def ^:private write-handler
|
||||
(def ^:private instant-write-handler
|
||||
(t/write-handler
|
||||
(constantly "m")
|
||||
(fn [v] (str (.toEpochMilli v)))))
|
||||
|
||||
(def ^:private offset-datetime-write-handler
|
||||
(t/write-handler
|
||||
(constantly "m")
|
||||
(fn [v] (str (.toEpochMilli (.toInstant v))))))
|
||||
|
||||
(def ^:private read-handler
|
||||
(t/read-handler
|
||||
(fn [v] (-> (Long/parseLong v)
|
||||
|
@ -31,25 +38,26 @@
|
|||
{"m" read-handler})
|
||||
|
||||
(def +write-handlers+
|
||||
{Instant write-handler})
|
||||
{Instant instant-write-handler
|
||||
OffsetDateTime offset-datetime-write-handler})
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Persistence Layer Conversions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; ;; Persistence Layer Conversions
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(extend-protocol sp/IParam
|
||||
Instant
|
||||
(-param [self ctx]
|
||||
(si/sql->param "{0}::timestamptz" (.toString self))))
|
||||
;; (extend-protocol sp/IParam
|
||||
;; Instant
|
||||
;; (-param [self ctx]
|
||||
;; (si/sql->param "{0}::timestamptz" (.toString self))))
|
||||
|
||||
(extend-protocol sp/ISQLType
|
||||
Timestamp
|
||||
(-convert [self]
|
||||
(.toInstant self))
|
||||
;; (extend-protocol sp/ISQLType
|
||||
;; Timestamp
|
||||
;; (-convert [self]
|
||||
;; (.toInstant self))
|
||||
|
||||
java.time.OffsetDateTime
|
||||
(-convert [self]
|
||||
(.toInstant self)))
|
||||
;; java.time.OffsetDateTime
|
||||
;; (-convert [self]
|
||||
;; (.toInstant self)))
|
||||
|
||||
(defmethod print-method Instant
|
||||
[mv ^java.io.Writer writer]
|
||||
|
|
|
@ -2,15 +2,19 @@
|
|||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.transit
|
||||
(:require [cognitect.transit :as t]
|
||||
[clojure.java.io :as io]
|
||||
[uxbox.util.time :as dt])
|
||||
(:import java.io.ByteArrayInputStream
|
||||
java.io.ByteArrayOutputStream
|
||||
java.io.File))
|
||||
(:require
|
||||
[cognitect.transit :as t]
|
||||
[clojure.java.io :as io]
|
||||
[uxbox.util.time :as dt]
|
||||
[uxbox.util.data :as data])
|
||||
(:import
|
||||
io.vertx.core.buffer.Buffer
|
||||
java.io.ByteArrayInputStream
|
||||
java.io.ByteArrayOutputStream
|
||||
java.io.File))
|
||||
|
||||
;; --- Handlers
|
||||
|
||||
|
@ -49,28 +53,33 @@
|
|||
|
||||
;; --- High-Level Api
|
||||
|
||||
;; TODO: check performance of different options
|
||||
|
||||
(defn decode
|
||||
([data]
|
||||
(decode data nil))
|
||||
([data opts]
|
||||
(cond
|
||||
(string? data)
|
||||
(decode (.getBytes data "UTF-8") opts)
|
||||
(instance? Buffer data)
|
||||
(decode (.getBytes ^Buffer data) opts)
|
||||
|
||||
(bytes? data)
|
||||
(with-open [input (ByteArrayInputStream. data)]
|
||||
(read! (reader input opts)))
|
||||
|
||||
;; ;; TODO: temporal
|
||||
;; (instance? org.jooq.JSONB data)
|
||||
;; (decode (.toString data) opts)
|
||||
|
||||
(string? data)
|
||||
(decode (.getBytes data "UTF-8") opts)
|
||||
|
||||
:else
|
||||
(with-open [input (io/input-stream data)]
|
||||
(read! (reader input opts))))))
|
||||
|
||||
(defn encode
|
||||
(^bytes [data]
|
||||
([data]
|
||||
(encode data nil))
|
||||
(^bytes [data opts]
|
||||
([data opts]
|
||||
(with-open [out (ByteArrayOutputStream.)]
|
||||
(let [w (writer out opts)]
|
||||
(write! w data)
|
||||
|
|
|
@ -5,18 +5,29 @@
|
|||
;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns uxbox.util.uuid
|
||||
(:refer-clojure :exclude [next])
|
||||
(:require [clj-uuid :as uuid])
|
||||
(:import java.util.UUID))
|
||||
|
||||
(def ^:const zero uuid/+null+)
|
||||
(def ^:const oid uuid/+namespace-oid+)
|
||||
|
||||
(def random
|
||||
(defmacro next
|
||||
[]
|
||||
`(uuid/v1))
|
||||
|
||||
(defmacro random
|
||||
"Alias for clj-uuid/v4."
|
||||
uuid/v4)
|
||||
[]
|
||||
`(uuid/v4))
|
||||
|
||||
(defn namespaced
|
||||
(defmacro namespaced
|
||||
[ns data]
|
||||
(uuid/v5 ns data))
|
||||
`(uuid/v5 ~ns ~data))
|
||||
|
||||
(defmacro str->uuid
|
||||
[s]
|
||||
`(UUID/fromString ~s))
|
||||
|
||||
(defn from-string
|
||||
"Parse string uuid representation into proper UUID instance."
|
||||
|
|
|
@ -7,68 +7,68 @@
|
|||
(ns uxbox.util.workers
|
||||
"A distributed asynchronous tasks queue implementation on top
|
||||
of PostgreSQL reliable advirsory locking mechanism."
|
||||
(:require [suricatta.core :as sc]
|
||||
[uxbox.db :as db]
|
||||
[uxbox.sql :as sql]))
|
||||
#_(:require
|
||||
[suricatta.core :as sc]
|
||||
[uxbox.db :as db]))
|
||||
|
||||
(defn- poll-for-task
|
||||
[conn queue]
|
||||
(let [sql (sql/acquire-task {:queue queue})]
|
||||
(sc/fetch-one conn sql)))
|
||||
;; (defn- poll-for-task
|
||||
;; [conn queue]
|
||||
;; (let [sql (sql/acquire-task {:queue queue})]
|
||||
;; (sc/fetch-one conn sql)))
|
||||
|
||||
(defn- mark-task-done
|
||||
[conn {:keys [id]}]
|
||||
(let [sql (sql/mark-task-done {:id id})]
|
||||
(sc/execute conn sql)))
|
||||
;; (defn- mark-task-done
|
||||
;; [conn {:keys [id]}]
|
||||
;; (let [sql (sql/mark-task-done {:id id})]
|
||||
;; (sc/execute conn sql)))
|
||||
|
||||
(defn- mark-task-failed
|
||||
[conn {:keys [id]} error]
|
||||
(let [sql (sql/mark-task-done {:id id :error (.getMessage error)})]
|
||||
(sc/execute conn sql)))
|
||||
;; (defn- mark-task-failed
|
||||
;; [conn {:keys [id]} error]
|
||||
;; (let [sql (sql/mark-task-done {:id id :error (.getMessage error)})]
|
||||
;; (sc/execute conn sql)))
|
||||
|
||||
(defn- watch-unit
|
||||
[conn queue callback]
|
||||
(let [task (poll-for-task conn queue)]
|
||||
(if (nil? task)
|
||||
(Thread/sleep 1000)
|
||||
(try
|
||||
(sc/atomic conn
|
||||
(callback conn task)
|
||||
(mark-task-done conn task))
|
||||
(catch Exception e
|
||||
(mark-task-failed conn task e))))))
|
||||
;; (defn- watch-unit
|
||||
;; [conn queue callback]
|
||||
;; (let [task (poll-for-task conn queue)]
|
||||
;; (if (nil? task)
|
||||
;; (Thread/sleep 1000)
|
||||
;; (try
|
||||
;; (sc/atomic conn
|
||||
;; (callback conn task)
|
||||
;; (mark-task-done conn task))
|
||||
;; (catch Exception e
|
||||
;; (mark-task-failed conn task e))))))
|
||||
|
||||
(defn- watch-loop
|
||||
"Watch tasks on the specified queue and executes a
|
||||
callback for each task is received.
|
||||
NOTE: This function blocks the current thread."
|
||||
[queue callback]
|
||||
(try
|
||||
(loop []
|
||||
(with-open [conn (db/connection)]
|
||||
(sc/atomic conn (watch-unit conn queue callback)))
|
||||
(recur))
|
||||
(catch InterruptedException e
|
||||
;; just ignoring
|
||||
)))
|
||||
;; (defn- watch-loop
|
||||
;; "Watch tasks on the specified queue and executes a
|
||||
;; callback for each task is received.
|
||||
;; NOTE: This function blocks the current thread."
|
||||
;; [queue callback]
|
||||
;; (try
|
||||
;; (loop []
|
||||
;; (with-open [conn (db/connection)]
|
||||
;; (sc/atomic conn (watch-unit conn queue callback)))
|
||||
;; (recur))
|
||||
;; (catch InterruptedException e
|
||||
;; ;; just ignoring
|
||||
;; )))
|
||||
|
||||
(defn watch!
|
||||
[queue callback]
|
||||
(let [runnable #(watch-loop queue callback)
|
||||
thread (Thread. ^Runnable runnable)]
|
||||
(.setDaemon thread true)
|
||||
(.start thread)
|
||||
(reify
|
||||
java.lang.AutoCloseable
|
||||
(close [_]
|
||||
(.interrupt thread)
|
||||
(.join thread 2000))
|
||||
;; (defn watch!
|
||||
;; [queue callback]
|
||||
;; (let [runnable #(watch-loop queue callback)
|
||||
;; thread (Thread. ^Runnable runnable)]
|
||||
;; (.setDaemon thread true)
|
||||
;; (.start thread)
|
||||
;; (reify
|
||||
;; java.lang.AutoCloseable
|
||||
;; (close [_]
|
||||
;; (.interrupt thread)
|
||||
;; (.join thread 2000))
|
||||
|
||||
clojure.lang.IDeref
|
||||
(deref [_]
|
||||
(.join thread))
|
||||
;; clojure.lang.IDeref
|
||||
;; (deref [_]
|
||||
;; (.join thread))
|
||||
|
||||
clojure.lang.IBlockingDeref
|
||||
(deref [_ ms default]
|
||||
(.join thread ms)
|
||||
default))))
|
||||
;; clojure.lang.IBlockingDeref
|
||||
;; (deref [_ ms default]
|
||||
;; (.join thread ms)
|
||||
;; default))))
|
||||
|
|
223
backend/src/vertx/core.clj
Normal file
223
backend/src/vertx/core.clj
Normal file
|
@ -0,0 +1,223 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns vertx.core
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[vertx.eventbus :as vxe]
|
||||
[vertx.util :as vu])
|
||||
(:import
|
||||
io.vertx.core.Context
|
||||
io.vertx.core.DeploymentOptions
|
||||
io.vertx.core.Future
|
||||
io.vertx.core.Handler
|
||||
io.vertx.core.Verticle
|
||||
io.vertx.core.Vertx
|
||||
io.vertx.core.VertxOptions
|
||||
java.util.function.Supplier))
|
||||
|
||||
(declare opts->deployment-options)
|
||||
(declare opts->vertx-options)
|
||||
(declare build-verticle)
|
||||
(declare build-actor)
|
||||
(declare build-disposable)
|
||||
|
||||
;; --- Protocols
|
||||
|
||||
(definterface IVerticleFactory)
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(s/def :vertx.core$system/threads pos?)
|
||||
(s/def :vertx.core$system/on-error fn?)
|
||||
(s/def ::system-options
|
||||
(s/keys :opt-un [:vertx.core$system/threads
|
||||
:vertx.core$system/on-error]))
|
||||
|
||||
(defn system
|
||||
"Creates a new vertx actor system instance."
|
||||
([] (system {}))
|
||||
([options]
|
||||
(s/assert ::system-options options)
|
||||
(let [^VertxOptions opts (opts->vertx-options options)
|
||||
^Vertx vsm (Vertx/vertx opts)]
|
||||
(vxe/configure! vsm opts)
|
||||
vsm)))
|
||||
|
||||
(defn get-or-create-context
|
||||
[vsm]
|
||||
(.getOrCreateContext ^Vertx (vu/resolve-system vsm)))
|
||||
|
||||
(defn current-context
|
||||
[]
|
||||
(Vertx/currentContext))
|
||||
|
||||
(defn handle-on-context
|
||||
"Attaches the context (current if not explicitly provided) to the
|
||||
promise execution chain."
|
||||
([prm] (handle-on-context prm (current-context)))
|
||||
([prm ctx]
|
||||
(let [d (p/deferred)]
|
||||
(p/finally prm (fn [v e]
|
||||
(.runOnContext
|
||||
^Context ctx
|
||||
^Handler (reify Handler
|
||||
(handle [_ v']
|
||||
(if e
|
||||
(p/reject! d e)
|
||||
(p/resolve! d v)))))))
|
||||
d)))
|
||||
|
||||
(s/def :vertx.core$verticle/on-start fn?)
|
||||
(s/def :vertx.core$verticle/on-stop fn?)
|
||||
(s/def :vertx.core$verticle/on-error fn?)
|
||||
(s/def ::verticle-options
|
||||
(s/keys :req-un [:vertx.core$verticle/on-start]
|
||||
:opt-un [:vertx.core$verticle/on-stop
|
||||
:vertx.core$verticle/on-error]))
|
||||
|
||||
(defn verticle
|
||||
"Creates a verticle instance (factory)."
|
||||
[options]
|
||||
(s/assert ::verticle-options options)
|
||||
(reify
|
||||
IVerticleFactory
|
||||
Supplier
|
||||
(get [_] (build-verticle options))))
|
||||
|
||||
(defn verticle?
|
||||
"Return `true` if `v` is instance of `IVerticleFactory`."
|
||||
[v]
|
||||
(instance? IVerticleFactory v))
|
||||
|
||||
(s/def :vertx.core$actor/on-message fn?)
|
||||
(s/def ::actor-options
|
||||
(s/keys :req-un [:vertx.core$actor/on-message]
|
||||
:opt-un [:vertx.core$verticle/on-start
|
||||
:vertx.core$verticle/on-error
|
||||
:vertx.core$verticle/on-stop]))
|
||||
|
||||
(defn actor
|
||||
"A shortcut for create a verticle instance (factory) that consumes a
|
||||
specific topic."
|
||||
[topic options]
|
||||
(s/assert string? topic)
|
||||
(s/assert ::actor-options options)
|
||||
(reify
|
||||
IVerticleFactory
|
||||
Supplier
|
||||
(get [_] (build-actor topic options))))
|
||||
|
||||
(s/def :vertx.core$deploy/instances pos?)
|
||||
(s/def :vertx.core$deploy/worker boolean?)
|
||||
(s/def ::deploy-options
|
||||
(s/keys :opt-un [:vertx.core$deploy/worker
|
||||
:vertx.core$deploy/instances]))
|
||||
|
||||
(defn deploy!
|
||||
"Deploy a verticle."
|
||||
([vsm supplier] (deploy! vsm supplier nil))
|
||||
([vsm supplier options]
|
||||
(s/assert verticle? supplier)
|
||||
(s/assert ::deploy-options options)
|
||||
(let [d (p/deferred)
|
||||
o (opts->deployment-options options)]
|
||||
(.deployVerticle ^Vertx vsm
|
||||
^Supplier supplier
|
||||
^DeploymentOptions o
|
||||
^Handler (vu/deferred->handler d))
|
||||
(p/then' d (fn [id] (build-disposable vsm id))))))
|
||||
|
||||
(defn undeploy!
|
||||
"Undeploy the verticle, this function should be rarelly used because
|
||||
the easiest way to undeplo is executin the callable returned by
|
||||
`deploy!` function."
|
||||
[vsm id]
|
||||
(s/assert string? id)
|
||||
(let [d (p/deferred)]
|
||||
(.undeploy ^Vertx (vu/resolve-system vsm)
|
||||
^String id
|
||||
^Handler (vu/deferred->handler d))
|
||||
d))
|
||||
|
||||
;; --- Impl
|
||||
|
||||
(defn- build-verticle
|
||||
[{:keys [on-start on-stop on-error]
|
||||
:or {on-error (constantly nil)
|
||||
on-stop (constantly nil)}}]
|
||||
(let [vsm (volatile! nil)
|
||||
ctx (volatile! nil)
|
||||
lst (volatile! nil)]
|
||||
(reify Verticle
|
||||
(init [_ instance context]
|
||||
(vreset! vsm instance)
|
||||
(vreset! ctx context))
|
||||
(getVertx [_] @vsm)
|
||||
(^void start [_ ^Future o]
|
||||
(-> (p/do! (on-start @ctx))
|
||||
(p/handle (fn [state error]
|
||||
(if error
|
||||
(do
|
||||
(.fail o error)
|
||||
(on-error @ctx error))
|
||||
(do
|
||||
(when (map? state)
|
||||
(vswap! lst merge state))
|
||||
(.complete o)))))))
|
||||
(^void stop [_ ^Future o]
|
||||
(p/handle (p/do! (on-stop @ctx @lst))
|
||||
(fn [_ err]
|
||||
(if err
|
||||
(do (on-error err)
|
||||
(.fail o err))
|
||||
(.complete o))))))))
|
||||
|
||||
(defn- build-actor
|
||||
[topic {:keys [on-message on-error on-stop on-start]
|
||||
:or {on-error (constantly nil)
|
||||
on-start (constantly {})
|
||||
on-stop (constantly nil)}}]
|
||||
(letfn [(-on-start [ctx]
|
||||
(let [state (on-start ctx)
|
||||
state (if (map? state) state {})
|
||||
consumer (vxe/consumer ctx topic on-message)]
|
||||
(assoc state ::consumer consumer)))]
|
||||
(build-verticle {:on-error on-error
|
||||
:on-stop on-stop
|
||||
:on-start -on-start})))
|
||||
|
||||
(defn- build-disposable
|
||||
[vsm id]
|
||||
(reify
|
||||
clojure.lang.IDeref
|
||||
(deref [_] id)
|
||||
|
||||
clojure.lang.IFn
|
||||
(invoke [_] (undeploy! vsm id))
|
||||
|
||||
java.io.Closeable
|
||||
(close [_]
|
||||
@(undeploy! vsm id))))
|
||||
|
||||
(defn- opts->deployment-options
|
||||
[{:keys [instances worker]}]
|
||||
(let [opts (DeploymentOptions.)]
|
||||
(when instances (.setInstances opts (int instances)))
|
||||
(when worker (.setWorker opts worker))
|
||||
;; (.setInstances opts 4)
|
||||
;; (.setWorkerPoolSize opts 4)
|
||||
opts))
|
||||
|
||||
(defn- opts->vertx-options
|
||||
[{:keys [threads on-error]}]
|
||||
(let [opts (VertxOptions.)]
|
||||
(when threads (.setEventLoopPoolSize opts (int threads)))
|
||||
(when on-error (.exceptionHandler (vu/fn->handler on-error)))
|
||||
opts))
|
||||
|
||||
|
||||
|
122
backend/src/vertx/eventbus.clj
Normal file
122
backend/src/vertx/eventbus.clj
Normal file
|
@ -0,0 +1,122 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns vertx.eventbus
|
||||
(:require [promesa.core :as p]
|
||||
[vertx.util :as vu])
|
||||
(:import io.vertx.core.Vertx
|
||||
io.vertx.core.Handler
|
||||
io.vertx.core.Context
|
||||
io.vertx.core.eventbus.Message
|
||||
io.vertx.core.eventbus.MessageConsumer
|
||||
io.vertx.core.eventbus.DeliveryOptions
|
||||
io.vertx.core.eventbus.EventBus
|
||||
io.vertx.core.eventbus.MessageCodec
|
||||
java.util.function.Supplier))
|
||||
|
||||
(declare opts->delivery-opts)
|
||||
(declare resolve-eventbus)
|
||||
(declare build-message-codec)
|
||||
(declare build-message)
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(defn consumer
|
||||
[vsm topic f]
|
||||
(let [^EventBus bus (resolve-eventbus vsm)
|
||||
^MessageConsumer consumer (.consumer bus ^String topic)]
|
||||
(.handler consumer (reify Handler
|
||||
(handle [_ msg]
|
||||
(.pause consumer)
|
||||
(-> (p/do! (f vsm (build-message msg)))
|
||||
(p/handle (fn [res err]
|
||||
(.resume consumer)
|
||||
(.reply msg (or res err)
|
||||
(opts->delivery-opts {}))))))))
|
||||
consumer))
|
||||
|
||||
(defn publish!
|
||||
([vsm topic msg] (publish! vsm topic msg {}))
|
||||
([vsm topic msg opts]
|
||||
(let [bus (resolve-eventbus vsm)
|
||||
opts (opts->delivery-opts opts)]
|
||||
(.publish ^EventBus bus
|
||||
^String topic
|
||||
^Object msg
|
||||
^DeliveryOptions opts)
|
||||
nil)))
|
||||
|
||||
(defn send!
|
||||
([vsm topic msg] (send! vsm topic msg {}))
|
||||
([vsm topic msg opts]
|
||||
(let [bus (resolve-eventbus vsm)
|
||||
opts (opts->delivery-opts opts)]
|
||||
(.send ^EventBus bus
|
||||
^String topic
|
||||
^Object msg
|
||||
^DeliveryOptions opts)
|
||||
nil)))
|
||||
|
||||
(defn request!
|
||||
([vsm topic msg] (request! vsm topic msg {}))
|
||||
([vsm topic msg opts]
|
||||
(let [bus (resolve-eventbus vsm)
|
||||
opts (opts->delivery-opts opts)
|
||||
d (p/deferred)]
|
||||
(.request ^EventBus bus
|
||||
^String topic
|
||||
^Object msg
|
||||
^DeliveryOptions opts
|
||||
^Handler (vu/deferred->handler d))
|
||||
(p/then' d build-message))))
|
||||
|
||||
(defn configure!
|
||||
[vsm opts]
|
||||
(let [^EventBus bus (resolve-eventbus vsm)]
|
||||
(.registerCodec bus (build-message-codec))))
|
||||
|
||||
(defrecord Msg [body])
|
||||
|
||||
(defn message?
|
||||
[v]
|
||||
(instance? Msg v))
|
||||
|
||||
;; --- Impl
|
||||
|
||||
(defn- resolve-eventbus
|
||||
[o]
|
||||
(cond
|
||||
(instance? Vertx o) (.eventBus ^Vertx o)
|
||||
(instance? Context o) (resolve-eventbus (.owner ^Context o))
|
||||
(instance? EventBus o) o
|
||||
:else (throw (ex-info "unexpected argument" {}))))
|
||||
|
||||
(defn- build-message-codec
|
||||
[]
|
||||
;; TODO: implement the wire encode/decode using transit+msgpack
|
||||
(reify MessageCodec
|
||||
(encodeToWire [_ buffer data])
|
||||
(decodeFromWire [_ pos buffer])
|
||||
(transform [_ data] data)
|
||||
(name [_] "clj:msgpack")
|
||||
(^byte systemCodecID [_] (byte -1))))
|
||||
|
||||
(defn- build-message
|
||||
[^Message msg]
|
||||
(let [metadata {::reply-to (.replyAddress msg)
|
||||
::send? (.isSend msg)
|
||||
::address (.address msg)}
|
||||
body (.body msg)]
|
||||
(Msg. body metadata nil)))
|
||||
|
||||
(defn- opts->delivery-opts
|
||||
[{:keys [codec local?]}]
|
||||
(let [^DeliveryOptions opts (DeliveryOptions.)]
|
||||
(.setCodecName opts (or codec "clj:msgpack"))
|
||||
(when local? (.setLocalOnly opts true))
|
||||
opts))
|
||||
|
||||
|
74
backend/src/vertx/http.clj
Normal file
74
backend/src/vertx/http.clj
Normal file
|
@ -0,0 +1,74 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns vertx.http
|
||||
"Enables `raw` access to the http facilites of vertx. If you want more
|
||||
clojure idiomatic api, refer to the `vertx.web` namespace."
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[vertx.util :as vu])
|
||||
(:import
|
||||
io.vertx.core.Vertx
|
||||
io.vertx.core.Verticle
|
||||
io.vertx.core.Handler
|
||||
io.vertx.core.Future
|
||||
io.vertx.core.Context
|
||||
io.vertx.core.http.HttpServer
|
||||
io.vertx.core.http.HttpServerRequest
|
||||
io.vertx.core.http.HttpServerResponse
|
||||
io.vertx.core.http.HttpServerOptions))
|
||||
|
||||
(declare opts->http-server-options)
|
||||
(declare resolve-handler)
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(s/def :vertx.http/handler fn?)
|
||||
(s/def :vertx.http/host string?)
|
||||
(s/def :vertx.http/port pos?)
|
||||
(s/def ::server-options
|
||||
(s/keys :req-un [:vertx.http/handler]
|
||||
:opt-un [:vertx.http/host
|
||||
:vertx.http/port]))
|
||||
|
||||
(defn server
|
||||
"Starts a vertx http server."
|
||||
[vsm {:keys [handler] :as options}]
|
||||
(s/assert ::server-options options)
|
||||
(let [^Vertx vsm (vu/resolve-system vsm)
|
||||
^HttpServerOptions opts (opts->http-server-options options)
|
||||
^HttpServer srv (.createHttpServer vsm opts)
|
||||
^Handler handler (resolve-handler handler)]
|
||||
(doto srv
|
||||
(.requestHandler handler)
|
||||
(.listen))
|
||||
srv))
|
||||
|
||||
;; --- Impl
|
||||
|
||||
(defn- opts->http-server-options
|
||||
[{:keys [host port]}]
|
||||
(let [opts (HttpServerOptions.)]
|
||||
(.setReuseAddress opts true)
|
||||
(.setReusePort opts true)
|
||||
;; (.setTcpNoDelay opts true)
|
||||
;; (.setTcpFastOpen opts true)
|
||||
(when host (.setHost opts host))
|
||||
(when port (.setPort opts port))
|
||||
opts))
|
||||
|
||||
(defn- fn->handler
|
||||
[f]
|
||||
(reify Handler
|
||||
(handle [_ request]
|
||||
(f request))))
|
||||
|
||||
(defn- resolve-handler
|
||||
[handler]
|
||||
(cond
|
||||
(fn? handler) (fn->handler handler)
|
||||
(instance? Handler handler) handler
|
||||
:else (throw (ex-info "invalid handler" {}))))
|
55
backend/src/vertx/timers.clj
Normal file
55
backend/src/vertx/timers.clj
Normal file
|
@ -0,0 +1,55 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns vertx.timers
|
||||
"The timers and async scheduled tasks."
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[vertx.util :as vu])
|
||||
(:import
|
||||
io.vertx.core.Vertx
|
||||
io.vertx.core.Handler))
|
||||
|
||||
(defn schedule-once!
|
||||
[vsm ms f]
|
||||
(let [^Vertx system (vu/resolve-system vsm)
|
||||
^Handler handler (vu/fn->handler (fn [v] (f)))
|
||||
timer-id (.setTimer system ms handler)]
|
||||
(reify
|
||||
java.lang.AutoCloseable
|
||||
(close [_]
|
||||
(.cancelTimer system timer-id)))))
|
||||
|
||||
(defn sechdule-periodic!
|
||||
[vsm ms f]
|
||||
(let [^Vertx system (vu/resolve-system vsm)
|
||||
^Handler handler (vu/fn->handler (fn [v] (f)))
|
||||
timer-id (.setPeriodic system ms handler)]
|
||||
(reify
|
||||
java.lang.AutoCloseable
|
||||
(close [_]
|
||||
(.cancelTimer system timer-id)))))
|
||||
|
||||
(defn schedule-task!
|
||||
[vsm ms f]
|
||||
(let [^Vertx system (vu/resolve-system vsm)
|
||||
tid* (atom nil)
|
||||
task (fn wrapped-task []
|
||||
(-> (p/do! (f))
|
||||
(p/then (fn [_]
|
||||
(let [tid (schedule-task! vsm ms wrapped-task)]
|
||||
(reset! tid* tid)
|
||||
nil)))))
|
||||
tid (schedule-task! vsm ms task)]
|
||||
(reset! tid* tid)
|
||||
(reify
|
||||
java.lang.AutoCloseable
|
||||
(close [this]
|
||||
(locking this
|
||||
(when-let [timer-id (deref tid*)]
|
||||
(.cancelTimer system timer-id)
|
||||
(reset! tid* nil)))))))
|
40
backend/src/vertx/util.clj
Normal file
40
backend/src/vertx/util.clj
Normal file
|
@ -0,0 +1,40 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns vertx.util
|
||||
(:require [promesa.core :as p])
|
||||
(:import io.vertx.core.Vertx
|
||||
io.vertx.core.Handler
|
||||
io.vertx.core.Context
|
||||
io.vertx.core.AsyncResult
|
||||
java.util.function.Supplier))
|
||||
|
||||
(defn resolve-system
|
||||
[o]
|
||||
(cond
|
||||
(instance? Vertx o) o
|
||||
(instance? Context o) (.owner ^Context o)
|
||||
:else (throw (ex-info "unexpected parameters" {}))))
|
||||
|
||||
(defn fn->supplier
|
||||
[f]
|
||||
(reify Supplier
|
||||
(get [_] (f))))
|
||||
|
||||
(defn fn->handler
|
||||
[f]
|
||||
(reify Handler
|
||||
(handle [_ v]
|
||||
(f v))))
|
||||
|
||||
(defn deferred->handler
|
||||
[d]
|
||||
(reify Handler
|
||||
(handle [_ ar]
|
||||
(if (.failed ar)
|
||||
(p/reject! d (.cause ar))
|
||||
(p/resolve! d (.result ar))))))
|
||||
|
87
backend/src/vertx/util/transit.clj
Normal file
87
backend/src/vertx/util/transit.clj
Normal file
|
@ -0,0 +1,87 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns vertx.util.transit
|
||||
(:require [cognitect.transit :as t]
|
||||
[clojure.java.io :as io])
|
||||
(:import java.io.ByteArrayInputStream
|
||||
java.io.ByteArrayOutputStream
|
||||
java.time.Instant))
|
||||
|
||||
(def ^:private write-handler
|
||||
(t/write-handler
|
||||
(constantly "m")
|
||||
(fn [v] (str (.toEpochMilli v)))))
|
||||
|
||||
(def ^:private read-handler
|
||||
(t/read-handler
|
||||
(fn [v] (-> (Long/parseLong v)
|
||||
(Instant/ofEpochMilli)))))
|
||||
|
||||
(def +read-handlers+
|
||||
{"m" read-handler})
|
||||
|
||||
(def +write-handlers+
|
||||
{Instant write-handler})
|
||||
|
||||
(defmethod print-method Instant
|
||||
[mv ^java.io.Writer writer]
|
||||
(.write writer (str "#instant \"" (.toString mv) "\"")))
|
||||
|
||||
(defmethod print-dup Instant [o w]
|
||||
(print-method o w))
|
||||
|
||||
;; --- Low-Level Api
|
||||
|
||||
(defn reader
|
||||
([istream]
|
||||
(reader istream nil))
|
||||
([istream {:keys [type] :or {type :msgpack}}]
|
||||
(t/reader istream type {:handlers +read-handlers+})))
|
||||
|
||||
(defn read!
|
||||
"Read value from streamed transit reader."
|
||||
[reader]
|
||||
(t/read reader))
|
||||
|
||||
(defn writer
|
||||
([ostream]
|
||||
(writer ostream nil))
|
||||
([ostream {:keys [type] :or {type :msgpack}}]
|
||||
(t/writer ostream type {:handlers +write-handlers+})))
|
||||
|
||||
(defn write!
|
||||
[writer data]
|
||||
(t/write writer data))
|
||||
|
||||
;; --- High-Level Api
|
||||
|
||||
;; TODO: check performance of different options
|
||||
|
||||
(defn decode
|
||||
([data]
|
||||
(decode data nil))
|
||||
([data opts]
|
||||
(cond
|
||||
(string? data)
|
||||
(decode (.getBytes data "UTF-8") opts)
|
||||
|
||||
(bytes? data)
|
||||
(with-open [input (ByteArrayInputStream. data)]
|
||||
(read! (reader input opts)))
|
||||
|
||||
:else
|
||||
(with-open [input (io/input-stream data)]
|
||||
(read! (reader input opts))))))
|
||||
|
||||
(defn encode
|
||||
(^bytes [data]
|
||||
(encode data nil))
|
||||
(^bytes [data opts]
|
||||
(with-open [out (ByteArrayOutputStream.)]
|
||||
(let [w (writer out opts)]
|
||||
(write! w data)
|
||||
(.toByteArray out)))))
|
169
backend/src/vertx/web.clj
Normal file
169
backend/src/vertx/web.clj
Normal file
|
@ -0,0 +1,169 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns vertx.web
|
||||
"High level api for http servers."
|
||||
(:require [clojure.spec.alpha :as s]
|
||||
[promesa.core :as p]
|
||||
[sieppari.core :as sp]
|
||||
[reitit.core :as rt]
|
||||
[vertx.http :as vxh]
|
||||
[vertx.util :as vu])
|
||||
(:import
|
||||
clojure.lang.Keyword
|
||||
clojure.lang.IPersistentMap
|
||||
io.vertx.core.Vertx
|
||||
io.vertx.core.Handler
|
||||
io.vertx.core.Future
|
||||
io.vertx.core.buffer.Buffer
|
||||
io.vertx.core.http.Cookie
|
||||
io.vertx.core.http.HttpServer
|
||||
io.vertx.core.http.HttpServerRequest
|
||||
io.vertx.core.http.HttpServerResponse
|
||||
io.vertx.core.http.HttpServerOptions
|
||||
io.vertx.ext.web.Route
|
||||
io.vertx.ext.web.Router
|
||||
io.vertx.ext.web.RoutingContext
|
||||
io.vertx.ext.web.handler.BodyHandler
|
||||
io.vertx.ext.web.handler.StaticHandler
|
||||
io.vertx.ext.web.handler.ResponseTimeHandler
|
||||
io.vertx.ext.web.handler.LoggerHandler))
|
||||
|
||||
;; --- Constants & Declarations
|
||||
|
||||
(declare -handle-response)
|
||||
(declare -handle-body)
|
||||
|
||||
;; --- Public Api
|
||||
|
||||
(s/def ::wrap-handler
|
||||
(s/or :fn fn?
|
||||
:vec (s/every fn? :kind vector?)))
|
||||
|
||||
(defn- make-ctx
|
||||
[^RoutingContext routing-context]
|
||||
(let [^HttpServerRequest request (.request ^RoutingContext routing-context)
|
||||
^HttpServerResponse response (.response ^RoutingContext routing-context)
|
||||
^Vertx system (.vertx routing-context)]
|
||||
{:body (.getBody routing-context)
|
||||
:path (.path request)
|
||||
:method (-> request .rawMethod .toLowerCase keyword)
|
||||
::request request
|
||||
::response response
|
||||
::execution-context (.getContext system)
|
||||
::routing-context routing-context}))
|
||||
|
||||
(defn handler
|
||||
"Wraps a user defined funcion based handler into a vertx-web aware
|
||||
handler (with support for multipart uploads.
|
||||
|
||||
If the handler is a vector, the sieppari intercerptos engine will be used
|
||||
to resolve the execution of the interceptors + handler."
|
||||
[vsm & handlers]
|
||||
(let [^Vertx vsm (vu/resolve-system vsm)
|
||||
^Router router (Router/router vsm)]
|
||||
(reduce #(%2 %1) router handlers)))
|
||||
|
||||
(defn assets
|
||||
([path] (assets path {}))
|
||||
([path {:keys [root] :or {root "public"} :as options}]
|
||||
(fn [^Router router]
|
||||
(let [^Route route (.route router path)
|
||||
^Handler handler (doto (StaticHandler/create)
|
||||
(.setWebRoot root)
|
||||
(.setDirectoryListing true))]
|
||||
(.handler route handler)
|
||||
router))))
|
||||
|
||||
(defn- default-handler
|
||||
[ctx]
|
||||
(if (::match ctx)
|
||||
{:status 405}
|
||||
{:status 404}))
|
||||
|
||||
(defn- run-chain
|
||||
[ctx chain handler]
|
||||
(let [d (p/deferred)]
|
||||
(sp/execute (conj chain handler) ctx #(p/resolve! d %) #(p/reject! d %))
|
||||
d))
|
||||
|
||||
(defn- router-handler
|
||||
[router {:keys [path method] :as ctx}]
|
||||
(let [{:keys [data path-params] :as match} (rt/match-by-path router path)
|
||||
handler-fn (or (get data method)
|
||||
(get data :all)
|
||||
default-handler)
|
||||
interceptors (get data :interceptors)
|
||||
ctx (assoc ctx ::match match :path-params path-params)]
|
||||
(if (empty? interceptors)
|
||||
(handler-fn ctx)
|
||||
(run-chain ctx interceptors handler-fn))))
|
||||
|
||||
(defn router
|
||||
([routes] (router routes {}))
|
||||
([routes {:keys [delete-uploads?
|
||||
upload-dir
|
||||
log-requests?
|
||||
time-response?]
|
||||
:or {delete-uploads? true
|
||||
upload-dir "/tmp/vertx.uploads"
|
||||
log-requests? false
|
||||
time-response? true}
|
||||
:as options}]
|
||||
(let [rtr (rt/router routes options)
|
||||
hdr #(router-handler rtr %)]
|
||||
(fn [^Router router]
|
||||
(let [^Route route (.route router)]
|
||||
(when time-response? (.handler route (ResponseTimeHandler/create)))
|
||||
(when log-requests? (.handler route (LoggerHandler/create)))
|
||||
|
||||
(.handler route (doto (BodyHandler/create true)
|
||||
(.setDeleteUploadedFilesOnEnd delete-uploads?)
|
||||
(.setUploadsDirectory upload-dir)))
|
||||
(.handler route (reify Handler
|
||||
(handle [_ context]
|
||||
(let [ctx (make-ctx context)]
|
||||
(-> (p/do! (hdr ctx))
|
||||
(p/then' #(-handle-response % ctx))
|
||||
(p/catch #(do (prn %) (.fail (:context ctx) %)))))))))
|
||||
router))))
|
||||
|
||||
;; --- Impl
|
||||
|
||||
(defprotocol IAsyncResponse
|
||||
(-handle-response [_ _]))
|
||||
|
||||
(extend-protocol IAsyncResponse
|
||||
clojure.lang.IPersistentMap
|
||||
(-handle-response [data ctx]
|
||||
(let [status (or (:status data) 200)
|
||||
body (:body data)
|
||||
res (::response ctx)]
|
||||
(.setStatusCode ^HttpServerResponse res status)
|
||||
(-handle-body body res))))
|
||||
|
||||
(defprotocol IAsyncBody
|
||||
(-handle-body [_ _]))
|
||||
|
||||
(extend-protocol IAsyncBody
|
||||
(Class/forName "[B")
|
||||
(-handle-body [data res]
|
||||
(.end ^HttpServerResponse res (Buffer/buffer data)))
|
||||
|
||||
Buffer
|
||||
(-handle-body [data res]
|
||||
(.end ^HttpServerResponse res ^Buffer data))
|
||||
|
||||
nil
|
||||
(-handle-body [data res]
|
||||
(.putHeader ^HttpServerResponse res "content-length" "0")
|
||||
(.end ^HttpServerResponse res))
|
||||
|
||||
String
|
||||
(-handle-body [data res]
|
||||
(let [length (count data)]
|
||||
(.putHeader ^HttpServerResponse res "content-length" (str length))
|
||||
(.end ^HttpServerResponse res data))))
|
204
backend/src/vertx/web/interceptors.clj
Normal file
204
backend/src/vertx/web/interceptors.clj
Normal file
|
@ -0,0 +1,204 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
|
||||
|
||||
(ns vertx.web.interceptors
|
||||
"High level api for http servers."
|
||||
(:require
|
||||
[clojure.spec.alpha :as s]
|
||||
[clojure.string :as str]
|
||||
[promesa.core :as p]
|
||||
[reitit.core :as r]
|
||||
[vertx.web :as vw]
|
||||
[sieppari.context :as spx]
|
||||
[sieppari.core :as sp])
|
||||
(:import
|
||||
clojure.lang.Keyword
|
||||
clojure.lang.MapEntry
|
||||
java.util.Map
|
||||
java.util.Map$Entry
|
||||
io.vertx.core.Vertx
|
||||
io.vertx.core.Handler
|
||||
io.vertx.core.Future
|
||||
io.vertx.core.http.Cookie
|
||||
io.vertx.core.http.HttpServerRequest
|
||||
io.vertx.core.http.HttpServerResponse
|
||||
io.vertx.ext.web.FileUpload
|
||||
io.vertx.ext.web.RoutingContext))
|
||||
|
||||
;; --- Cookies
|
||||
|
||||
(defn- build-cookie
|
||||
[name data]
|
||||
(cond-> (Cookie/cookie ^String name ^String (:value data))
|
||||
(:http-only data) (.setHttpOnly true)
|
||||
(:domain data) (.setDomain (:domain data))
|
||||
(:path data) (.setPath (:path data))
|
||||
(:secure data) (.setSecure true)))
|
||||
|
||||
(defn cookies
|
||||
[]
|
||||
{:enter (fn [data]
|
||||
(let [^HttpServerRequest req (get-in data [:request ::vw/request])
|
||||
parse-cookie (fn [^Cookie item] [(.getName item) (.getValue item)])
|
||||
cookies (into {} (map parse-cookie) (vals (.cookieMap req)))]
|
||||
(update data :request assoc :cookies cookies)))
|
||||
:leave (fn [data]
|
||||
(let [cookies (get-in data [:response :cookies])
|
||||
^HttpServerResponse res (get-in data [:request ::vw/response])]
|
||||
(when (map? cookies)
|
||||
(reduce-kv #(.addCookie res (build-cookie %1 %2)) nil cookies))
|
||||
data))})
|
||||
;; --- Headers
|
||||
|
||||
(def ^:private lowercase-keys-t
|
||||
(map (fn [^Map$Entry entry]
|
||||
(MapEntry. (.toLowerCase (.getKey entry)) (.getValue entry)))))
|
||||
|
||||
(defn- parse-headers
|
||||
[req]
|
||||
(let [^HttpServerRequest request (::vw/request req)]
|
||||
(into {} lowercase-keys-t (.headers request))))
|
||||
|
||||
(defn headers
|
||||
[]
|
||||
{:enter (fn [data]
|
||||
(update data :request assoc :headers (parse-headers (:request data))))
|
||||
:leave (fn [data]
|
||||
(let [^HttpServerResponse res (get-in data [:request ::vw/response])
|
||||
headers (get-in data [:response :headers])]
|
||||
(run! (fn [[key value]]
|
||||
(.putHeader ^HttpServerResponse res
|
||||
^String (name key)
|
||||
^String (str value)))
|
||||
headers)
|
||||
data))})
|
||||
|
||||
;; --- Params
|
||||
|
||||
(defn- parse-param-entry
|
||||
[acc ^Map$Entry item]
|
||||
(let [key (keyword (.toLowerCase (.getKey item)))
|
||||
prv (get acc key ::default)]
|
||||
(cond
|
||||
(= prv ::default)
|
||||
(assoc! acc key (.getValue item))
|
||||
|
||||
(vector? prv)
|
||||
(assoc! acc key (conj prv (.getValue item)))
|
||||
|
||||
:else
|
||||
(assoc! acc key [prv (.getValue item)]))))
|
||||
|
||||
(defn- parse-params
|
||||
[req]
|
||||
(let [request (::vw/request req)]
|
||||
(persistent!
|
||||
(reduce parse-param-entry
|
||||
(transient {})
|
||||
(.params ^HttpServerResponse request)))))
|
||||
|
||||
(defn params
|
||||
([] (params nil))
|
||||
([{:keys [attr] :or {attr :params}}]
|
||||
{:enter (fn [data]
|
||||
(let [params (parse-params (:request data))]
|
||||
(update data :request assoc attr params)))}))
|
||||
|
||||
;; --- Uploads
|
||||
|
||||
(defn uploads
|
||||
([] (uploads nil))
|
||||
([{:keys [attr] :or {attr :uploads}}]
|
||||
{:enter (fn [data]
|
||||
(let [context (get-in data [:request ::vw/routing-context])
|
||||
uploads (reduce (fn [acc ^FileUpload upload]
|
||||
(assoc acc
|
||||
(keyword (.name upload))
|
||||
{:type :uploaded-file
|
||||
:mtype (.contentType upload)
|
||||
:path (.uploadedFileName upload)
|
||||
:name (.fileName upload)
|
||||
:size (.size upload)}))
|
||||
(transient {})
|
||||
(.fileUploads ^RoutingContext context))]
|
||||
(update data :request assoc attr (persistent! uploads))))}))
|
||||
|
||||
;; --- CORS
|
||||
|
||||
(s/def ::origin string?)
|
||||
(s/def ::allow-credentials boolean?)
|
||||
(s/def ::allow-methods (s/every keyword? :kind set?))
|
||||
(s/def ::allow-headers (s/every keyword? :kind set?))
|
||||
(s/def ::expose-headers (s/every keyword? :kind set?))
|
||||
(s/def ::max-age number?)
|
||||
|
||||
(s/def ::cors-opts
|
||||
(s/keys :req-un [::origin]
|
||||
:opt-un [::allow-headers
|
||||
::allow-methods
|
||||
::expose-headers
|
||||
::max-age]))
|
||||
|
||||
(defn cors
|
||||
[opts]
|
||||
(s/assert ::cors-opts opts)
|
||||
(letfn [(preflight? [{:keys [method headers] :as ctx}]
|
||||
(and (= method :options)
|
||||
(contains? headers "origin")
|
||||
(contains? headers "access-control-request-method")))
|
||||
|
||||
(normalize [data]
|
||||
(str/join ", " (map name data)))
|
||||
|
||||
(allow-origin? [headers]
|
||||
(let [origin (:origin opts)
|
||||
value (get headers "origin")]
|
||||
(cond
|
||||
(nil? value) value
|
||||
(= origin "*") origin
|
||||
(set? origin) (origin value)
|
||||
(= origin value) origin)))
|
||||
|
||||
(get-headers [{:keys [headers] :as ctx}]
|
||||
(when-let [origin (allow-origin? headers)]
|
||||
(cond-> {"access-control-allow-origin" origin
|
||||
"access-control-allow-methods" "GET, OPTIONS, HEAD"}
|
||||
|
||||
(:allow-methods opts)
|
||||
(assoc "access-control-allow-methods"
|
||||
(-> (normalize (:allow-methods opts))
|
||||
(str/upper-case)))
|
||||
|
||||
(:allow-credentials opts)
|
||||
(assoc "access-control-allow-credentials" "true")
|
||||
|
||||
(:expose-headers opts)
|
||||
(assoc "access-control-expose-headers"
|
||||
(-> (normalize (:expose-headers opts))
|
||||
(str/lower-case)))
|
||||
|
||||
(:max-age opts)
|
||||
(assoc "access-control-max-age" (:max-age opts))
|
||||
|
||||
(:allow-headers opts)
|
||||
(assoc "access-control-allow-headers"
|
||||
(-> (normalize (:allow-headers opts))
|
||||
(str/lower-case))))))
|
||||
|
||||
(enter [data]
|
||||
(let [ctx (:request data)]
|
||||
(if (preflight? ctx)
|
||||
(spx/terminate (assoc data ::preflight true))
|
||||
data)))
|
||||
|
||||
(leave [data]
|
||||
(let [headers (get-headers (:request data))]
|
||||
(if (::preflight data)
|
||||
(assoc data :response {:status 204 :headers headers})
|
||||
(update-in data [:response :headers] merge headers))))]
|
||||
|
||||
{:enter enter
|
||||
:leave leave}))
|
Some files were not shown because too many files have changed in this diff Show more
Loading…
Add table
Reference in a new issue