From e9b00339a5e7a21b6cdd083510ee2dfb0d00d28b Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Mon, 18 Nov 2019 11:52:57 +0100 Subject: [PATCH] :construction: 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 --- backend/deps.edn | 43 +- .../resources/emails/debug-email-list.html | 14 + backend/resources/emails/en/register.mustache | 30 +- .../emails/partials/en/footer.mustache | 46 ++ .../resources/emails/partials/head.mustache | 6 + .../emails/partials/inline_style.mustache | 162 +++++ backend/resources/log4j2.xml | 12 + backend/resources/migrations/0000.main.up.sql | 28 - backend/resources/migrations/0001.main.up.sql | 12 + .../resources/migrations/0001.txlog.up.sql | 17 - backend/resources/migrations/0002.auth.up.sql | 26 +- .../resources/migrations/0003.projects.up.sql | 9 +- .../resources/migrations/0004.pages.up.sql | 31 +- .../resources/migrations/0005.kvstore.up.sql | 11 +- .../resources/migrations/0006.emails.up.sql | 7 +- .../resources/migrations/0007.images.up.sql | 25 +- .../resources/migrations/0008.icons.up.sql | 25 +- .../0009.history.improvements.up.sql | 42 -- .../resources/migrations/XXXX.workers.up.sql | 12 +- backend/resources/sql/cli.sql | 53 -- backend/resources/sql/emails.sql | 45 -- backend/resources/sql/icons.sql | 69 --- backend/resources/sql/images.sql | 67 --- backend/resources/sql/kvstore.sql | 17 - backend/resources/sql/pages.sql | 88 --- backend/resources/sql/projects.sql | 49 -- backend/resources/sql/users.sql | 69 --- backend/resources/sql/workers.sql | 53 -- backend/src/user.clj | 69 ++- backend/src/uxbox/api/auth.clj | 72 --- backend/src/uxbox/api/debug_emails.clj | 67 --- backend/src/uxbox/api/icons.clj | 131 ---- backend/src/uxbox/api/images.clj | 169 ------ backend/src/uxbox/api/kvstore.clj | 53 -- backend/src/uxbox/api/pages.clj | 167 ------ backend/src/uxbox/api/projects.clj | 102 ---- backend/src/uxbox/api/svg.clj | 19 - backend/src/uxbox/api/users.clj | 84 --- backend/src/uxbox/cli/collimp.clj | 224 ------- backend/src/uxbox/cli/sql.clj | 4 - backend/src/uxbox/config.clj | 6 +- backend/src/uxbox/core.clj | 16 + backend/src/uxbox/db.clj | 113 ++-- backend/src/uxbox/emails.clj | 45 +- backend/src/uxbox/emails/core.clj | 88 --- backend/src/uxbox/emails/layouts.clj | 228 ------- backend/src/uxbox/emails/users.clj | 77 --- backend/src/uxbox/fixtures.clj | 157 ++--- backend/src/uxbox/http.clj | 162 ++--- backend/src/uxbox/http/cors.clj | 77 --- backend/src/uxbox/http/debug.clj | 25 + backend/src/uxbox/http/errors.clj | 18 +- backend/src/uxbox/http/etag.clj | 53 -- backend/src/uxbox/http/handlers.clj | 86 +++ backend/src/uxbox/http/interceptors.clj | 65 ++ backend/src/uxbox/http/middleware.clj | 307 ---------- backend/src/uxbox/http/response.clj | 216 ------- backend/src/uxbox/http/session.clj | 63 ++ backend/src/uxbox/images.clj | 2 + backend/src/uxbox/locks.clj | 12 +- backend/src/uxbox/main.clj | 5 +- backend/src/uxbox/migrations.clj | 103 ++-- backend/src/uxbox/portation.clj | 168 +++--- backend/src/uxbox/scheduled_jobs.clj | 23 - backend/src/uxbox/scheduled_jobs/emails.clj | 133 ----- backend/src/uxbox/scheduled_jobs/garbage.clj | 28 - backend/src/uxbox/services.clj | 61 -- backend/src/uxbox/services/auth.clj | 63 +- backend/src/uxbox/services/core.clj | 76 ++- backend/src/uxbox/services/icons.clj | 414 ++++++------- backend/src/uxbox/services/images.clj | 401 +++++++------ backend/src/uxbox/services/kvstore.clj | 117 ++-- backend/src/uxbox/services/pages.clj | 370 ++++++------ backend/src/uxbox/services/projects.clj | 212 +++---- backend/src/uxbox/services/svgparse.clj | 144 ++--- backend/src/uxbox/services/users.clj | 565 ++++++++++-------- backend/src/uxbox/sql.clj | 18 - backend/src/uxbox/util/blob.clj | 90 ++- backend/src/uxbox/util/dispatcher.clj | 88 +++ backend/src/uxbox/util/emails.clj | 103 ++++ backend/src/uxbox/util/migrations.clj | 104 ++++ backend/src/uxbox/util/pgsql.clj | 150 +++++ backend/src/uxbox/util/quartz.clj | 139 ----- backend/src/uxbox/util/snappy.clj | 28 +- backend/src/uxbox/util/spec.clj | 33 +- backend/src/uxbox/util/sql.clj | 251 ++++++++ backend/src/uxbox/util/struct.clj | 3 - backend/src/uxbox/util/template.clj | 88 +-- backend/src/uxbox/util/time.clj | 46 +- backend/src/uxbox/util/transit.clj | 35 +- backend/src/uxbox/util/uuid.clj | 19 +- backend/src/uxbox/util/workers.clj | 114 ++-- backend/src/vertx/core.clj | 223 +++++++ backend/src/vertx/eventbus.clj | 122 ++++ backend/src/vertx/http.clj | 74 +++ backend/src/vertx/timers.clj | 55 ++ backend/src/vertx/util.clj | 40 ++ backend/src/vertx/util/transit.clj | 87 +++ backend/src/vertx/web.clj | 169 ++++++ backend/src/vertx/web/interceptors.clj | 204 +++++++ backend/test/uxbox/tests/helpers.clj | 296 ++++----- backend/test/uxbox/tests/main.clj | 10 +- backend/test/uxbox/tests/test_auth.clj | 81 ++- backend/test/uxbox/tests/test_icons.clj | 286 ++++----- backend/test/uxbox/tests/test_images.clj | 308 +++++----- backend/test/uxbox/tests/test_kvstore.clj | 98 ++- backend/test/uxbox/tests/test_pages.clj | 325 ++++------ backend/test/uxbox/tests/test_projects.clj | 132 ++-- backend/test/uxbox/tests/test_svgparse.clj | 152 ++--- backend/test/uxbox/tests/test_txlog.clj | 19 - backend/test/uxbox/tests/test_users.clj | 203 ++++--- backend/vendor/executors/core.clj | 176 ------ backend/vendor/migrante/core.clj | 218 ------- docker/devenv/docker-compose.yaml | 2 +- frontend/deps.edn | 1 + frontend/src/uxbox/main/data/colors.cljs | 14 +- frontend/src/uxbox/main/data/icons.cljs | 58 +- frontend/src/uxbox/main/data/images.cljs | 94 ++- frontend/src/uxbox/main/data/pages.cljs | 12 +- frontend/src/uxbox/main/data/projects.cljs | 4 +- frontend/src/uxbox/main/data/users.cljs | 5 +- frontend/src/uxbox/main/data/workspace.cljs | 1 - frontend/src/uxbox/main/repo/auth.cljs | 13 +- frontend/src/uxbox/main/repo/core.cljs | 135 +++++ frontend/src/uxbox/main/repo/pages.cljs | 37 +- frontend/src/uxbox/main/repo/projects.cljs | 2 +- frontend/src/uxbox/main/ui.cljs | 37 +- .../src/uxbox/main/ui/dashboard/icons.cljs | 4 +- .../src/uxbox/main/ui/dashboard/images.cljs | 4 +- frontend/src/uxbox/main/ui/workspace.cljs | 5 +- .../src/uxbox/main/ui/workspace/sidebar.cljs | 2 +- .../main/ui/workspace/sidebar/sitemap.cljs | 7 +- frontend/src/uxbox/util/data.cljs | 12 + frontend/src/uxbox/util/http.cljs | 28 +- 134 files changed, 5394 insertions(+), 6598 deletions(-) create mode 100644 backend/resources/emails/debug-email-list.html create mode 100644 backend/resources/emails/partials/en/footer.mustache create mode 100644 backend/resources/emails/partials/head.mustache create mode 100644 backend/resources/emails/partials/inline_style.mustache create mode 100644 backend/resources/log4j2.xml delete mode 100644 backend/resources/migrations/0000.main.up.sql create mode 100644 backend/resources/migrations/0001.main.up.sql delete mode 100644 backend/resources/migrations/0001.txlog.up.sql delete mode 100644 backend/resources/migrations/0009.history.improvements.up.sql delete mode 100644 backend/resources/sql/cli.sql delete mode 100644 backend/resources/sql/emails.sql delete mode 100644 backend/resources/sql/icons.sql delete mode 100644 backend/resources/sql/images.sql delete mode 100644 backend/resources/sql/kvstore.sql delete mode 100644 backend/resources/sql/pages.sql delete mode 100644 backend/resources/sql/projects.sql delete mode 100644 backend/resources/sql/users.sql delete mode 100644 backend/resources/sql/workers.sql delete mode 100644 backend/src/uxbox/api/auth.clj delete mode 100644 backend/src/uxbox/api/debug_emails.clj delete mode 100644 backend/src/uxbox/api/icons.clj delete mode 100644 backend/src/uxbox/api/images.clj delete mode 100644 backend/src/uxbox/api/kvstore.clj delete mode 100644 backend/src/uxbox/api/pages.clj delete mode 100644 backend/src/uxbox/api/projects.clj delete mode 100644 backend/src/uxbox/api/svg.clj delete mode 100644 backend/src/uxbox/api/users.clj delete mode 100644 backend/src/uxbox/cli/collimp.clj delete mode 100644 backend/src/uxbox/cli/sql.clj create mode 100644 backend/src/uxbox/core.clj delete mode 100644 backend/src/uxbox/emails/core.clj delete mode 100644 backend/src/uxbox/emails/layouts.clj delete mode 100644 backend/src/uxbox/emails/users.clj delete mode 100644 backend/src/uxbox/http/cors.clj create mode 100644 backend/src/uxbox/http/debug.clj delete mode 100644 backend/src/uxbox/http/etag.clj create mode 100644 backend/src/uxbox/http/handlers.clj create mode 100644 backend/src/uxbox/http/interceptors.clj delete mode 100644 backend/src/uxbox/http/middleware.clj delete mode 100644 backend/src/uxbox/http/response.clj create mode 100644 backend/src/uxbox/http/session.clj delete mode 100644 backend/src/uxbox/scheduled_jobs.clj delete mode 100644 backend/src/uxbox/scheduled_jobs/emails.clj delete mode 100644 backend/src/uxbox/scheduled_jobs/garbage.clj delete mode 100644 backend/src/uxbox/services.clj delete mode 100644 backend/src/uxbox/sql.clj create mode 100644 backend/src/uxbox/util/dispatcher.clj create mode 100644 backend/src/uxbox/util/emails.clj create mode 100644 backend/src/uxbox/util/migrations.clj create mode 100644 backend/src/uxbox/util/pgsql.clj delete mode 100644 backend/src/uxbox/util/quartz.clj create mode 100644 backend/src/uxbox/util/sql.clj delete mode 100644 backend/src/uxbox/util/struct.clj create mode 100644 backend/src/vertx/core.clj create mode 100644 backend/src/vertx/eventbus.clj create mode 100644 backend/src/vertx/http.clj create mode 100644 backend/src/vertx/timers.clj create mode 100644 backend/src/vertx/util.clj create mode 100644 backend/src/vertx/util/transit.clj create mode 100644 backend/src/vertx/web.clj create mode 100644 backend/src/vertx/web/interceptors.clj delete mode 100644 backend/test/uxbox/tests/test_txlog.clj delete mode 100644 backend/vendor/executors/core.clj delete mode 100644 backend/vendor/migrante/core.clj create mode 100644 frontend/src/uxbox/main/repo/core.cljs diff --git a/backend/deps.edn b/backend/deps.edn index 0bf9823fc..aad21e445 100644 --- a/backend/deps.edn +++ b/backend/deps.edn @@ -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"]} diff --git a/backend/resources/emails/debug-email-list.html b/backend/resources/emails/debug-email-list.html new file mode 100644 index 000000000..b2827e29e --- /dev/null +++ b/backend/resources/emails/debug-email-list.html @@ -0,0 +1,14 @@ + + +
+

Available Emails:

+ +
+ + diff --git a/backend/resources/emails/en/register.mustache b/backend/resources/emails/en/register.mustache index c23b78dbe..95cfc335b 100644 --- a/backend/resources/emails/en/register.mustache +++ b/backend/resources/emails/en/register.mustache @@ -11,7 +11,31 @@ UXBOX team. -- end -- begin :body-html -

Hello {{user}}!

-

Welcome to UXBOX.

-

UXBOX team.

+ + + + + title + {{> ../partials/inline_style }} + + + + + + + + + + +
+ +

Hello {{user}}!

+

Welcome to UXBOX.

+

UXBOX team.

+
+ {{> ../partials/en/footer }} + + -- end \ No newline at end of file diff --git a/backend/resources/emails/partials/en/footer.mustache b/backend/resources/emails/partials/en/footer.mustache new file mode 100644 index 000000000..09b9ceec9 --- /dev/null +++ b/backend/resources/emails/partials/en/footer.mustache @@ -0,0 +1,46 @@ + + + + + + + + +
+
+ + + + + + {{#comment}} + + + + {{/comment}} + +
+ +
+

+ Sent from UXBOX | + + Email preferences + +

+
+
+
diff --git a/backend/resources/emails/partials/head.mustache b/backend/resources/emails/partials/head.mustache new file mode 100644 index 000000000..9c6f296a9 --- /dev/null +++ b/backend/resources/emails/partials/head.mustache @@ -0,0 +1,6 @@ + + + + title + {{> inline_style }} + diff --git a/backend/resources/emails/partials/inline_style.mustache b/backend/resources/emails/partials/inline_style.mustache new file mode 100644 index 000000000..b2a28a0f8 --- /dev/null +++ b/backend/resources/emails/partials/inline_style.mustache @@ -0,0 +1,162 @@ + diff --git a/backend/resources/log4j2.xml b/backend/resources/log4j2.xml new file mode 100644 index 000000000..74a3f2508 --- /dev/null +++ b/backend/resources/log4j2.xml @@ -0,0 +1,12 @@ + + + + + + + + + + + + diff --git a/backend/resources/migrations/0000.main.up.sql b/backend/resources/migrations/0000.main.up.sql deleted file mode 100644 index d4f5e4c0f..000000000 --- a/backend/resources/migrations/0000.main.up.sql +++ /dev/null @@ -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; diff --git a/backend/resources/migrations/0001.main.up.sql b/backend/resources/migrations/0001.main.up.sql new file mode 100644 index 000000000..01ea24054 --- /dev/null +++ b/backend/resources/migrations/0001.main.up.sql @@ -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; diff --git a/backend/resources/migrations/0001.txlog.up.sql b/backend/resources/migrations/0001.txlog.up.sql deleted file mode 100644 index a2777ccda..000000000 --- a/backend/resources/migrations/0001.txlog.up.sql +++ /dev/null @@ -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(); diff --git a/backend/resources/migrations/0002.auth.up.sql b/backend/resources/migrations/0002.auth.up.sql index 4ec704f84..7a26c9e61 100644 --- a/backend/resources/migrations/0002.auth.up.sql +++ b/backend/resources/migrations/0002.auth.up.sql @@ -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); diff --git a/backend/resources/migrations/0003.projects.up.sql b/backend/resources/migrations/0003.projects.up.sql index 1b3233599..57fdd8cdc 100644 --- a/backend/resources/migrations/0003.projects.up.sql +++ b/backend/resources/migrations/0003.projects.up.sql @@ -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(); diff --git a/backend/resources/migrations/0004.pages.up.sql b/backend/resources/migrations/0004.pages.up.sql index 3a2ca69c1..2c9eb4b3b 100644 --- a/backend/resources/migrations/0004.pages.up.sql +++ b/backend/resources/migrations/0004.pages.up.sql @@ -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(); diff --git a/backend/resources/migrations/0005.kvstore.up.sql b/backend/resources/migrations/0005.kvstore.up.sql index 0b540c1d0..0488414aa 100644 --- a/backend/resources/migrations/0005.kvstore.up.sql +++ b/backend/resources/migrations/0005.kvstore.up.sql @@ -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(); diff --git a/backend/resources/migrations/0006.emails.up.sql b/backend/resources/migrations/0006.emails.up.sql index b621501b7..85d4ad39e 100644 --- a/backend/resources/migrations/0006.emails.up.sql +++ b/backend/resources/migrations/0006.emails.up.sql @@ -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); diff --git a/backend/resources/migrations/0007.images.up.sql b/backend/resources/migrations/0007.images.up.sql index 4abb6a86b..ca6dea90f 100644 --- a/backend/resources/migrations/0007.images.up.sql +++ b/backend/resources/migrations/0007.images.up.sql @@ -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(); diff --git a/backend/resources/migrations/0008.icons.up.sql b/backend/resources/migrations/0008.icons.up.sql index aee7ad025..12bbbf5e0 100644 --- a/backend/resources/migrations/0008.icons.up.sql +++ b/backend/resources/migrations/0008.icons.up.sql @@ -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(); diff --git a/backend/resources/migrations/0009.history.improvements.up.sql b/backend/resources/migrations/0009.history.improvements.up.sql deleted file mode 100644 index 47ccd23ed..000000000 --- a/backend/resources/migrations/0009.history.improvements.up.sql +++ /dev/null @@ -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(); diff --git a/backend/resources/migrations/XXXX.workers.up.sql b/backend/resources/migrations/XXXX.workers.up.sql index 31237318c..a2cea7b30 100644 --- a/backend/resources/migrations/XXXX.workers.up.sql +++ b/backend/resources/migrations/XXXX.workers.up.sql @@ -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(); diff --git a/backend/resources/sql/cli.sql b/backend/resources/sql/cli.sql deleted file mode 100644 index 0f4dfa89e..000000000 --- a/backend/resources/sql/cli.sql +++ /dev/null @@ -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 : (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; diff --git a/backend/src/user.clj b/backend/src/user.clj index ed3d92fe7..2a811c26a 100644 --- a/backend/src/user.clj +++ b/backend/src/user.clj @@ -5,18 +5,48 @@ ;; Copyright (c) 2016-2019 Andrey Antukh (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) diff --git a/backend/src/uxbox/api/auth.clj b/backend/src/uxbox/api/auth.clj deleted file mode 100644 index 9f490a2e6..000000000 --- a/backend/src/uxbox/api/auth.clj +++ /dev/null @@ -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 - -(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 ""))))))) diff --git a/backend/src/uxbox/api/debug_emails.clj b/backend/src/uxbox/api/debug_emails.clj deleted file mode 100644 index 664f54f55..000000000 --- a/backend/src/uxbox/api/debug_emails.clj +++ /dev/null @@ -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 - -(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"})))) diff --git a/backend/src/uxbox/api/icons.clj b/backend/src/uxbox/api/icons.clj deleted file mode 100644 index bfb2e3b56..000000000 --- a/backend/src/uxbox/api/icons.clj +++ /dev/null @@ -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 - -(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)))) - diff --git a/backend/src/uxbox/api/images.clj b/backend/src/uxbox/api/images.clj deleted file mode 100644 index ccde3cb5e..000000000 --- a/backend/src/uxbox/api/images.clj +++ /dev/null @@ -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 - -(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)))) - - diff --git a/backend/src/uxbox/api/kvstore.clj b/backend/src/uxbox/api/kvstore.clj deleted file mode 100644 index 5cd9c0462..000000000 --- a/backend/src/uxbox/api/kvstore.clj +++ /dev/null @@ -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 - -(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)))))) - - diff --git a/backend/src/uxbox/api/pages.clj b/backend/src/uxbox/api/pages.clj deleted file mode 100644 index 315a19426..000000000 --- a/backend/src/uxbox/api/pages.clj +++ /dev/null @@ -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 - -(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)))) diff --git a/backend/src/uxbox/api/projects.clj b/backend/src/uxbox/api/projects.clj deleted file mode 100644 index 9b587cf2c..000000000 --- a/backend/src/uxbox/api/projects.clj +++ /dev/null @@ -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 - -(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)))) diff --git a/backend/src/uxbox/api/svg.clj b/backend/src/uxbox/api/svg.clj deleted file mode 100644 index 4a74219cf..000000000 --- a/backend/src/uxbox/api/svg.clj +++ /dev/null @@ -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 - -(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)))) diff --git a/backend/src/uxbox/api/users.clj b/backend/src/uxbox/api/users.clj deleted file mode 100644 index f2226a4ad..000000000 --- a/backend/src/uxbox/api/users.clj +++ /dev/null @@ -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 - -(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)))))) - - - - diff --git a/backend/src/uxbox/cli/collimp.clj b/backend/src/uxbox/cli/collimp.clj deleted file mode 100644 index 3c48932de..000000000 --- a/backend/src/uxbox/cli/collimp.clj +++ /dev/null @@ -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 - -(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))))) diff --git a/backend/src/uxbox/cli/sql.clj b/backend/src/uxbox/cli/sql.clj deleted file mode 100644 index 77890198f..000000000 --- a/backend/src/uxbox/cli/sql.clj +++ /dev/null @@ -1,4 +0,0 @@ -(ns uxbox.cli.sql - (:require [hugsql.core :as hugsql])) - -(hugsql/def-sqlvec-fns "sql/cli.sql" {:quoting :ansi :fn-suffix ""}) diff --git a/backend/src/uxbox/config.clj b/backend/src/uxbox/config.clj index 5269d695a..9a4e048aa 100644 --- a/backend/src/uxbox/config.clj +++ b/backend/src/uxbox/config.clj @@ -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)) diff --git a/backend/src/uxbox/core.clj b/backend/src/uxbox/core.clj new file mode 100644 index 000000000..441210f0c --- /dev/null +++ b/backend/src/uxbox/core.clj @@ -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 + +(ns uxbox.core + (:require + [vertx.core :as vx] + [mount.core :as mount :refer [defstate]])) + +(defstate system + :start (vx/system) + :stop (.close system)) + + diff --git a/backend/src/uxbox/db.clj b/backend/src/uxbox/db.clj index a3083df7c..a421437e1 100644 --- a/backend/src/uxbox/db.clj +++ b/backend/src/uxbox/db.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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})) diff --git a/backend/src/uxbox/emails.clj b/backend/src/uxbox/emails.clj index d4d89f7bd..99f6dfa87 100644 --- a/backend/src/uxbox/emails.clj +++ b/backend/src/uxbox/emails.clj @@ -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 +;; Copyright (c) 2016-2019 Andrey Antukh (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))))) diff --git a/backend/src/uxbox/emails/core.clj b/backend/src/uxbox/emails/core.clj deleted file mode 100644 index 09dc2ed7b..000000000 --- a/backend/src/uxbox/emails/core.clj +++ /dev/null @@ -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 - -(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))))) diff --git a/backend/src/uxbox/emails/layouts.clj b/backend/src/uxbox/emails/layouts.clj deleted file mode 100644 index a887143b3..000000000 --- a/backend/src/uxbox/emails/layouts.clj +++ /dev/null @@ -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 - -(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}) diff --git a/backend/src/uxbox/emails/users.clj b/backend/src/uxbox/emails/users.clj deleted file mode 100644 index d6f1f0cf7..000000000 --- a/backend/src/uxbox/emails/users.clj +++ /dev/null @@ -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 - -(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}) - diff --git a/backend/src/uxbox/fixtures.clj b/backend/src/uxbox/fixtures.clj index 6fecbb108..cc808c3d6 100644 --- a/backend/src/uxbox/fixtures.clj +++ b/backend/src/uxbox/fixtures.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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)))) diff --git a/backend/src/uxbox/http.clj b/backend/src/uxbox/http.clj index a8af79e50..ec1abd7e7 100644 --- a/backend/src/uxbox/http.clj +++ b/backend/src/uxbox/http.clj @@ -5,115 +5,67 @@ ;; Copyright (c) 2019 Andrey Antukh (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}))) diff --git a/backend/src/uxbox/http/cors.clj b/backend/src/uxbox/http/cors.clj deleted file mode 100644 index 181a46888..000000000 --- a/backend/src/uxbox/http/cors.clj +++ /dev/null @@ -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 - -(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)))))) - - - diff --git a/backend/src/uxbox/http/debug.clj b/backend/src/uxbox/http/debug.clj new file mode 100644 index 000000000..d73a65778 --- /dev/null +++ b/backend/src/uxbox/http/debug.clj @@ -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 + +(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"}) diff --git a/backend/src/uxbox/http/errors.clj b/backend/src/uxbox/http/errors.clj index 64a840cbc..b08ad4121 100644 --- a/backend/src/uxbox/http/errors.clj +++ b/backend/src/uxbox/http/errors.clj @@ -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))) diff --git a/backend/src/uxbox/http/etag.clj b/backend/src/uxbox/http/etag.clj deleted file mode 100644 index c18da1729..000000000 --- a/backend/src/uxbox/http/etag.clj +++ /dev/null @@ -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 - -(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))) - - diff --git a/backend/src/uxbox/http/handlers.clj b/backend/src/uxbox/http/handlers.clj new file mode 100644 index 000000000..fec037f92 --- /dev/null +++ b/backend/src/uxbox/http/handlers.clj @@ -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 + +(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)}}) + diff --git a/backend/src/uxbox/http/interceptors.clj b/backend/src/uxbox/http/interceptors.clj new file mode 100644 index 000000000..4d27697eb --- /dev/null +++ b/backend/src/uxbox/http/interceptors.clj @@ -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 + +(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)))}) + diff --git a/backend/src/uxbox/http/middleware.clj b/backend/src/uxbox/http/middleware.clj deleted file mode 100644 index 8bdd59302..000000000 --- a/backend/src/uxbox/http/middleware.clj +++ /dev/null @@ -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 - -(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}}))) diff --git a/backend/src/uxbox/http/response.clj b/backend/src/uxbox/http/response.clj deleted file mode 100644 index 453ec71e3..000000000 --- a/backend/src/uxbox/http/response.clj +++ /dev/null @@ -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 - -(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))) diff --git a/backend/src/uxbox/http/session.clj b/backend/src/uxbox/http/session.clj new file mode 100644 index 000000000..f85b12867 --- /dev/null +++ b/backend/src/uxbox/http/session.clj @@ -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 + +(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))}) diff --git a/backend/src/uxbox/images.clj b/backend/src/uxbox/images.clj index f145ff19e..1b4137e35 100644 --- a/backend/src/uxbox/images.clj +++ b/backend/src/uxbox/images.clj @@ -21,6 +21,8 @@ org.im4java.core.ConvertCmd org.im4java.core.IMOperation)) +;; TODO: make this module non-blocking + ;; --- Thumbnails Generation (s/def ::width integer?) diff --git a/backend/src/uxbox/locks.clj b/backend/src/uxbox/locks.clj index aaa881068..361a089bc 100644 --- a/backend/src/uxbox/locks.clj +++ b/backend/src/uxbox/locks.clj @@ -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)) diff --git a/backend/src/uxbox/main.clj b/backend/src/uxbox/main.clj index b2e8bd853..18494e4a5 100644 --- a/backend/src/uxbox/main.clj +++ b/backend/src/uxbox/main.clj @@ -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)) diff --git a/backend/src/uxbox/migrations.clj b/backend/src/uxbox/migrations.clj index d07cf1fc1..287f43573 100644 --- a/backend/src/uxbox/migrations.clj +++ b/backend/src/uxbox/migrations.clj @@ -5,79 +5,52 @@ ;; Copyright (c) 2016 Andrey Antukh (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)) diff --git a/backend/src/uxbox/portation.clj b/backend/src/uxbox/portation.clj index 7a13f104c..5d69863dc 100644 --- a/backend/src/uxbox/portation.clj +++ b/backend/src/uxbox/portation.clj @@ -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)))) diff --git a/backend/src/uxbox/scheduled_jobs.clj b/backend/src/uxbox/scheduled_jobs.clj deleted file mode 100644 index 952c6eeac..000000000 --- a/backend/src/uxbox/scheduled_jobs.clj +++ /dev/null @@ -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 - -(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)) diff --git a/backend/src/uxbox/scheduled_jobs/emails.clj b/backend/src/uxbox/scheduled_jobs/emails.clj deleted file mode 100644 index 4ffa38eb8..000000000 --- a/backend/src/uxbox/scheduled_jobs/emails.clj +++ /dev/null @@ -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 - -(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))))) diff --git a/backend/src/uxbox/scheduled_jobs/garbage.clj b/backend/src/uxbox/scheduled_jobs/garbage.clj deleted file mode 100644 index fedfaa180..000000000 --- a/backend/src/uxbox/scheduled_jobs/garbage.clj +++ /dev/null @@ -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 - -(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))))) diff --git a/backend/src/uxbox/services.clj b/backend/src/uxbox/services.clj deleted file mode 100644 index 30d095ae8..000000000 --- a/backend/src/uxbox/services.clj +++ /dev/null @@ -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 - -(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))) diff --git a/backend/src/uxbox/services/auth.clj b/backend/src/uxbox/services/auth.clj index 155d45d1d..292cf36dd 100644 --- a/backend/src/uxbox/services/auth.clj +++ b/backend/src/uxbox/services/auth.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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)))) diff --git a/backend/src/uxbox/services/core.clj b/backend/src/uxbox/services/core.clj index 2b2bd7296..3da03ca42 100644 --- a/backend/src/uxbox/services/core.clj +++ b/backend/src/uxbox/services/core.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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))) diff --git a/backend/src/uxbox/services/icons.clj b/backend/src/uxbox/services/icons.clj index b32c52f30..8348b1dd6 100644 --- a/backend/src/uxbox/services/icons.clj +++ b/backend/src/uxbox/services/icons.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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)))) diff --git a/backend/src/uxbox/services/images.clj b/backend/src/uxbox/services/images.clj index 7f8438cbf..f5dbd8312 100644 --- a/backend/src/uxbox/services/images.clj +++ b/backend/src/uxbox/services/images.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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))) diff --git a/backend/src/uxbox/services/kvstore.clj b/backend/src/uxbox/services/kvstore.clj index f85614d36..ffeb9a8b9 100644 --- a/backend/src/uxbox/services/kvstore.clj +++ b/backend/src/uxbox/services/kvstore.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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)))) diff --git a/backend/src/uxbox/services/pages.clj b/backend/src/uxbox/services/pages.clj index 8085a1a55..0fb887675 100644 --- a/backend/src/uxbox/services/pages.clj +++ b/backend/src/uxbox/services/pages.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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)))) diff --git a/backend/src/uxbox/services/projects.clj b/backend/src/uxbox/services/projects.clj index 2a6d09a40..416f8bc89 100644 --- a/backend/src/uxbox/services/projects.clj +++ b/backend/src/uxbox/services/projects.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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))) diff --git a/backend/src/uxbox/services/svgparse.clj b/backend/src/uxbox/services/svgparse.clj index bf7487f74..0e1e12207 100644 --- a/backend/src/uxbox/services/svgparse.clj +++ b/backend/src/uxbox/services/svgparse.clj @@ -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)) diff --git a/backend/src/uxbox/services/users.clj b/backend/src/uxbox/services/users.clj index 40dab1829..a81c90dfc 100644 --- a/backend/src/uxbox/services/users.clj +++ b/backend/src/uxbox/services/users.clj @@ -5,318 +5,377 @@ ;; Copyright (c) 2016 Andrey Antukh (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])) diff --git a/backend/src/uxbox/sql.clj b/backend/src/uxbox/sql.clj deleted file mode 100644 index a6e87be93..000000000 --- a/backend/src/uxbox/sql.clj +++ /dev/null @@ -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 - -(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 ""}) - diff --git a/backend/src/uxbox/util/blob.clj b/backend/src/uxbox/util/blob.clj index e1b96eff8..f79e11cdb 100644 --- a/backend/src/uxbox/util/blob.clj +++ b/backend/src/uxbox/util/blob.clj @@ -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}))) diff --git a/backend/src/uxbox/util/dispatcher.clj b/backend/src/uxbox/util/dispatcher.clj new file mode 100644 index 000000000..7c93a8db7 --- /dev/null +++ b/backend/src/uxbox/util/dispatcher.clj @@ -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 + +(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)))}) diff --git a/backend/src/uxbox/util/emails.clj b/backend/src/uxbox/util/emails.clj new file mode 100644 index 000000000..739627eda --- /dev/null +++ b/backend/src/uxbox/util/emails.clj @@ -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 + +(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))))))) diff --git a/backend/src/uxbox/util/migrations.clj b/backend/src/uxbox/util/migrations.clj new file mode 100644 index 000000000..379b7c4c8 --- /dev/null +++ b/backend/src/uxbox/util/migrations.clj @@ -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 + +(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)))))) diff --git a/backend/src/uxbox/util/pgsql.clj b/backend/src/uxbox/util/pgsql.clj new file mode 100644 index 000000000..240952c85 --- /dev/null +++ b/backend/src/uxbox/util/pgsql.clj @@ -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 + +(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))))) + diff --git a/backend/src/uxbox/util/quartz.clj b/backend/src/uxbox/util/quartz.clj deleted file mode 100644 index e74cca37a..000000000 --- a/backend/src/uxbox/util/quartz.clj +++ /dev/null @@ -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 - -(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))) diff --git a/backend/src/uxbox/util/snappy.clj b/backend/src/uxbox/util/snappy.clj index 731e06c96..4816bf9c6 100644 --- a/backend/src/uxbox/util/snappy.clj +++ b/backend/src/uxbox/util/snappy.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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." diff --git a/backend/src/uxbox/util/spec.clj b/backend/src/uxbox/util/spec.clj index fdf729369..5a948424e 100644 --- a/backend/src/uxbox/util/spec.clj +++ b/backend/src/uxbox/util/spec.clj @@ -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) diff --git a/backend/src/uxbox/util/sql.clj b/backend/src/uxbox/util/sql.clj new file mode 100644 index 000000000..79b2ecfba --- /dev/null +++ b/backend/src/uxbox/util/sql.clj @@ -0,0 +1,251 @@ +;; Copyright (c) 2019 Andrey Antukh +;; 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 *"))) + diff --git a/backend/src/uxbox/util/struct.clj b/backend/src/uxbox/util/struct.clj deleted file mode 100644 index f15ab1ca3..000000000 --- a/backend/src/uxbox/util/struct.clj +++ /dev/null @@ -1,3 +0,0 @@ -(ns uxbox.util.struct - (:refer-clojure :exclude [keyword uuid vector boolean long map set]) - (:require [struct.core :as st])) diff --git a/backend/src/uxbox/util/template.clj b/backend/src/uxbox/util/template.clj index 8579f4163..be1fb38c0 100644 --- a/backend/src/uxbox/util/template.clj +++ b/backend/src/uxbox/util/template.clj @@ -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 +;; Copyright (c) 2016-2019 Andrey Antukh (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)))) + diff --git a/backend/src/uxbox/util/time.clj b/backend/src/uxbox/util/time.clj index 88137b98f..7f7fa9fd2 100644 --- a/backend/src/uxbox/util/time.clj +++ b/backend/src/uxbox/util/time.clj @@ -5,10 +5,12 @@ ;; Copyright (c) 2016 Andrey Antukh (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] diff --git a/backend/src/uxbox/util/transit.clj b/backend/src/uxbox/util/transit.clj index 4254a1caf..a601d6e2c 100644 --- a/backend/src/uxbox/util/transit.clj +++ b/backend/src/uxbox/util/transit.clj @@ -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 +;; Copyright (c) 2019 Andrey Antukh (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) diff --git a/backend/src/uxbox/util/uuid.clj b/backend/src/uxbox/util/uuid.clj index 8fe024ce1..fde6cfa70 100644 --- a/backend/src/uxbox/util/uuid.clj +++ b/backend/src/uxbox/util/uuid.clj @@ -5,18 +5,29 @@ ;; Copyright (c) 2016 Andrey Antukh (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." diff --git a/backend/src/uxbox/util/workers.clj b/backend/src/uxbox/util/workers.clj index fac845b84..03e4572f3 100644 --- a/backend/src/uxbox/util/workers.clj +++ b/backend/src/uxbox/util/workers.clj @@ -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)))) diff --git a/backend/src/vertx/core.clj b/backend/src/vertx/core.clj new file mode 100644 index 000000000..bc5b28610 --- /dev/null +++ b/backend/src/vertx/core.clj @@ -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 + +(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)) + + + diff --git a/backend/src/vertx/eventbus.clj b/backend/src/vertx/eventbus.clj new file mode 100644 index 000000000..f98b4cdf8 --- /dev/null +++ b/backend/src/vertx/eventbus.clj @@ -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 + +(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)) + + diff --git a/backend/src/vertx/http.clj b/backend/src/vertx/http.clj new file mode 100644 index 000000000..d02ffde7d --- /dev/null +++ b/backend/src/vertx/http.clj @@ -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 + +(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" {})))) diff --git a/backend/src/vertx/timers.clj b/backend/src/vertx/timers.clj new file mode 100644 index 000000000..9484ad9fb --- /dev/null +++ b/backend/src/vertx/timers.clj @@ -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 + +(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))))))) diff --git a/backend/src/vertx/util.clj b/backend/src/vertx/util.clj new file mode 100644 index 000000000..fc86b28fc --- /dev/null +++ b/backend/src/vertx/util.clj @@ -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 + +(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)))))) + diff --git a/backend/src/vertx/util/transit.clj b/backend/src/vertx/util/transit.clj new file mode 100644 index 000000000..d96011133 --- /dev/null +++ b/backend/src/vertx/util/transit.clj @@ -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 + +(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))))) diff --git a/backend/src/vertx/web.clj b/backend/src/vertx/web.clj new file mode 100644 index 000000000..321042f77 --- /dev/null +++ b/backend/src/vertx/web.clj @@ -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 + +(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)))) diff --git a/backend/src/vertx/web/interceptors.clj b/backend/src/vertx/web/interceptors.clj new file mode 100644 index 000000000..50d960e64 --- /dev/null +++ b/backend/src/vertx/web/interceptors.clj @@ -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 + +(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})) diff --git a/backend/test/uxbox/tests/helpers.clj b/backend/test/uxbox/tests/helpers.clj index 9ff22d473..9463ef2c3 100644 --- a/backend/test/uxbox/tests/helpers.clj +++ b/backend/test/uxbox/tests/helpers.clj @@ -1,30 +1,27 @@ (ns uxbox.tests.helpers - (:refer-clojure :exclude [await]) - (:require [clj-http.client :as http] - [buddy.hashers :as hashers] - [buddy.core.codecs :as codecs] - [cuerdas.core :as str] - [ring.adapter.jetty :as jetty] - [mount.core :as mount] - [datoteka.storages :as st] - [suricatta.core :as sc] - [uxbox.services.auth :as usa] - [uxbox.services.users :as usu] - [uxbox.util.transit :as t] - [uxbox.migrations :as umg] - [uxbox.media :as media] - [uxbox.db :as db] - [uxbox.config :as cfg])) - -;; TODO: parametrize this -(def +base-url+ "http://localhost:5050") + (:require + [clojure.spec.alpha :as s] + [buddy.hashers :as hashers] + [promesa.core :as p] + [cuerdas.core :as str] + [mount.core :as mount] + [datoteka.storages :as st] + [uxbox.fixtures :as fixtures] + [uxbox.migrations] + [uxbox.media] + [uxbox.db :as db] + [uxbox.util.blob :as blob] + [uxbox.util.uuid :as uuid] + [uxbox.config :as cfg])) (defn state-init [next] (let [config (cfg/read-test-config)] (-> (mount/only #{#'uxbox.config/config #'uxbox.config/secret - #'uxbox.db/datasource + ;; #'uxbox.db/datasource + #'uxbox.core/system + #'uxbox.db/pool #'uxbox.migrations/migrations #'uxbox.media/assets-storage #'uxbox.media/media-storage @@ -39,158 +36,124 @@ (defn database-reset [next] - (with-open [conn (db/connection)] - (let [sql (str "SELECT table_name " - " FROM information_schema.tables " - " WHERE table_schema = 'public' " - " AND table_name != 'migrations';") - result (->> (sc/fetch conn sql) - (map :table_name))] - (sc/execute conn (str "TRUNCATE " - (apply str (interpose ", " result)) - " CASCADE;")))) + (let [sql (str "SELECT table_name " + " FROM information_schema.tables " + " WHERE table_schema = 'public' " + " AND table_name != 'migrations';")] + + @(db/with-atomic [conn db/pool] + (-> (db/query conn sql) + (p/then #(map :table-name %)) + (p/then (fn [result] + (db/query-one conn (str "TRUNCATE " + (apply str (interpose ", " result)) + " CASCADE;"))))))) (try (next) (finally (st/clear! uxbox.media/media-storage) (st/clear! uxbox.media/assets-storage)))) -(defmacro await - [expr] - `(try - (deref ~expr) - (catch Exception e# - (.getCause e#)))) +(defn mk-uuid + [prefix & args] + (uuid/namespaced uuid/oid (apply str prefix args))) -(defn- strip-response - [{:keys [status headers body]}] - (if (str/starts-with? (get headers "Content-Type") "application/transit+json") - [status (-> (codecs/str->bytes body) - (t/decode))] - [status body])) +;; --- Users creation -(defn get-auth-headers - [user] - (let [store (ring.middleware.session.cookie/cookie-store {:key "a 16-byte secret"}) - result (ring.middleware.session/session-response - {:session {:user-id (:id user)}} {} - {:store store :cookie-name "session"})] - {"cookie" (first (get-in result [:headers "Set-Cookie"]))})) - -(defn http-get - ([user uri] (http-get user uri nil)) - ([user uri {:keys [query] :as opts}] - (let [headers (assoc (get-auth-headers user) - "accept" "application/transit+json") - params (cond-> {:headers headers} - query (assoc :query-params query))] - (try - (strip-response (http/get uri params)) - (catch clojure.lang.ExceptionInfo e - (strip-response (ex-data e))))))) - -(defn http-post - ([uri params] - (http-post nil uri params)) - ([user uri {:keys [body] :as params}] - (let [body (-> (t/encode body) - (codecs/bytes->str)) - headers (assoc (get-auth-headers user) - "accept" "application/transit+json" - "content-type" "application/transit+json") - params {:headers headers :body body}] - (try - (strip-response (http/post uri params)) - (catch clojure.lang.ExceptionInfo e - (strip-response (ex-data e))))))) - -(defn http-multipart - [user uri params] - (let [headers (assoc (get-auth-headers user) - "accept" "application/transit+json") - params {:headers headers - :multipart params}] - (try - (strip-response (http/post uri params)) - (catch clojure.lang.ExceptionInfo e - (strip-response (ex-data e)))))) - -(defn http-put - ([uri params] - (http-put nil uri params)) - ([user uri {:keys [body] :as params}] - (let [body (-> (t/encode body) - (codecs/bytes->str)) - headers (assoc (get-auth-headers user) - "accept" "application/transit+json" - "content-type" "application/transit+json") - params {:headers headers :body body}] - (try - (strip-response (http/put uri params)) - (catch clojure.lang.ExceptionInfo e - (strip-response (ex-data e))))))) - -(defn http-delete - ([uri] - (http-delete nil uri)) - ([user uri] - (let [headers (assoc (get-auth-headers user) - "accept" "application/transit+json" - "content-type" "application/transit+json") - params {:headers headers}] - (try - (strip-response (http/delete uri params)) - (catch clojure.lang.ExceptionInfo e - (strip-response (ex-data e))))))) - -(defn- decode-response - [{:keys [status headers body] :as response}] - (if (= (get headers "content-type") "application/transit+json") - (assoc response :body (-> (codecs/str->bytes body) - (t/decode))) - response)) - -(defn request - [{:keys [path method body user headers raw?] - :or {raw? false} - :as request}] - {:pre [(string? path) (keyword? method)]} - (let [body (if (and body (not raw?)) - (-> (t/encode body) - (codecs/bytes->str)) - body) - headers (cond-> headers - body (assoc "content-type" "application/transit+json") - raw? (assoc "content-type" "application/octet-stream")) - params {:headers headers :body body} - uri (str +base-url+ path)] - (try - (let [response (case method - :get (http/get uri (dissoc params :body)) - :post (http/post uri params) - :put (http/put uri params) - :delete (http/delete uri params))] - (decode-response response)) - (catch clojure.lang.ExceptionInfo e - (decode-response (ex-data e)))))) +(declare decode-user-row) +(declare decode-page-row) (defn create-user - "Helper for create users" [conn i] - (let [data {:username (str "user" i) - :password (str "user" i) - :metadata (str i) - :fullname (str "User " i) - :email (str "user" i "@uxbox.io")}] - (usu/create-user conn data))) + (let [sql "insert into users (id, fullname, username, email, password, metadata, photo) + values ($1, $2, $3, $4, $5, $6, '') returning *"] + (-> (db/query-one conn [sql + (mk-uuid "user" i) + (str "User " i) + (str "user" i) + (str "user" i ".test@uxbox.io") + (hashers/encrypt "123123") + (blob/encode {})]) + (p/then' decode-user-row)))) + +(defn create-project + [conn uid i] + (let [sql "insert into projects (id, user_id, name) + values ($1, $2, $3) returning *" + name (str "sample project " i)] + (db/query-one conn [sql (mk-uuid "project" i) uid name]))) + +(defn create-page + [conn uid pid i] + (let [sql "insert into pages (id, user_id, project_id, name, data, metadata) + values ($1, $2, $3, $4, $5, $6) returning *" + data (blob/encode {:shapes []}) + mdata (blob/encode {}) + name (str "page" i) + id (mk-uuid "page" i)] + (-> (db/query-one conn [sql id uid pid name data mdata]) + (p/then' decode-page-row)))) + +(defn- decode-page-row + [{:keys [data metadata] :as row}] + (when row + (cond-> row + data (assoc :data (blob/decode data)) + metadata (assoc :metadata (blob/decode metadata))))) + +(defn- decode-user-row + [{:keys [metadata] :as row}] + (when row + (cond-> row + metadata (assoc :metadata (blob/decode metadata))))) + +(defn handle-error + [err] + (cond + (instance? clojure.lang.ExceptionInfo err) + (ex-data err) + + (instance? java.util.concurrent.ExecutionException err) + (handle-error (.getCause err)) + + :else + [err nil])) (defmacro try-on - [& body] + [expr] `(try - (let [result# (do ~@body)] + (let [result# (deref ~expr)] [nil result#]) - (catch Throwable e# - [e# nil]))) + (catch Exception e# + [(handle-error e#) nil]))) + + +(defmacro try-on! + [expr] + `(try + (let [result# (deref ~expr)] + {:error nil + :result result#}) + (catch Exception e# + {:error (handle-error e#) + :result nil}))) + +(defn print-result! + [{:keys [error result]}] + + (if error + (do + (println "====> START ERROR") + (if (= :spec-validation (:code error)) + (do + (s/explain-out (:data error)) + (println "====> END ERROR")) + (prn error))) + (do + (println "====> START RESPONSE") + (prn result) + (println "====> END RESPONSE")))) + (defn exception? [v] @@ -209,22 +172,3 @@ [e code] (let [data (ex-data e)] (= code (:code data)))) - -(defn run-server - [handler] - (jetty/run-jetty handler {:join? false - :async? true - :daemon? true - :port 5050})) - -(defmacro with-server - "Evaluate code in context of running catacumba server." - [{:keys [handler sleep] :or {sleep 50} :as options} & body] - `(let [server# (run-server ~handler)] - (try - ~@body - (finally - (.stop server#) - (Thread/sleep ~sleep))))) - - diff --git a/backend/test/uxbox/tests/main.clj b/backend/test/uxbox/tests/main.clj index 74d9e54d2..00a4975eb 100644 --- a/backend/test/uxbox/tests/main.clj +++ b/backend/test/uxbox/tests/main.clj @@ -9,13 +9,13 @@ (defn -main [& args] - (require 'uxbox.tests.test-projects) - (require 'uxbox.tests.test-pages) - (require 'uxbox.tests.test-images) - (require 'uxbox.tests.test-icons) + ;; (require 'uxbox.tests.test-projects) + ;; (require 'uxbox.tests.test-pages) + ;; (require 'uxbox.tests.test-images) + ;; (require 'uxbox.tests.test-icons) (require 'uxbox.tests.test-users) (require 'uxbox.tests.test-auth) - (require 'uxbox.tests.test-kvstore) + ;; (require 'uxbox.tests.test-kvstore) (let [{:keys [fail]} (test/run-all-tests #"^uxbox.tests.*")] (if (pos? fail) (System/exit fail) diff --git a/backend/test/uxbox/tests/test_auth.clj b/backend/test/uxbox/tests/test_auth.clj index 44c335f8b..fbec7fef0 100644 --- a/backend/test/uxbox/tests/test_auth.clj +++ b/backend/test/uxbox/tests/test_auth.clj @@ -1,51 +1,42 @@ +;; 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 + (ns uxbox.tests.test-auth - (:require [clojure.test :as t] - [promesa.core :as p] - [buddy.hashers :as hashers] - [uxbox.db :as db] - [uxbox.http :as http] - [uxbox.services.users :as usu] - [uxbox.services :as usv] - [uxbox.tests.helpers :as th])) + (:require + [clojure.test :as t] + [promesa.core :as p] + [buddy.hashers :as hashers] + [uxbox.db :as db] + [uxbox.services.core :as sv] + [uxbox.tests.helpers :as th])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) -(t/deftest test-http-success-auth - (let [data {:username "user1" - :fullname "user 1" - :metadata "1" - :password "user1" - :email "user1@uxbox.io"} - user (with-open [conn (db/connection)] - (usu/create-user conn data))] - (th/with-server {:handler @http/app} - (let [data {:username "user1" - :password "user1" - :metadata "1" - :scope "foobar"} - uri (str th/+base-url+ "/api/auth/login") - [status data] (th/http-post uri {:body data})] - ;; (println "RESPONSE:" status data) - (t/is (= status 204)))))) - -(t/deftest test-http-failed-auth - (let [data {:username "user1" - :fullname "user 1" - :metadata "1" - :password (hashers/encrypt "user1") - :email "user1@uxbox.io"} - user (with-open [conn (db/connection)] - (usu/create-user conn data))] - (th/with-server {:handler @http/app} - (let [data {:username "user1" - :password "user2" - :metadata "2" - :scope "foobar"} - uri (str th/+base-url+ "/api/auth/login") - [status data] (th/http-post uri {:body data})] - ;; (prn "RESPONSE:" status data) - (t/is (= 400 status)) - (t/is (= (:type data) :validation)) - (t/is (= (:code data) :uxbox.services.auth/wrong-credentials)))))) +(t/deftest test-failed-auth + (let [user @(th/create-user db/pool 1) + event {:username "user1" + :type :login + :password "foobar" + :metadata "1" + :scope "foobar"} + [err res] (th/try-on + (sv/mutation event))] + (t/is (nil? res)) + (t/is (= (:type err) :validation)) + (t/is (= (:code err) :uxbox.services.auth/wrong-credentials)))) +(t/deftest test-success-auth + (let [user @(th/create-user db/pool 1) + event {:username "user1" + :type :login + :password "123123" + :metadata "1" + :scope "foobar"} + [err res] (th/try-on + (sv/mutation event))] + (t/is (= res (:id user))) + (t/is (nil? err)))) diff --git a/backend/test/uxbox/tests/test_icons.clj b/backend/test/uxbox/tests/test_icons.clj index bde6d3860..4abac86a8 100644 --- a/backend/test/uxbox/tests/test_icons.clj +++ b/backend/test/uxbox/tests/test_icons.clj @@ -1,5 +1,5 @@ (ns uxbox.tests.test-icons - (:require [clojure.test :as t] + #_(:require [clojure.test :as t] [promesa.core :as p] [suricatta.core :as sc] [uxbox.db :as db] @@ -9,154 +9,154 @@ [uxbox.services :as usv] [uxbox.tests.helpers :as th])) -(t/use-fixtures :once th/state-init) -(t/use-fixtures :each th/database-reset) +;; (t/use-fixtures :once th/state-init) +;; (t/use-fixtures :each th/database-reset) -(t/deftest test-http-list-icon-collections - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "coll1"} - coll (icons/create-collection conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icon-collections") - [status data] (th/http-get user uri)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= 1 (count data)))))))) +;; (t/deftest test-http-list-icon-collections +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "coll1"} +;; coll (icons/create-collection conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icon-collections") +;; [status data] (th/http-get user uri)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= 1 (count data)))))))) -(t/deftest test-http-create-icon-collection - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icon-collections") - data {:user (:id user) - :name "coll1"} - params {:body data} - [status data] (th/http-post user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 201 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "coll1"))))))) +;; (t/deftest test-http-create-icon-collection +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icon-collections") +;; data {:user (:id user) +;; :name "coll1"} +;; params {:body data} +;; [status data] (th/http-post user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 201 status)) +;; (t/is (= (:user data) (:id user))) +;; (t/is (= (:name data) "coll1"))))))) -(t/deftest test-http-update-icon-collection - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "coll1"} - coll (icons/create-collection conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icon-collections/" (:id coll)) - params {:body (assoc coll :name "coll2")} - [status data] (th/http-put user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "coll2"))))))) +;; (t/deftest test-http-update-icon-collection +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "coll1"} +;; coll (icons/create-collection conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icon-collections/" (:id coll)) +;; params {:body (assoc coll :name "coll2")} +;; [status data] (th/http-put user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= (:user data) (:id user))) +;; (t/is (= (:name data) "coll2"))))))) -(t/deftest test-http-icon-collection-delete - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "coll1" - :data #{1}} - coll (icons/create-collection conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icon-collections/" (:id coll)) - [status data] (th/http-delete user uri)] - (t/is (= 204 status)) - (let [sqlv (sql/get-icon-collections {:user (:id user)}) - result (sc/fetch conn sqlv)] - (t/is (empty? result)))))))) +;; (t/deftest test-http-icon-collection-delete +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "coll1" +;; :data #{1}} +;; coll (icons/create-collection conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icon-collections/" (:id coll)) +;; [status data] (th/http-delete user uri)] +;; (t/is (= 204 status)) +;; (let [sqlv (sql/get-icon-collections {:user (:id user)}) +;; result (sc/fetch conn sqlv)] +;; (t/is (empty? result)))))))) -(t/deftest test-http-create-icon - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icons") - data {:name "sample.jpg" - :content "" - :metadata {:width 200 - :height 200 - :view-box [0 0 200 200]} - :collection nil} - params {:body data} - [status data] (th/http-post user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 201 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "sample.jpg")) - (t/is (= (:metadata data) {:width 200 - :height 200 - :view-box [0 0 200 200]}))))))) +;; (t/deftest test-http-create-icon +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icons") +;; data {:name "sample.jpg" +;; :content "" +;; :metadata {:width 200 +;; :height 200 +;; :view-box [0 0 200 200]} +;; :collection nil} +;; params {:body data} +;; [status data] (th/http-post user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 201 status)) +;; (t/is (= (:user data) (:id user))) +;; (t/is (= (:name data) "sample.jpg")) +;; (t/is (= (:metadata data) {:width 200 +;; :height 200 +;; :view-box [0 0 200 200]}))))))) -(t/deftest test-http-update-icon - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "test.svg" - :content "" - :metadata {} - :collection nil} - icon (icons/create-icon conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icons/" (:id icon)) - params {:body (assoc icon :name "my stuff")} - [status data] (th/http-put user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "my stuff"))))))) +;; (t/deftest test-http-update-icon +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "test.svg" +;; :content "" +;; :metadata {} +;; :collection nil} +;; icon (icons/create-icon conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icons/" (:id icon)) +;; params {:body (assoc icon :name "my stuff")} +;; [status data] (th/http-put user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= (:user data) (:id user))) +;; (t/is (= (:name data) "my stuff"))))))) -(t/deftest test-http-copy-icon - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "test.svg" - :content "" - :metadata {} - :collection nil} - icon (icons/create-icon conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icons/" (:id icon) "/copy") - body {:collection nil} - params {:body body} - [status data] (th/http-put user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= status 200)) - (let [sqlv (sql/get-icons {:user (:id user) :collection nil}) - result (sc/fetch conn sqlv)] - (t/is (= 2 (count result))))))))) +;; (t/deftest test-http-copy-icon +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "test.svg" +;; :content "" +;; :metadata {} +;; :collection nil} +;; icon (icons/create-icon conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icons/" (:id icon) "/copy") +;; body {:collection nil} +;; params {:body body} +;; [status data] (th/http-put user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= status 200)) +;; (let [sqlv (sql/get-icons {:user (:id user) :collection nil}) +;; result (sc/fetch conn sqlv)] +;; (t/is (= 2 (count result))))))))) -(t/deftest test-http-delete-icon - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "test.svg" - :content "" - :metadata {} - :collection nil} - icon (icons/create-icon conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icons/" (:id icon)) - [status data] (th/http-delete user uri)] - (t/is (= 204 status)) - (let [sqlv (sql/get-icons {:user (:id user) :collection nil}) - result (sc/fetch conn sqlv)] - (t/is (empty? result)))))))) +;; (t/deftest test-http-delete-icon +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "test.svg" +;; :content "" +;; :metadata {} +;; :collection nil} +;; icon (icons/create-icon conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icons/" (:id icon)) +;; [status data] (th/http-delete user uri)] +;; (t/is (= 204 status)) +;; (let [sqlv (sql/get-icons {:user (:id user) :collection nil}) +;; result (sc/fetch conn sqlv)] +;; (t/is (empty? result)))))))) -(t/deftest test-http-list-icons - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "test.png" - :content "" - :metadata {} - :collection nil} - icon (icons/create-icon conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/icons") - [status data] (th/http-get user uri)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= 1 (count data)))))))) +;; (t/deftest test-http-list-icons +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "test.png" +;; :content "" +;; :metadata {} +;; :collection nil} +;; icon (icons/create-icon conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/icons") +;; [status data] (th/http-get user uri)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= 1 (count data)))))))) diff --git a/backend/test/uxbox/tests/test_images.clj b/backend/test/uxbox/tests/test_images.clj index 873f8e3b5..c98b9f8a2 100644 --- a/backend/test/uxbox/tests/test_images.clj +++ b/backend/test/uxbox/tests/test_images.clj @@ -1,5 +1,5 @@ (ns uxbox.tests.test-images - (:require [clojure.test :as t] + #_(:require [clojure.test :as t] [promesa.core :as p] [suricatta.core :as sc] [clojure.java.io :as io] @@ -12,165 +12,165 @@ [uxbox.services :as usv] [uxbox.tests.helpers :as th])) -(t/use-fixtures :once th/state-init) -(t/use-fixtures :each th/database-reset) +;; (t/use-fixtures :once th/state-init) +;; (t/use-fixtures :each th/database-reset) -(t/deftest test-http-list-image-collections - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "coll1"} - coll (images/create-collection conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/image-collections") - [status data] (th/http-get user uri)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= 1 (count data)))))))) +;; (t/deftest test-http-list-image-collections +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "coll1"} +;; coll (images/create-collection conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/image-collections") +;; [status data] (th/http-get user uri)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= 1 (count data)))))))) -(t/deftest test-http-create-image-collection - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/image-collections") - data {:user (:id user) - :name "coll1"} - params {:body data} - [status data] (th/http-post user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 201 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "coll1"))))))) +;; (t/deftest test-http-create-image-collection +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/image-collections") +;; data {:user (:id user) +;; :name "coll1"} +;; params {:body data} +;; [status data] (th/http-post user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 201 status)) +;; (t/is (= (:user data) (:id user))) +;; (t/is (= (:name data) "coll1"))))))) -(t/deftest test-http-update-image-collection - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "coll1"} - coll (images/create-collection conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/image-collections/" (:id coll)) - params {:body (assoc coll :name "coll2")} - [status data] (th/http-put user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "coll2"))))))) +;; (t/deftest test-http-update-image-collection +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "coll1"} +;; coll (images/create-collection conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/image-collections/" (:id coll)) +;; params {:body (assoc coll :name "coll2")} +;; [status data] (th/http-put user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= (:user data) (:id user))) +;; (t/is (= (:name data) "coll2"))))))) -(t/deftest test-http-image-collection-delete - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "coll1" - :data #{1}} - coll (images/create-collection conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/image-collections/" (:id coll)) - [status data] (th/http-delete user uri)] - (t/is (= 204 status)) - (let [sqlv (sql/get-image-collections {:user (:id user)}) - result (sc/fetch conn sqlv)] - (t/is (empty? result)))))))) +;; (t/deftest test-http-image-collection-delete +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "coll1" +;; :data #{1}} +;; coll (images/create-collection conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/image-collections/" (:id coll)) +;; [status data] (th/http-delete user uri)] +;; (t/is (= 204 status)) +;; (let [sqlv (sql/get-image-collections {:user (:id user)}) +;; result (sc/fetch conn sqlv)] +;; (t/is (empty? result)))))))) -(t/deftest test-http-create-image - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/images") - parts [{:name "sample.jpg" - :part-name "file" - :content (io/input-stream - (io/resource "uxbox/tests/_files/sample.jpg"))} - {:part-name "user" :content (str (:id user))} - {:part-name "width" :content "100"} - {:part-name "height" :content "100"} - {:part-name "mimetype" :content "image/png"}] - [status data] (th/http-multipart user uri parts)] - ;; (println "RESPONSE:" status data) - (t/is (= 201 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "sample.jpg"))))))) +;; (t/deftest test-http-create-image +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/images") +;; parts [{:name "sample.jpg" +;; :part-name "file" +;; :content (io/input-stream +;; (io/resource "uxbox/tests/_files/sample.jpg"))} +;; {:part-name "user" :content (str (:id user))} +;; {:part-name "width" :content "100"} +;; {:part-name "height" :content "100"} +;; {:part-name "mimetype" :content "image/png"}] +;; [status data] (th/http-multipart user uri parts)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 201 status)) +;; (t/is (= (:user data) (:id user))) +;; (t/is (= (:name data) "sample.jpg"))))))) -(t/deftest test-http-update-image - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "test.png" - :path "some/path" - :width 100 - :height 100 - :mimetype "image/png" - :collection nil} - img (images/create-image conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/images/" (:id img)) - params {:body (assoc img :name "my stuff")} - [status data] (th/http-put user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "my stuff"))))))) +;; (t/deftest test-http-update-image +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "test.png" +;; :path "some/path" +;; :width 100 +;; :height 100 +;; :mimetype "image/png" +;; :collection nil} +;; img (images/create-image conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/images/" (:id img)) +;; params {:body (assoc img :name "my stuff")} +;; [status data] (th/http-put user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= (:user data) (:id user))) +;; (t/is (= (:name data) "my stuff"))))))) -(t/deftest test-http-copy-image - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - storage media/images-storage - filename "sample.jpg" - rcs (io/resource "uxbox/tests/_files/sample.jpg") - path @(st/save storage filename rcs) - data {:user (:id user) - :name filename - :path (str path) - :width 100 - :height 100 - :mimetype "image/jpg" - :collection nil} - img (images/create-image conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/images/" (:id img) "/copy") - body {:id (:id img) - :collection nil} - params {:body body} - [status data] (th/http-put user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (let [sqlv (sql/get-images {:user (:id user) :collection nil}) - result (sc/fetch conn sqlv)] - (t/is (= 2 (count result))))))))) +;; (t/deftest test-http-copy-image +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; storage media/images-storage +;; filename "sample.jpg" +;; rcs (io/resource "uxbox/tests/_files/sample.jpg") +;; path @(st/save storage filename rcs) +;; data {:user (:id user) +;; :name filename +;; :path (str path) +;; :width 100 +;; :height 100 +;; :mimetype "image/jpg" +;; :collection nil} +;; img (images/create-image conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/images/" (:id img) "/copy") +;; body {:id (:id img) +;; :collection nil} +;; params {:body body} +;; [status data] (th/http-put user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (let [sqlv (sql/get-images {:user (:id user) :collection nil}) +;; result (sc/fetch conn sqlv)] +;; (t/is (= 2 (count result))))))))) -(t/deftest test-http-delete-image - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "test.png" - :path "some/path" - :width 100 - :height 100 - :mimetype "image/png" - :collection nil} - img (images/create-image conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/images/" (:id img)) - [status data] (th/http-delete user uri)] - (t/is (= 204 status)) - (let [sqlv (sql/get-images {:user (:id user) :collection nil}) - result (sc/fetch conn sqlv)] - (t/is (empty? result)))))))) +;; (t/deftest test-http-delete-image +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "test.png" +;; :path "some/path" +;; :width 100 +;; :height 100 +;; :mimetype "image/png" +;; :collection nil} +;; img (images/create-image conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/images/" (:id img)) +;; [status data] (th/http-delete user uri)] +;; (t/is (= 204 status)) +;; (let [sqlv (sql/get-images {:user (:id user) :collection nil}) +;; result (sc/fetch conn sqlv)] +;; (t/is (empty? result)))))))) -(t/deftest test-http-list-images - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - data {:user (:id user) - :name "test.png" - :path "some/path" - :width 100 - :height 100 - :mimetype "image/png" - :collection nil} - img (images/create-image conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/library/images") - [status data] (th/http-get user uri)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= 1 (count data)))))))) +;; (t/deftest test-http-list-images +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; data {:user (:id user) +;; :name "test.png" +;; :path "some/path" +;; :width 100 +;; :height 100 +;; :mimetype "image/png" +;; :collection nil} +;; img (images/create-image conn data)] +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ "/api/library/images") +;; [status data] (th/http-get user uri)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= 1 (count data)))))))) diff --git a/backend/test/uxbox/tests/test_kvstore.clj b/backend/test/uxbox/tests/test_kvstore.clj index 8e5f8fce9..d6f50c242 100644 --- a/backend/test/uxbox/tests/test_kvstore.clj +++ b/backend/test/uxbox/tests/test_kvstore.clj @@ -1,66 +1,52 @@ (ns uxbox.tests.test-kvstore - (:require [clojure.test :as t] - [promesa.core :as p] - [suricatta.core :as sc] - [buddy.core.codecs :as codecs] - [uxbox.db :as db] - [uxbox.util.uuid :as uuid] - [uxbox.http :as http] - [uxbox.services.kvstore :as kvs] - [uxbox.tests.helpers :as th])) + (:require + [clojure.spec.alpha :as s] + [clojure.test :as t] + [promesa.core :as p] + [uxbox.db :as db] + [uxbox.http :as http] + [uxbox.services.core :as sv] + [uxbox.tests.helpers :as th])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) +(t/deftest test-mutation-upsert-kvstore + (let [{:keys [id] :as user} @(th/create-user db/pool 1)] + (let [out (th/try-on! (sv/query {::sv/type :kvstore-entry + :key "foobar" + :user id}))] + ;; (th/print-result! out) + (t/is (nil? (:error out))) + (t/is (nil? (:result out)))) -(t/deftest test-http-kvstore - (with-open [conn (db/connection)] - (let [{:keys [id] :as user} (th/create-user conn 1)] + (let [out (th/try-on! (sv/mutation {::sv/type :upsert-kvstore + :user id + :key "foobar" + :value {:some #{:value}}}))] + ;; (th/print-result! out) + (t/is (nil? (:error out))) + (t/is (nil? (:result out)))) - ;; Not exists at this moment - (t/is (nil? (kvs/retrieve-kvstore conn {:user id :key "foo" :version -1}))) + (let [out (th/try-on! (sv/query {::sv/type :kvstore-entry + :key "foobar" + :user id}))] + ;; (th/print-result! out) + (t/is (nil? (:error out))) + (t/is (= {:some #{:value}} (get-in out [:result :value]))) + (t/is (= "foobar" (get-in out [:result :key])))) - ;; Creating new one should work as expected - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/kvstore/foo") - body {:value "bar" :version -1} - params {:body body} - [status data] (th/http-put user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:key data) "foo")) - (t/is (= (:value data) "bar")))) + (let [out (th/try-on! (sv/mutation {::sv/type :delete-kvstore + :user id + :key "foobar"}))] + ;; (th/print-result! out) + (t/is (nil? (:error out))) + (t/is (nil? (:result out)))) - ;; Should exists - (let [data (kvs/retrieve-kvstore conn {:user id :key "foo"})] - (t/is (= (:key data) "foo")) - (t/is (= (:value data) "bar")) - - ;; Overwriting should work - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/kvstore/foo") - body (assoc data :value "baz") - _ (prn body) - [status data] (th/http-put user uri {:body body})] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:key data) "foo")) - (t/is (= (:value data) "baz"))))) - - ;; Should exists and match the overwritten value - (let [data (kvs/retrieve-kvstore conn {:user id :key "foo"})] - (t/is (= (:key data) "foo")) - (t/is (= (:value data) "baz"))) - - ;; Delete should work - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/kvstore/foo") - [status data] (th/http-delete user uri)] - ;; (println "RESPONSE:" status data) - (t/is (= 204 status)))) - - ;; Not exists at this moment - (t/is (nil? (kvs/retrieve-kvstore conn {:user id :key "foo"}))) - - ))) + (let [out (th/try-on! (sv/query {::sv/type :kvstore-entry + :key "foobar" + :user id}))] + ;; (th/print-result! out) + (t/is (nil? (:error out))) + (t/is (nil? (:result out)))))) diff --git a/backend/test/uxbox/tests/test_pages.clj b/backend/test/uxbox/tests/test_pages.clj index 2095549d8..9e01140ef 100644 --- a/backend/test/uxbox/tests/test_pages.clj +++ b/backend/test/uxbox/tests/test_pages.clj @@ -1,219 +1,142 @@ (ns uxbox.tests.test-pages - (:require [clojure.test :as t] - [promesa.core :as p] - [suricatta.core :as sc] - [uxbox.util.uuid :as uuid] - [uxbox.db :as db] - [uxbox.http :as http] - [uxbox.services.projects :as uspr] - [uxbox.services.pages :as uspg] - [uxbox.services :as usv] - [uxbox.tests.helpers :as th])) + (:require + [clojure.spec.alpha :as s] + [clojure.test :as t] + [promesa.core :as p] + [uxbox.db :as db] + [uxbox.http :as http] + [uxbox.services.core :as sv] + [uxbox.tests.helpers :as th])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) -(t/deftest test-http-page-create - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"})] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/pages") - params {:body {:project (:id proj) - :name "page1" - :data "1" - :metadata "1" - :width 200 - :height 200 - :layout "mobile"}} - [status data] (th/http-post user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 201 status)) - (t/is (= (:data (:body params)) (:data data))) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "page1"))))))) +(t/deftest test-mutation-create-page + (let [user @(th/create-user db/pool 1) + proj @(th/create-project db/pool (:id user) 1) + data {::sv/type :create-page + :data {:shapes []} + :metadata {} + :project-id (:id proj) + :name "test page" + :user (:id user)} + [err rsp] (th/try-on (sv/mutation data))] + (t/is (nil? err)) + (t/is (uuid? (:id rsp))) + (t/is (= (:user data) (:user-id rsp))) + (t/is (= (:name data) (:name rsp))) + (t/is (= (:data data) (:data rsp))) + (t/is (= (:metadata data) (:metadata rsp))))) -(t/deftest test-http-page-update - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"}) - data {:id (uuid/random) - :user (:id user) - :project (:id proj) - :version 0 - :data "1" - :metadata "2" - :name "page1" - :width 200 - :height 200 - :layout "mobil"} - page (uspg/create-page conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ (str "/api/pages/" (:id page))) - params {:body (assoc page :data "3")} - [status page'] (th/http-put user uri params)] - ;; (println "RESPONSE:" status page') - (t/is (= 200 status)) - (t/is (= "3" (:data page'))) - (t/is (= 1 (:version page'))) - (t/is (= (:user page') (:id user))) - (t/is (= (:name data) "page1"))))))) +(t/deftest test-mutation-update-page + (let [user @(th/create-user db/pool 1) + proj @(th/create-project db/pool (:id user) 1) + page @(th/create-page db/pool (:id user) (:id proj) 1) + data {::sv/type :update-page + :id (:id page) + :data {:shapes [1 2 3]} + :metadata {:foo 2} + :project-id (:id proj) + :name "test page" + :user (:id user)} + res (th/try-on! (sv/mutation data))] -(t/deftest test-http-page-update-metadata - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"}) - data {:id (uuid/random) - :user (:id user) - :project (:id proj) - :version 0 - :data "1" - :metadata "2" - :name "page1" - :width 200 - :height 200 - :layout "mobil"} - page (uspg/create-page conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ (str "/api/pages/" (:id page) "/metadata")) - params {:body (assoc page :data "3")} - [status page'] (th/http-put user uri params)] - ;; (println "RESPONSE:" status page') - (t/is (= 200 status)) - (t/is (= "1" (:data page'))) - (t/is (= 1 (:version page'))) - (t/is (= (:user page') (:id user))) - (t/is (= (:name data) "page1"))))))) + ;; (th/print-result! res) -(t/deftest test-http-page-delete - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"}) - data {:id (uuid/random) - :user (:id user) - :project (:id proj) - :version 0 - :data "1" - :metadata "2" - :name "page1" - :width 200 - :height 200 - :layout "mobil"} - page (uspg/create-page conn data)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ (str "/api/pages/" (:id page))) - [status response] (th/http-delete user uri)] - ;; (println "RESPONSE:" status response) - (t/is (= 204 status)) - (let [sqlv ["SELECT * FROM pages WHERE \"user\"=? AND deleted_at is null" - (:id user)] - result (sc/fetch conn sqlv)] - (t/is (empty? result)))))))) + (t/is (nil? (:error res))) + (t/is (= (:id data) (get-in res [:result :id]))) + (t/is (= (:user data) (get-in res [:result :user-id]))) + (t/is (= (:name data) (get-in res [:result :name]))) + (t/is (= (:data data) (get-in res [:result :data]))) + (t/is (= (:metadata data) (get-in res [:result :metadata]))))) -(t/deftest test-http-page-list-by-project - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj1 (uspr/create-project conn {:user (:id user) :name "proj1"}) - proj2 (uspr/create-project conn {:user (:id user) :name "proj2"}) - data {:user (:id user) - :version 0 - :data "1" - :metadata "2" - :name "page1" - :width 200 - :height 200 - :layout "mobil"} - page1 (uspg/create-page conn (assoc data :project (:id proj1))) - page2 (uspg/create-page conn (assoc data :project (:id proj2)))] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ (str "/api/pages?project=" (:id proj1))) - [status response] (th/http-get user uri)] - ;; (println "RESPONSE:" status response) - (t/is (= 200 status)) - (t/is (= 1 (count response))) - (t/is (= (:id (first response)) (:id page1)))))))) +(t/deftest test-mutation-update-page-metadata + (let [user @(th/create-user db/pool 1) + proj @(th/create-project db/pool (:id user) 1) + page @(th/create-page db/pool (:id user) (:id proj) 1) + data {::sv/type :update-page + :id (:id page) + :metadata {:foo 2} + :project-id (:id proj) + :name "test page" + :user (:id user)} + res (th/try-on! (sv/mutation data))] -(t/deftest test-http-page-history-retrieve - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"}) - data {:id (uuid/random) - :user (:id user) - :project (:id proj) - :version 0 - :data "1" - :metadata "2" - :name "page1" - :width 200 - :height 200 - :layout "mobil"} - page (uspg/create-page conn data)] - (dotimes [i 100] - (let [page (uspg/get-page-by-id conn (:id data))] - (uspg/update-page conn (assoc page :data (str i))))) + ;; (th/print-result! res) + (t/is (nil? (:error res))) + (t/is (= (:id data) (get-in res [:result :id]))) + (t/is (= (:user data) (get-in res [:result :user-id]))) + (t/is (= (:name data) (get-in res [:result :name]))) + (t/is (= (:metadata data) (get-in res [:result :metadata]))))) - ;; Check inserted history - (let [sqlv ["SELECT * FROM pages_history WHERE page=?" (:id data)] - result (sc/fetch conn sqlv)] - (t/is (= (count result) 101))) +(t/deftest test-mutation-delete-page + (let [user @(th/create-user db/pool 1) + proj @(th/create-project db/pool (:id user) 1) + page @(th/create-page db/pool (:id user) (:id proj) 1) + data {::sv/type :delete-page + :id (:id page) + :user (:id user)} + res (th/try-on! (sv/mutation data))] - ;; Check retrieve all items - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/pages/" (:id page) "/history") - [status result] (th/http-get user uri nil)] - ;; (println "RESPONSE:" status result) - (t/is (= (count result) 10)) - (t/is (= 200 status)) - (t/is (= 100 (:version (first result)))) + ;; (th/print-result! res) + (t/is (nil? (:error res))) + (t/is (nil? (:result res))))) - (let [params {:query {:since (:version (last result)) - :max 20}} - [status result] (th/http-get user uri params)] - ;; (println "RESPONSE:" status result) - (t/is (= (count result) 20)) - (t/is (= 200 status)) - (t/is (= 90 (:version (first result)))))) - )))) +(t/deftest test-query-pages-by-project + (let [user @(th/create-user db/pool 1) + proj @(th/create-project db/pool (:id user) 1) + page @(th/create-page db/pool (:id user) (:id proj) 1) + data {::sv/type :pages-by-project + :project-id (:id proj) + :user (:id user)} + res (th/try-on! (sv/query data))] -(t/deftest test-http-page-history-update - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"}) - data {:id (uuid/random) - :user (:id user) - :project (:id proj) - :version 0 - :data "1" - :metadata "2" - :name "page1" - :width 200 - :height 200 - :layout "mobil"} - page (uspg/create-page conn data)] + (th/print-result! res) + (t/is (nil? (:error res))) + (t/is (vector? (:result res))) + (t/is (= 1 (count (:result res)))) + (t/is (= "page1" (get-in res [:result 0 :name]))) + (t/is (:id proj) (get-in res [:result 0 :project-id])))) - (dotimes [i 10] - (let [page (uspg/get-page-by-id conn (:id data))] - (uspg/update-page conn (assoc page :data (str i))))) +;; (t/deftest test-http-page-history-update +;; (with-open [conn (db/connection)] +;; (let [user (th/create-user conn 1) +;; proj (uspr/create-project conn {:user (:id user) :name "proj1"}) +;; data {:id (uuid/random) +;; :user (:id user) +;; :project (:id proj) +;; :version 0 +;; :data "1" +;; :metadata "2" +;; :name "page1" +;; :width 200 +;; :height 200 +;; :layout "mobil"} +;; page (uspg/create-page conn data)] - ;; Check inserted history - (let [sql (str "SELECT * FROM pages_history " - " WHERE page=? ORDER BY created_at DESC") - result (sc/fetch conn [sql (:id data)]) - item (first result)] +;; (dotimes [i 10] +;; (let [page (uspg/get-page-by-id conn (:id data))] +;; (uspg/update-page conn (assoc page :data (str i))))) - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ - "/api/pages/" (:id page) - "/history/" (:id item)) - params {:body {:label "test" :pinned true}} - [status data] (th/http-put user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:id data) (:id item)))))) +;; ;; Check inserted history +;; (let [sql (str "SELECT * FROM pages_history " +;; " WHERE page=? ORDER BY created_at DESC") +;; result (sc/fetch conn [sql (:id data)]) +;; item (first result)] - (let [sql (str "SELECT * FROM pages_history " - " WHERE page=? AND pinned = true " - " ORDER BY created_at DESC") - result (sc/fetch-one conn [sql (:id data)])] - (t/is (= "test" (:label result))) - (t/is (= true (:pinned result))))))) +;; (th/with-server {:handler @http/app} +;; (let [uri (str th/+base-url+ +;; "/api/pages/" (:id page) +;; "/history/" (:id item)) +;; params {:body {:label "test" :pinned true}} +;; [status data] (th/http-put user uri params)] +;; ;; (println "RESPONSE:" status data) +;; (t/is (= 200 status)) +;; (t/is (= (:id data) (:id item)))))) + +;; (let [sql (str "SELECT * FROM pages_history " +;; " WHERE page=? AND pinned = true " +;; " ORDER BY created_at DESC") +;; result (sc/fetch-one conn [sql (:id data)])] +;; (t/is (= "test" (:label result))) +;; (t/is (= true (:pinned result))))))) diff --git a/backend/test/uxbox/tests/test_projects.clj b/backend/test/uxbox/tests/test_projects.clj index d0c3d8b4a..b76acfd84 100644 --- a/backend/test/uxbox/tests/test_projects.clj +++ b/backend/test/uxbox/tests/test_projects.clj @@ -1,87 +1,63 @@ (ns uxbox.tests.test-projects - (:require [clojure.test :as t] - [promesa.core :as p] - [suricatta.core :as sc] - [clj-uuid :as uuid] - [uxbox.db :as db] - [uxbox.http :as http] - [uxbox.services.projects :as uspr] - [uxbox.services.pages :as uspg] - [uxbox.services :as usv] - [uxbox.tests.helpers :as th])) + (:require + [clojure.test :as t] + [promesa.core :as p] + [uxbox.db :as db] + [uxbox.http :as http] + [uxbox.services.core :as sv] + [uxbox.tests.helpers :as th])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) -(t/deftest test-http-project-list - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"})] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/projects") - [status data] (th/http-get user uri)] - (t/is (= 200 status)) - (t/is (= 1 (count data)))))))) +(t/deftest test-query-project-list + (let [user @(th/create-user db/pool 1) + proj @(th/create-project db/pool (:id user) 1) + data {::sv/type :projects + :user (:id user)} + [err rsp] (th/try-on (sv/query data))] + (t/is (nil? err)) + (t/is (= 1 (count rsp))) + (t/is (= (:id proj) (get-in rsp [0 :id]))) + (t/is (= (:name proj (get-in rsp [0 :name])))))) -(t/deftest test-http-project-create - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/projects") - params {:body {:name "proj1"}} - [status data] (th/http-post user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 201 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "proj1"))))))) +(t/deftest test-mutation-create-project + (let [user @(th/create-user db/pool 1) + data {::sv/type :create-project + :user (:id user) + :name "test project"} + [err rsp] (th/try-on (sv/mutation data))] + ;; (prn "RESPONSE:" err rsp) + (t/is (nil? err)) + (t/is (= (:user data) (:user-id rsp))) + (t/is (= (:name data) (:name rsp))))) -(t/deftest test-http-project-update - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"})] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/projects/" (:id proj)) - params {:body (assoc proj :name "proj2")} - [status data] (th/http-put user uri params)] - ;; (prn "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:user data) (:id user))) - (t/is (= (:name data) "proj2"))))))) +(t/deftest test-mutation-update-project + (let [user @(th/create-user db/pool 1) + proj @(th/create-project db/pool (:id user) 1) + data {::sv/type :update-project + :id (:id proj) + :name "test project mod" + :user (:id user)} + [err rsp] (th/try-on (sv/mutation data))] + ;; (prn "RESPONSE:" err rsp) + (t/is (nil? err)) + (t/is (= (:id data) (:id rsp))) + (t/is (= (:user data) (:user-id rsp))) + (t/is (= (:name data) (:name rsp))))) -(t/deftest test-http-project-delete - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"})] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/projects/" (:id proj)) - [status data] (th/http-delete user uri)] - ;; (prn "RESPONSE:" status data) - (t/is (= 204 status)) - (let [sqlv ["SELECT * FROM projects WHERE \"user\"=? AND deleted_at is null" - (:id user)] - result (sc/fetch conn sqlv)] - (t/is (empty? result)))))))) +(t/deftest test-mutation-delete-project + (let [user @(th/create-user db/pool 1) + proj @(th/create-project db/pool (:id user) 1) + data {::sv/type :delete-project + :id (:id proj) + :user (:id user)} + [err rsp] (th/try-on (sv/mutation data))] + ;; (prn "RESPONSE:" err rsp) + (t/is (nil? err)) + (t/is (nil? rsp)) -(t/deftest test-http-project-retrieve-by-share-token - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1) - proj (uspr/create-project conn {:user (:id user) :name "proj1"}) - page (uspg/create-page conn {:id (uuid/v4) - :user (:id user) - :project (:id proj) - :version 0 - :data "1" - :options "2" - :name "page1" - :width 200 - :height 200 - :layout "mobil"}) - shares (uspr/get-share-tokens-for-project conn (:id proj))] - (th/with-server {:handler @http/app} - (let [token (:token (first shares)) - uri (str th/+base-url+ "/api/projects/by-token/" token) - [status data] (th/http-get user uri)] - ;; (println "RESPONSE:" status data) - (t/is (= status 200)) - (t/is (vector? (:pages data))) - (t/is (= 1 (count (:pages data))))))))) + (let [sql "SELECT * FROM projects + WHERE user_id=$1 AND deleted_at is null" + res @(db/query db/pool [sql (:id user)])] + (t/is (empty? res))))) diff --git a/backend/test/uxbox/tests/test_svgparse.clj b/backend/test/uxbox/tests/test_svgparse.clj index 44cf42147..40e719b55 100644 --- a/backend/test/uxbox/tests/test_svgparse.clj +++ b/backend/test/uxbox/tests/test_svgparse.clj @@ -1,90 +1,90 @@ (ns uxbox.tests.test-svgparse - (:require [clojure.test :as t] + #_(:require [clojure.test :as t] [clojure.java.io :as io] [uxbox.http :as http] [uxbox.services :as usv] [uxbox.services.svgparse :as svg] [uxbox.tests.helpers :as th])) -(t/use-fixtures :once th/state-init) +;; (t/use-fixtures :once th/state-init) -(t/deftest parse-svg-test - (t/testing "parsing valid svg 1" - (let [image (slurp (io/resource "uxbox/tests/_files/sample1.svg")) - result (svg/parse-string image)] - (t/is (contains? result :width)) - (t/is (contains? result :height)) - (t/is (contains? result :view-box)) - (t/is (contains? result :name)) - (t/is (contains? result :content)) - (t/is (= 500.0 (:width result))) - (t/is (= 500.0 (:height result))) - (t/is (= [0.0 0.0 500.00001 500.00001] (:view-box result))) - (t/is (= "lock.svg" (:name result))))) +;; (t/deftest parse-svg-test +;; (t/testing "parsing valid svg 1" +;; (let [image (slurp (io/resource "uxbox/tests/_files/sample1.svg")) +;; result (svg/parse-string image)] +;; (t/is (contains? result :width)) +;; (t/is (contains? result :height)) +;; (t/is (contains? result :view-box)) +;; (t/is (contains? result :name)) +;; (t/is (contains? result :content)) +;; (t/is (= 500.0 (:width result))) +;; (t/is (= 500.0 (:height result))) +;; (t/is (= [0.0 0.0 500.00001 500.00001] (:view-box result))) +;; (t/is (= "lock.svg" (:name result))))) - (t/testing "parsing valid svg 2" - (let [image (slurp (io/resource "uxbox/tests/_files/sample2.svg")) - result (svg/parse-string image)] - (t/is (contains? result :width)) - (t/is (contains? result :height)) - (t/is (contains? result :view-box)) - (t/is (contains? result :name)) - (t/is (contains? result :content)) - (t/is (= 500.0 (:width result))) - (t/is (= 500.0 (:height result))) - (t/is (= [0.0 0.0 500.0 500.00001] (:view-box result))) - (t/is (= "play.svg" (:name result))))) +;; (t/testing "parsing valid svg 2" +;; (let [image (slurp (io/resource "uxbox/tests/_files/sample2.svg")) +;; result (svg/parse-string image)] +;; (t/is (contains? result :width)) +;; (t/is (contains? result :height)) +;; (t/is (contains? result :view-box)) +;; (t/is (contains? result :name)) +;; (t/is (contains? result :content)) +;; (t/is (= 500.0 (:width result))) +;; (t/is (= 500.0 (:height result))) +;; (t/is (= [0.0 0.0 500.0 500.00001] (:view-box result))) +;; (t/is (= "play.svg" (:name result))))) - (t/testing "parsing invalid data 1" - (let [image (slurp (io/resource "uxbox/tests/_files/sample.jpg")) - [e result] (th/try-on (svg/parse-string image))] - (t/is (th/exception? e)) - (t/is (th/ex-info? e)) - (t/is (th/ex-with-code? e :uxbox.services.svgparse/invalid-input)))) +;; (t/testing "parsing invalid data 1" +;; (let [image (slurp (io/resource "uxbox/tests/_files/sample.jpg")) +;; [e result] (th/try-on (svg/parse-string image))] +;; (t/is (th/exception? e)) +;; (t/is (th/ex-info? e)) +;; (t/is (th/ex-with-code? e :uxbox.services.svgparse/invalid-input)))) - (t/testing "parsing invalid data 2" - (let [[e result] (th/try-on (svg/parse-string ""))] - (t/is (th/exception? e)) - (t/is (th/ex-info? e)) - (t/is (th/ex-with-code? e :uxbox.services.svgparse/invalid-input)))) +;; (t/testing "parsing invalid data 2" +;; (let [[e result] (th/try-on (svg/parse-string ""))] +;; (t/is (th/exception? e)) +;; (t/is (th/ex-info? e)) +;; (t/is (th/ex-with-code? e :uxbox.services.svgparse/invalid-input)))) - (t/testing "parsing invalid data 3" - (let [[e result] (th/try-on (svg/parse-string ""))] - (t/is (th/exception? e)) - (t/is (th/ex-info? e)) - (t/is (th/ex-with-code? e :uxbox.services.svgparse/invalid-result)))) +;; (t/testing "parsing invalid data 3" +;; (let [[e result] (th/try-on (svg/parse-string ""))] +;; (t/is (th/exception? e)) +;; (t/is (th/ex-info? e)) +;; (t/is (th/ex-with-code? e :uxbox.services.svgparse/invalid-result)))) - ;; (t/testing "valid http request" - ;; (with-open [conn (db/connection)] - ;; (let [image (slurp (io/resource "uxbox/tests/_files/sample2.svg")) - ;; path "/api/svg/parse" - ;; user (th/create-user conn 1)] - ;; (th/with-server {:handler @http/app} - ;; (let [rsp (th/request {:method :post - ;; :path path - ;; :body image - ;; :raw? true})] - ;; (t/is (= 200 (:status rsp))) - ;; (prn "RESPONSE" rsp) - ;; ;; (t/is (contains? (:body rsp) :width)) - ;; ;; (t/is (contains? (:body rsp) :height)) - ;; ;; (t/is (contains? (:body rsp) :view-box)) - ;; ;; (t/is (contains? (:body rsp) :name)) - ;; ;; (t/is (contains? (:body rsp) :content)) - ;; ;; (t/is (= 500.0 (:width (:body rsp)))) - ;; #_(t/is (= 500.0 (:height (:body rsp)))) - ;; #_(t/is (= [0.0 0.0 500.0 500.00001] (:view-box (:body rsp)))) - ;; #_(t/is (= "play.svg" (:name (:body rsp)))))))) +;; ;; (t/testing "valid http request" +;; ;; (with-open [conn (db/connection)] +;; ;; (let [image (slurp (io/resource "uxbox/tests/_files/sample2.svg")) +;; ;; path "/api/svg/parse" +;; ;; user (th/create-user conn 1)] +;; ;; (th/with-server {:handler @http/app} +;; ;; (let [rsp (th/request {:method :post +;; ;; :path path +;; ;; :body image +;; ;; :raw? true})] +;; ;; (t/is (= 200 (:status rsp))) +;; ;; (prn "RESPONSE" rsp) +;; ;; ;; (t/is (contains? (:body rsp) :width)) +;; ;; ;; (t/is (contains? (:body rsp) :height)) +;; ;; ;; (t/is (contains? (:body rsp) :view-box)) +;; ;; ;; (t/is (contains? (:body rsp) :name)) +;; ;; ;; (t/is (contains? (:body rsp) :content)) +;; ;; ;; (t/is (= 500.0 (:width (:body rsp)))) +;; ;; #_(t/is (= 500.0 (:height (:body rsp)))) +;; ;; #_(t/is (= [0.0 0.0 500.0 500.00001] (:view-box (:body rsp)))) +;; ;; #_(t/is (= "play.svg" (:name (:body rsp)))))))) - ;; (t/testing "invalid http request" - ;; (let [path "/api/svg/parse" - ;; image ""] - ;; (with-server {:handler (uft/routes)} - ;; (let [rsp (th/request {:method :post - ;; :path path - ;; :body image - ;; :raw? true})] - ;; (t/is (= 400 (:status rsp))) - ;; (t/is (= :validation (get-in rsp [:body :type]))) - ;; (t/is (= ::svg/invalid-result (get-in rsp [:body :code]))))))) - ) +;; ;; (t/testing "invalid http request" +;; ;; (let [path "/api/svg/parse" +;; ;; image ""] +;; ;; (with-server {:handler (uft/routes)} +;; ;; (let [rsp (th/request {:method :post +;; ;; :path path +;; ;; :body image +;; ;; :raw? true})] +;; ;; (t/is (= 400 (:status rsp))) +;; ;; (t/is (= :validation (get-in rsp [:body :type]))) +;; ;; (t/is (= ::svg/invalid-result (get-in rsp [:body :code]))))))) +;; ) diff --git a/backend/test/uxbox/tests/test_txlog.clj b/backend/test/uxbox/tests/test_txlog.clj deleted file mode 100644 index c2c2971dc..000000000 --- a/backend/test/uxbox/tests/test_txlog.clj +++ /dev/null @@ -1,19 +0,0 @@ -(ns uxbox.tests.test-txlog - "A txlog and services abstraction generic tests." - (:require [clojure.test :as t] - [promesa.core :as p] - [uxbox.services.core :as usc] - [uxbox.services :as usv] - [uxbox.tests.helpers :as th])) - -;; (t/use-fixtures :each th/database-reset) - -;; (defmethod usc/novelty ::testype1 -;; [data] -;; true) - -;; (t/deftest txlog-spec1 -;; (let [data {:type ::testype1 :foo 1 :bar "baz"} -;; response (usv/novelty data)] -;; (t/is (p/promise? response)) -;; (t/is (= true @response)))) diff --git a/backend/test/uxbox/tests/test_users.clj b/backend/test/uxbox/tests/test_users.clj index c2ffb451f..c09900a8a 100644 --- a/backend/test/uxbox/tests/test_users.clj +++ b/backend/test/uxbox/tests/test_users.clj @@ -1,119 +1,116 @@ (ns uxbox.tests.test-users - (:require [clojure.test :as t] - [clojure.java.io :as io] - [promesa.core :as p] - [buddy.hashers :as hashers] - [suricatta.core :as sc] - [uxbox.db :as db] - [uxbox.http :as http] - [uxbox.services.users :as usu] - [uxbox.services :as usv] - [uxbox.tests.helpers :as th])) + (:require + [clojure.test :as t] + [clojure.java.io :as io] + [promesa.core :as p] + [cuerdas.core :as str] + [datoteka.core :as fs] + ;; [buddy.hashers :as hashers] + [vertx.core :as vc] + [uxbox.db :as db] + [uxbox.services.core :as sv] + [uxbox.tests.helpers :as th])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) -(t/deftest test-http-retrieve-profile - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/profile/me") - [status data] (th/http-get user uri)] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:fullname data) "User 1")) - (t/is (= (:username data) "user1")) - (t/is (= (:metadata data) "1")) - (t/is (= (:email data) "user1@uxbox.io")) - (t/is (not (contains? data :password)))))))) +(t/deftest test-query-profile + (let [user @(th/create-user db/pool 1) + event {::sv/type :profile + :user (:id user)} + [err rsp] (th/try-on (sv/query event))] + ;; (println "RESPONSE:" resp))) + (t/is (nil? err)) + (t/is (= (:fullname rsp) "User 1")) + (t/is (= (:username rsp) "user1")) + (t/is (= (:metadata rsp) {})) + (t/is (= (:email rsp) "user1.test@uxbox.io")) + (t/is (not (contains? rsp :password))))) -(t/deftest test-http-update-profile - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/profile/me") - data (assoc user - :fullname "Full Name" - :username "user222" - :metadata "222" - :email "user222@uxbox.io") - [status data] (th/http-put user uri {:body data})] - ;; (println "RESPONSE:" status data) - (t/is (= 200 status)) - (t/is (= (:fullname data) "Full Name")) - (t/is (= (:username data) "user222")) - (t/is (= (:metadata data) "222")) - (t/is (= (:email data) "user222@uxbox.io")) - (t/is (not (contains? data :password)))))))) +(t/deftest test-mutation-update-profile + (let [user @(th/create-user db/pool 1) + event (assoc user + ::sv/type :update-profile + :fullname "Full Name" + :username "user222" + :metadata {:foo "bar"} + :email "user222@uxbox.io") + [err data] (th/try-on (sv/mutation event))] + ;; (println "RESPONSE:" err data) + (t/is (nil? err)) + (t/is (= (:fullname data) "Full Name")) + (t/is (= (:username data) "user222")) + (t/is (= (:metadata data) {:foo "bar"})) + (t/is (= (:email data) "user222@uxbox.io")) + (t/is (not (contains? data :password))))) -(t/deftest test-http-update-profile-photo - (with-open [conn (db/connection)] - (let [user (th/create-user conn 1)] - (th/with-server {:handler @http/app} - (let [uri (str th/+base-url+ "/api/profile/me/photo") - params [{:name "sample.jpg" - :part-name "file" - :content (io/input-stream - (io/resource "uxbox/tests/_files/sample.jpg"))}] - [status data] (th/http-multipart user uri params)] - ;; (println "RESPONSE:" status data) - (t/is (= 204 status))))))) +(t/deftest test-mutation-update-profile-photo + (let [user @(th/create-user db/pool 1) + event {::sv/type :update-profile-photo + :user (:id user) + :file {:name "sample.jpg" + :path (fs/path "test/uxbox/tests/_files/sample.jpg") + :size 123123 + :mtype "image/jpeg"}} + [err rsp] (th/try-on (sv/mutation event))] + ;; (prn "RESPONSE:" [err rsp]) + (t/is (nil? err)) + (t/is (= (:id user) (:id rsp))) + (t/is (str/starts-with? (:photo rsp) "http")))) -;; (t/deftest test-http-register-user -;; (with-server {:handler (uft/routes)} -;; (let [uri (str th/+base-url+ "/api/auth/register") -;; data {:fullname "Full Name" -;; :username "user222" -;; :email "user222@uxbox.io" -;; :password "user222"} -;; [status data] (th/http-post uri {:body data})] -;; ;; (println "RESPONSE:" status data) -;; (t/is (= 200 status))))) +;; (t/deftest test-mutation-register-profile +;; (let[data {:fullname "Full Name" +;; :username "user222" +;; :email "user222@uxbox.io" +;; :password "user222" +;; ::sv/type :register-profile} +;; [err rsp] (th/try-on (sv/mutation data))] +;; (println "RESPONSE:" err rsp))) -;; (t/deftest test-http-validate-recovery-token -;; (with-open [conn (db/connection)] -;; (let [user (th/create-user conn 1)] -;; (with-server {:handler (uft/routes)} -;; (let [token (#'usu/request-password-recovery conn "user1") -;; uri1 (str th/+base-url+ "/api/auth/recovery/not-existing") -;; uri2 (str th/+base-url+ "/api/auth/recovery/" token) -;; [status1 data1] (th/http-get user uri1) -;; [status2 data2] (th/http-get user uri2)] -;; ;; (println "RESPONSE:" status1 data1) -;; ;; (println "RESPONSE:" status2 data2) -;; (t/is (= 404 status1)) -;; (t/is (= 204 status2))))))) +;; ;; (t/deftest test-http-validate-recovery-token +;; ;; (with-open [conn (db/connection)] +;; ;; (let [user (th/create-user conn 1)] +;; ;; (with-server {:handler (uft/routes)} +;; ;; (let [token (#'usu/request-password-recovery conn "user1") +;; ;; uri1 (str th/+base-url+ "/api/auth/recovery/not-existing") +;; ;; uri2 (str th/+base-url+ "/api/auth/recovery/" token) +;; ;; [status1 data1] (th/http-get user uri1) +;; ;; [status2 data2] (th/http-get user uri2)] +;; ;; ;; (println "RESPONSE:" status1 data1) +;; ;; ;; (println "RESPONSE:" status2 data2) +;; ;; (t/is (= 404 status1)) +;; ;; (t/is (= 204 status2))))))) -;; (t/deftest test-http-request-password-recovery -;; (with-open [conn (db/connection)] -;; (let [user (th/create-user conn 1) -;; sql "select * from user_pswd_recovery" -;; res (sc/fetch-one conn sql)] +;; ;; (t/deftest test-http-request-password-recovery +;; ;; (with-open [conn (db/connection)] +;; ;; (let [user (th/create-user conn 1) +;; ;; sql "select * from user_pswd_recovery" +;; ;; res (sc/fetch-one conn sql)] -;; ;; Initially no tokens exists -;; (t/is (nil? res)) +;; ;; ;; Initially no tokens exists +;; ;; (t/is (nil? res)) -;; (with-server {:handler (uft/routes)} -;; (let [uri (str th/+base-url+ "/api/auth/recovery") -;; data {:username "user1"} -;; [status data] (th/http-post user uri {:body data})] -;; ;; (println "RESPONSE:" status data) -;; (t/is (= 204 status))) +;; ;; (with-server {:handler (uft/routes)} +;; ;; (let [uri (str th/+base-url+ "/api/auth/recovery") +;; ;; data {:username "user1"} +;; ;; [status data] (th/http-post user uri {:body data})] +;; ;; ;; (println "RESPONSE:" status data) +;; ;; (t/is (= 204 status))) -;; (let [res (sc/fetch-one conn sql)] -;; (t/is (not (nil? res))) -;; (t/is (= (:user res) (:id user)))))))) +;; ;; (let [res (sc/fetch-one conn sql)] +;; ;; (t/is (not (nil? res))) +;; ;; (t/is (= (:user res) (:id user)))))))) -;; (t/deftest test-http-validate-recovery-token -;; (with-open [conn (db/connection)] -;; (let [user (th/create-user conn 1)] -;; (with-server {:handler (uft/routes)} -;; (let [token (#'usu/request-password-recovery conn (:username user)) -;; uri (str th/+base-url+ "/api/auth/recovery") -;; data {:token token :password "mytestpassword"} -;; [status data] (th/http-put user uri {:body data}) +;; ;; (t/deftest test-http-validate-recovery-token +;; ;; (with-open [conn (db/connection)] +;; ;; (let [user (th/create-user conn 1)] +;; ;; (with-server {:handler (uft/routes)} +;; ;; (let [token (#'usu/request-password-recovery conn (:username user)) +;; ;; uri (str th/+base-url+ "/api/auth/recovery") +;; ;; data {:token token :password "mytestpassword"} +;; ;; [status data] (th/http-put user uri {:body data}) -;; user' (usu/find-full-user-by-id conn (:id user))] -;; (t/is (= status 204)) -;; (t/is (hashers/check "mytestpassword" (:password user')))))))) +;; ;; user' (usu/find-full-user-by-id conn (:id user))] +;; ;; (t/is (= status 204)) +;; ;; (t/is (hashers/check "mytestpassword" (:password user')))))))) diff --git a/backend/vendor/executors/core.clj b/backend/vendor/executors/core.clj deleted file mode 100644 index 4bffc365b..000000000 --- a/backend/vendor/executors/core.clj +++ /dev/null @@ -1,176 +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 - -(ns executors.core - "A executos service abstraction layer." - (:import java.util.function.Supplier - java.util.concurrent.ForkJoinPool - java.util.concurrent.Future - java.util.concurrent.CompletableFuture - java.util.concurrent.ExecutorService - java.util.concurrent.TimeoutException - java.util.concurrent.ThreadFactory - java.util.concurrent.TimeUnit - java.util.concurrent.ScheduledExecutorService - java.util.concurrent.Executors)) - -(def ^:const +max-priority+ Thread/MAX_PRIORITY) -(def ^:const +min-priority+ Thread/MIN_PRIORITY) -(def ^:const +norm-priority+ Thread/NORM_PRIORITY) - -;; --- Protocols - -(defprotocol IExecutor - (^:private -execute [_ task] "Execute a task in a executor.") - (^:private -submit [_ task] "Submit a task and return a promise.")) - -(defprotocol IScheduledExecutor - (^:provate -schedule [_ ms task] "Schedule a task to execute in a future.")) - -(defprotocol IScheduledTask - "A cancellation abstraction." - (-cancel [_]) - (-cancelled? [_])) - -;; --- Implementation - -(defn- thread-factory-adapter - "Adapt a simple clojure function into a - ThreadFactory instance." - [func] - (reify ThreadFactory - (^Thread newThread [_ ^Runnable runnable] - (func runnable)))) - -(defn- thread-factory - [{:keys [daemon priority] - :or {daemon true - priority Thread/NORM_PRIORITY}}] - (thread-factory-adapter - (fn [runnable] - (let [thread (Thread. ^Runnable runnable)] - (.setDaemon thread daemon) - (.setPriority thread priority) - thread)))) - -(defn- resolve-thread-factory - [opts] - (cond - (map? opts) (thread-factory opts) - (fn? opts) (thread-factory-adapter opts) - (instance? ThreadFactory opts) opts - :else (throw (ex-info "Invalid thread factory" {})))) - -(deftype ScheduledTask [^Future fut] - clojure.lang.IDeref - (deref [_] - (.get fut)) - - clojure.lang.IBlockingDeref - (deref [_ ms default] - (try - (.get fut ms TimeUnit/MILLISECONDS) - (catch TimeoutException e - default))) - - clojure.lang.IPending - (isRealized [_] (and (.isDone fut) - (not (.isCancelled fut)))) - - IScheduledTask - (-cancelled? [_] - (.isCancelled fut)) - - (-cancel [_] - (when-not (.isCancelled fut) - (.cancel fut true)))) - -(extend-type ExecutorService - IExecutor - (-execute [this task] - (CompletableFuture/runAsync ^Runnable task this)) - - (-submit [this task] - (let [supplier (reify Supplier (get [_] (task)))] - (CompletableFuture/supplyAsync supplier this)))) - -(extend-type ScheduledExecutorService - IScheduledExecutor - (-schedule [this ms func] - (let [fut (.schedule this func ms TimeUnit/MILLISECONDS)] - (ScheduledTask. fut)))) - -;; --- Public Api (Pool Constructors) - -(defn common-pool - "Get the common pool." - [] - (ForkJoinPool/commonPool)) - -(defn cached - "A cached thread pool constructor." - ([] - (Executors/newCachedThreadPool)) - ([opts] - (let [factory (resolve-thread-factory opts)] - (Executors/newCachedThreadPool factory)))) - -(defn fixed - "A fixed thread pool constructor." - ([n] - (Executors/newFixedThreadPool (int n))) - ([n opts] - (let [factory (resolve-thread-factory opts)] - (Executors/newFixedThreadPool (int n) factory)))) - -(defn single-thread - "A single thread pool constructor." - ([] - (Executors/newSingleThreadExecutor)) - ([opts] - (let [factory (resolve-thread-factory opts)] - (Executors/newSingleThreadExecutor factory)))) - -(defn scheduled - "A scheduled thread pool constructo." - ([] (Executors/newScheduledThreadPool (int 1))) - ([n] (Executors/newScheduledThreadPool (int n))) - ([n opts] - (let [factory (resolve-thread-factory opts)] - (Executors/newScheduledThreadPool (int n) factory)))) - -;; --- Public Api (Task Execution) - -(defn execute - "Execute a task in a provided executor. - - A task is a plain clojure function or - jvm Runnable instance." - ([task] - (-> (common-pool) - (-execute task))) - ([executor task] - (-execute executor task))) - -(defn submit - "Submit a task to be executed in a provided executor - and return a promise that will be completed with - the return value of a task. - - A task is a plain clojure function." - ([task] - (-> (common-pool) - (-submit task))) - ([executor task] - (-submit executor task))) - -(defn schedule - "Schedule task exection for some time in the future." - ([ms task] - (-> (common-pool) - (-schedule ms task))) - ([executor ms task] - (-schedule executor ms task))) diff --git a/backend/vendor/migrante/core.clj b/backend/vendor/migrante/core.clj deleted file mode 100644 index 51d0beb9a..000000000 --- a/backend/vendor/migrante/core.clj +++ /dev/null @@ -1,218 +0,0 @@ -(ns migrante.core - (:require [suricatta.core :as sc] - [suricatta.proto :as sp] - [cuerdas.core :as str] - [clojure.java.io :as io])) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Private Api: Helpers -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(def ^:dynamic *verbose* false) -(def ^:dynamic *ctx* nil) - -(defmacro ^:private log - "A simple sugar syntax helper for log information - into the standard output." - [& args] - `(when *verbose* - (println ~@args))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Private Api: Implementation -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn- migration-registered? - "Check if concrete migration is already registred." - ([conn module step] - {:pre [(keyword? module) (keyword? step)]} - (let [sql (str "select * from migrations" - " where module=? and step=?") - res (sc/fetch conn [sql (name module) (name step)])] - (pos? (count res))))) - -(defn- register-migration! - "Register a concrete migration into local migrations database." - ([conn module step] - {:pre [(keyword? module) (keyword? step)]} - (let [sql "insert into migrations (module, step) values (?, ?)"] - (sc/execute conn [sql (name module) (name step)])))) - -(defn- unregister-migration! - "Unregister a concrete migration from local migrations database." - ([conn module step] - {:pre [(keyword? module) (keyword? step)]} - (let [sql "delete from migrations where module=? and step=?;"] - (sc/execute conn [sql (name module) (name step)])))) - -(defn- setup! - "Initialize the database if it is not initialized." - [conn] - (let [sql (str "create table if not exists migrations (" - " module text," - " step text," - " created_at timestamp DEFAULT current_timestamp," - " unique(module, step)" - ");")] - (sc/execute conn sql))) - -(defprotocol IMigration - "Define a migration step behavior on up and down - migration actons." - (-name [_] "Return the migration name") - (-desc [_] "Return the migration desc") - (-run-up [_ _] "Run function in migrate process.") - (-run-down [_ _] "Run function in rollback process.")) - -(deftype Migration [name desc up down]) - -(extend-protocol IMigration - Migration - (-run-up [step conn] - (let [upfn (.-up step)] - (binding [*ctx* conn] - (upfn)))) - (-run-down [step conn] - (if-let [downfn (.-down step)] - (binding [*ctx* conn] - (downfn)))) - (-name [step] - (str/collapse-whitespace - (.-name step))) - (-desc [step] - (str/collapse-whitespace - (.-desc step)))) - -(defn- do-migrate - [conn migration {:keys [until fake] :or {fake false}}] - (let [mid (:name migration) - steps (:steps migration)] - (log (str/format "Applying migrations for `%s`:" mid)) - (sc/atomic conn - (run! (fn [[sid sdata]] - (when-not (migration-registered? conn mid sid) - (log (format "- %s - %s - %s" sid (-name sdata) - (str/prune (-desc sdata) 70))) - (sc/atomic conn - (when (not fake) - (-run-up sdata conn)) - (register-migration! conn mid sid))) - (when (= until sid) - (reduced nil))) - steps)) - (log "\n"))) - -(defn- do-rollback - [conn migration {:keys [until fake] :or {fake false}}] - (let [mid (:name migration) - steps (reverse (:steps migration))] - (sc/atomic conn - (run! (fn [[sid sdata]] - (when (migration-registered? conn mid sid) - (log (format "- Rollback migration %s/%s (%s - %s)" - mid sid (-name sdata) (-desc sdata))) - (sc/atomic conn - (when (not fake) - (-run-down sdata conn)) - (unregister-migration! conn mid sid))) - (when (= until sid) - (reduced nil))) - steps)))) - -(defn- normalize-to-connection - [dbspec] - (if (satisfies? sp/IContextHolder dbspec) - dbspec - (sc/context dbspec))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Public Api -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn execute - "Execute a query and return a number of rows affected." - [q] - (sc/execute *ctx* q)) - -(defn fetch - "Fetch eagerly results executing a query. - - This function returns a vector of records (default) or - rows (depending on specified opts). Resources are relased - inmediatelly without specific explicit action for it." - ([q] - (sc/fetch *ctx* q)) - ([q opts] - (sc/fetch *ctx* q opts))) - -(defprotocol IMigrationContext - (-migrate [_ migration options]) - (-rollback [_ migration options]) - (-registered? [_ module step])) - -(defn context - "Create new instance of migration context." - ([conn] (context conn nil)) - ([conn {:keys [verbose] :or {verbose true}}] - (let [conn (normalize-to-connection conn)] - (setup! conn) - (reify - java.lang.AutoCloseable - (close [_] (.close conn)) - - IMigrationContext - (-migrate [_ migration options] - (sc/atomic conn - (binding [*verbose* verbose] - (do-migrate conn migration options)))) - - (-rollback [_ migration options] - (sc/atomic conn - (binding [*verbose* verbose] - (do-rollback conn migration options)))) - (-registered? [_ module step] - (migration-registered? conn module step)))))) - -(defn migrate - "Main entry point for apply a migration." - ([mctx migration] - (migrate mctx migration nil)) - ([mctx migration options] - (-migrate mctx migration options))) - -(defn rollback - "Main entry point for apply a migration." - ([mctx migration] - (rollback mctx migration nil)) - ([mctx migration options] - (-rollback mctx migration options))) - -(defn registered? - [mctx module step] - (-registered? mctx module step)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; Sugar Syntax -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defmacro defmigration - [sym & [docs & args]] - (let [{:keys [up down]} (if (string? docs) - (apply hash-map args) - (apply hash-map docs args)) - docs (if (string? docs) docs "") - mname (name sym)] - `(def ~sym - ~docs - (->Migration ~mname ~docs - (or ~up identity) - (or ~down identity))))) - -(defmacro resource - "Helper for setup migration functions - just using a simple path to sql file - located in the class path." - [path] - `(fn [] - (let [sql# (slurp (io/resource ~path))] - (execute sql#)))) diff --git a/docker/devenv/docker-compose.yaml b/docker/devenv/docker-compose.yaml index d510a8041..a567ab910 100644 --- a/docker/devenv/docker-compose.yaml +++ b/docker/devenv/docker-compose.yaml @@ -34,7 +34,7 @@ services: environment: - UXBOX_HTTP_SERVER_DEBUG=false - - UXBOX_DATABASE_URI="jdbc:postgresql://postgres/uxbox" + - UXBOX_DATABASE_URI="postgresql://postgres/uxbox" - UXBOX_DATABASE_USERNAME="uxbox" - UXBOX_DATABASE_PASSWORD="uxbox" diff --git a/frontend/deps.edn b/frontend/deps.edn index b65ee9300..fd83e8560 100644 --- a/frontend/deps.edn +++ b/frontend/deps.edn @@ -6,6 +6,7 @@ environ/environ {:mvn/version "1.1.0"} metosin/reitit-core {:mvn/version "0.3.10"} + expound/expound {:mvn/version "0.7.2"} funcool/beicon {:mvn/version "5.1.0"} funcool/cuerdas {:mvn/version "2.2.0"} diff --git a/frontend/src/uxbox/main/data/colors.cljs b/frontend/src/uxbox/main/data/colors.cljs index a564ca2f2..8b2785539 100644 --- a/frontend/src/uxbox/main/data/colors.cljs +++ b/frontend/src/uxbox/main/data/colors.cljs @@ -9,7 +9,7 @@ [beicon.core :as rx] [clojure.set :as set] [potok.core :as ptk] - [uxbox.main.repo :as rp] + [uxbox.main.repo.core :as rp] [uxbox.main.store :as st] [uxbox.util.color :as color] [uxbox.util.i18n :refer [tr]] @@ -56,9 +56,12 @@ (defrecord FetchCollections [] ptk/WatchEvent (watch [_ state s] - (->> (rp/req :fetch/kvstore "color-collections") - (rx/map :payload) - (rx/map collections-fetched)))) + (->> (rp/query! :kvstore-entry {:key "color-collections"}) + (rx/map collections-fetched) + (rx/catch (fn [{:keys [type] :as error}] + (if (= type :not-found) + (rx/empty) + (rx/throw error))))))) (defn fetch-collections [] @@ -99,8 +102,7 @@ data {:id "color-collections" :version version :value value}] - (->> (rp/req :update/kvstore data) - (rx/map :payload) + (->> (rp/mutation! :upsert-kvstore data) (rx/map collections-fetched))))) (defn persist-collections diff --git a/frontend/src/uxbox/main/data/icons.cljs b/frontend/src/uxbox/main/data/icons.cljs index c2e9d5fa4..4c7b3e59d 100644 --- a/frontend/src/uxbox/main/data/icons.cljs +++ b/frontend/src/uxbox/main/data/icons.cljs @@ -5,17 +5,18 @@ ;; Copyright (c) 2016 Andrey Antukh (ns uxbox.main.data.icons - (:require [cuerdas.core :as str] - [beicon.core :as rx] - [uxbox.util.data :refer (jscoll->vec)] - [uxbox.util.uuid :as uuid] - [potok.core :as ptk] - [uxbox.util.i18n :refer [tr]] - [uxbox.util.router :as r] - [uxbox.util.dom :as dom] - [uxbox.util.files :as files] - [uxbox.main.store :as st] - [uxbox.main.repo :as rp])) + (:require + [beicon.core :as rx] + [cuerdas.core :as str] + [potok.core :as ptk] + [uxbox.main.repo.core :as rp] + [uxbox.main.store :as st] + [uxbox.util.data :refer (jscoll->vec)] + [uxbox.util.dom :as dom] + [uxbox.util.files :as files] + [uxbox.util.i18n :refer [tr]] + [uxbox.util.router :as r] + [uxbox.util.uuid :as uuid])) ;; --- Initialize @@ -67,8 +68,7 @@ (defrecord FetchCollections [] ptk/WatchEvent (watch [_ state s] - (->> (rp/req :fetch/icon-collections) - (rx/map :payload) + (->> (rp/query! :icons-collections) (rx/map collections-fetched)))) (defn fetch-collections @@ -97,9 +97,8 @@ ptk/WatchEvent (watch [_ state s] (let [name (tr "ds.default-library-title" (gensym "c")) - coll {:name name}] - (->> (rp/req :create/icon-collection coll) - (rx/map :payload) + data {:name name}] + (->> (rp/mutation! :create-icons-collection data) (rx/map collection-created))))) (defn create-collection @@ -126,9 +125,8 @@ (defrecord UpdateCollection [id] ptk/WatchEvent (watch [_ state s] - (let [item (get-in state [:icons-collections id])] - (->> (rp/req :update/icon-collection item) - (rx/map :payload) + (let [data (get-in state [:icons-collections id])] + (->> (rp/mutation! :update-icons-collection data) (rx/map collection-updated))))) (defn update-collection @@ -160,7 +158,7 @@ ptk/WatchEvent (watch [_ state s] (let [type (get-in state [:dashboard :icons :type])] - (->> (rp/req :delete/icon-collection id) + (->> (rp/mutation! :delete-icons-collection {:id id}) (rx/map #(select-collection type)))))) (defn delete-collection @@ -219,7 +217,7 @@ (allowed? [file] (= (.-type file) "image/svg+xml")) (prepare [[content metadata]] - {:collection id + {:collection-id id :content content :id (uuid/random) ;; TODO Keep the name of the original icon @@ -229,7 +227,7 @@ (rx/filter allowed?) (rx/flat-map parse) (rx/map prepare) - (rx/flat-map #(rp/req :create/icon %)) + (rx/flat-map #(rp/mutation! :create-icon %)) (rx/map :payload) (rx/map icon-created))))) @@ -255,9 +253,8 @@ (defrecord PersistIcon [id] ptk/WatchEvent (watch [_ state stream] - (let [icon (get-in state [:icons id])] - (->> (rp/req :update/icon icon) - (rx/map :payload) + (let [data (get-in state [:icons id])] + (->> (rp/mutation! :update-icon data) (rx/map icon-persisted))))) (defn persist-icon @@ -285,9 +282,8 @@ (defrecord FetchIcons [id] ptk/WatchEvent (watch [_ state s] - (let [params {:coll id}] - (->> (rp/req :fetch/icons params) - (rx/map :payload) + (let [params (cond-> {} id (assoc :collection-id id))] + (->> (rp/query! :icons-by-collection params) (rx/map icons-fetched))))) (defn fetch-icons @@ -306,7 +302,7 @@ ptk/WatchEvent (watch [_ state s] - (->> (rp/req :delete/icon id) + (->> (rp/mutation! :delete-icon {:id id}) (rx/ignore)))) (defn delete-icon @@ -370,8 +366,8 @@ (->> (rx/from-coll selected) (rx/map #(get-in state [:icons %])) (rx/map #(dissoc % :id)) - (rx/map #(assoc % :collection id)) - (rx/flat-map #(rp/req :create/icon %)) + (rx/map #(assoc % :collection-id id)) + (rx/flat-map #(rp/mutation :create-icon %)) (rx/map :payload) (rx/map icon-created)) (->> (rx/from-coll selected) diff --git a/frontend/src/uxbox/main/data/images.cljs b/frontend/src/uxbox/main/data/images.cljs index 68bbcaf06..06d6cbd87 100644 --- a/frontend/src/uxbox/main/data/images.cljs +++ b/frontend/src/uxbox/main/data/images.cljs @@ -5,20 +5,21 @@ ;; Copyright (c) 2016 Andrey Antukh (ns uxbox.main.data.images - (:require [cljs.spec.alpha :as s] - [cuerdas.core :as str] - [beicon.core :as rx] - [potok.core :as ptk] - [uxbox.main.store :as st] - [uxbox.main.repo :as rp] - [uxbox.util.i18n :refer [tr]] - [uxbox.util.router :as rt] - [uxbox.util.data :refer (jscoll->vec)] - [uxbox.util.uuid :as uuid] - [uxbox.util.time :as ts] - [uxbox.util.spec :as us] - [uxbox.util.router :as r] - [uxbox.util.files :as files])) + (:require + [cljs.spec.alpha :as s] + [cuerdas.core :as str] + [beicon.core :as rx] + [potok.core :as ptk] + [uxbox.main.store :as st] + [uxbox.main.repo.core :as rp] + [uxbox.util.i18n :refer [tr]] + [uxbox.util.router :as rt] + [uxbox.util.data :refer (jscoll->vec)] + [uxbox.util.uuid :as uuid] + [uxbox.util.time :as ts] + [uxbox.util.spec :as us] + [uxbox.util.router :as r] + [uxbox.util.files :as files])) ;; --- Specs @@ -30,21 +31,20 @@ (s/def ::mimetype string?) (s/def ::thumbnail us/url-str?) (s/def ::id uuid?) -(s/def ::version integer?) (s/def ::url us/url-str?) -(s/def ::collection (s/nilable uuid?)) -(s/def ::user uuid?) +(s/def ::collection-id (s/nilable ::us/uuid)) +(s/def ::user-id ::us/uuid) (s/def ::collection-entity (s/keys :req-un [::id ::name ::created-at ::modified-at - ::user - ::version])) + ::user-id])) (s/def ::image-entity - (s/keys :req-un [::id + (s/keys :opt-un [::collection-id] + :req-un [::id ::name ::width ::height @@ -53,9 +53,7 @@ ::mimetype ::thumbnail ::url - ::version - ::collection - ::user])) + ::user-id])) ;; --- Initialize @@ -90,8 +88,7 @@ (defrecord FetchCollections [] ptk/WatchEvent (watch [_ state s] - (->> (rp/req :fetch/image-collections) - (rx/map :payload) + (->> (rp/query! :images-collections) (rx/map collections-fetched)))) (defn fetch-collections @@ -120,9 +117,8 @@ (defrecord CreateCollection [] ptk/WatchEvent (watch [_ state s] - (let [coll {:name (tr "ds.default-library-title" (gensym "c")) - :id (uuid/random)}] - (->> (rp/req :create/image-collection coll) + (let [data {:name (tr "ds.default-library-title" (gensym "c"))}] + (->> (rp/mutation! :create-image-collection data) (rx/map :payload) (rx/map collection-created))))) @@ -152,8 +148,7 @@ ptk/WatchEvent (watch [_ state s] (let [item (get-in state [:images-collections id])] - (->> (rp/req :update/image-collection item) - (rx/map :payload) + (->> (rp/mutation! :update-images-collection item) (rx/map collection-updated))))) (defn update-collection @@ -185,7 +180,7 @@ ptk/WatchEvent (watch [_ state s] (let [type (get-in state [:dashboard :images :type])] - (->> (rp/req :delete/image-collection id) + (->> (rp/mutation! :delete-images-collection {:id id}) (rx/map #(rt/nav :dashboard/images nil {:type type})))))) (defn delete-collection @@ -223,17 +218,18 @@ (finalize-upload [state] (assoc-in state [:dashboard :images :uploading] false)) (prepare [[file [width height]]] - {:collection id - :mimetype (.-type file) - :id (uuid/random) - :file file - :width width - :height height})] + (cond-> {:name (.-name file) + :mimetype (.-type file) + :id (uuid/random) + :file file + :width width + :height height} + id (assoc :collection-id id)))] (->> (rx/from-coll files) (rx/filter allowed-file?) (rx/mapcat image-size) (rx/map prepare) - (rx/mapcat #(rp/req :create/image %)) + (rx/mapcat #(rp/mutation! :create-image %)) (rx/map :payload) (rx/reduce conj []) (rx/do #(st/emit! finalize-upload)) @@ -266,9 +262,8 @@ (defrecord PersistImage [id] ptk/WatchEvent (watch [_ state stream] - (let [image (get-in state [:images id])] - (->> (rp/req :update/image image) - (rx/map :payload) + (let [data (get-in state [:images id])] + (->> (rp/mutation! :update-image data) (rx/map image-persisted))))) (defn persist-image @@ -295,9 +290,8 @@ (defrecord FetchImages [id] ptk/WatchEvent (watch [_ state s] - (let [params {:coll id}] - (->> (rp/req :fetch/images params) - (rx/map :payload) + (let [params (cond-> {} id (assoc :collection-id id))] + (->> (rp/query! :images-by-collection params) (rx/map images-fetched))))) (defn fetch-images @@ -316,10 +310,9 @@ (let [existing (get-in state [:images id])] (if existing (rx/empty) - (->> (rp/req :fetch/image {:id id}) - (rx/catch rp/client-error? #(rx/empty)) - (rx/map :payload) - (rx/map image-fetched)))))) + (->> (rp/query! :image-by-id {:id id}) + (rx/map image-fetched) + (rx/catch rp/client-error? #(rx/empty))))))) (defn fetch-image "Conditionally fetch image by its id. If image @@ -352,7 +345,7 @@ ptk/WatchEvent (watch [_ state s] - (->> (rp/req :delete/image id) + (->> (rp/mutation! :delete-image {:id id}) (rx/ignore)))) (defn delete-image @@ -414,8 +407,7 @@ (let [selected (get-in state [:dashboard :images :selected])] (rx/merge (->> (rx/from-coll selected) - (rx/flat-map #(rp/req :copy/image {:id % :collection id})) - (rx/map :payload) + (rx/flat-map #(rp/mutation! :copy-image {:id % :collection-id id})) (rx/map image-created)) (->> (rx/from-coll selected) (rx/map deselect-image)))))) diff --git a/frontend/src/uxbox/main/data/pages.cljs b/frontend/src/uxbox/main/data/pages.cljs index 6c11ad70c..5df8fb24d 100644 --- a/frontend/src/uxbox/main/data/pages.cljs +++ b/frontend/src/uxbox/main/data/pages.cljs @@ -22,7 +22,7 @@ (s/def ::name ::us/string) (s/def ::inst ::us/inst) (s/def ::type ::us/keyword) -(s/def ::project ::us/uuid) +(s/def ::project-id ::us/uuid) (s/def ::created-at ::us/inst) (s/def ::modified-at ::us/inst) (s/def ::version ::us/number) @@ -51,10 +51,10 @@ (s/def ::page-entity (s/keys :req-un [::id ::name - ::project + ::project-id ::created-at ::modified-at - ::user + ::user-id ::metadata ::shapes])) @@ -70,7 +70,7 @@ (s/def ::server-page (s/keys :req-un [::id ::name - ::project + ::project-id ::version ::created-at ::modified-at @@ -194,7 +194,7 @@ (declare rehash-pages) (s/def ::page-created-params - (s/keys :req-un [::id ::name ::project ::metadata])) + (s/keys :req-un [::id ::name ::project-id ::metadata])) (defn page-created [data] @@ -215,7 +215,7 @@ ;; --- Create Page Form (s/def ::form-created-page-params - (s/keys :req-un [::name ::project ::width ::height])) + (s/keys :req-un [::name ::project-id ::width ::height])) (defn form->create-page [{:keys [name project width height layout] :as data}] diff --git a/frontend/src/uxbox/main/data/projects.cljs b/frontend/src/uxbox/main/data/projects.cljs index d6cb20b59..5ddaeeee8 100644 --- a/frontend/src/uxbox/main/data/projects.cljs +++ b/frontend/src/uxbox/main/data/projects.cljs @@ -22,7 +22,7 @@ (s/def ::id uuid?) (s/def ::name string?) (s/def ::version integer?) -(s/def ::user uuid?) +(s/def ::user-id uuid?) (s/def ::created-at inst?) (s/def ::modified-at inst?) @@ -30,7 +30,7 @@ (s/keys ::req-un [::id ::name ::version - ::user + ::user-id ::created-at ::modified-at])) diff --git a/frontend/src/uxbox/main/data/users.cljs b/frontend/src/uxbox/main/data/users.cljs index c5290e555..854e40651 100644 --- a/frontend/src/uxbox/main/data/users.cljs +++ b/frontend/src/uxbox/main/data/users.cljs @@ -9,7 +9,7 @@ [cljs.spec.alpha :as s] [beicon.core :as rx] [potok.core :as ptk] - [uxbox.main.repo :as rp] + [uxbox.main.repo.core :as rp] [uxbox.util.i18n :as i18n :refer [tr]] [uxbox.util.messages :as uum] [uxbox.util.spec :as us] @@ -59,8 +59,7 @@ (reify ptk/WatchEvent (watch [_ state s] - (->> (rp/req :fetch/profile) - (rx/map :payload) + (->> (rp/query! :profile) (rx/map profile-fetched))))) ;; --- Update Profile diff --git a/frontend/src/uxbox/main/data/workspace.cljs b/frontend/src/uxbox/main/data/workspace.cljs index 6fc1d9d85..ed705d38a 100644 --- a/frontend/src/uxbox/main/data/workspace.cljs +++ b/frontend/src/uxbox/main/data/workspace.cljs @@ -11,7 +11,6 @@ [potok.core :as ptk] [uxbox.config :as cfg] [uxbox.main.constants :as c] - [uxbox.main.data.history :as udh] [uxbox.main.data.icons :as udi] [uxbox.main.data.pages :as udp] [uxbox.main.data.projects :as dp] diff --git a/frontend/src/uxbox/main/repo/auth.cljs b/frontend/src/uxbox/main/repo/auth.cljs index 2f0e77567..586e3f30a 100644 --- a/frontend/src/uxbox/main/repo/auth.cljs +++ b/frontend/src/uxbox/main/repo/auth.cljs @@ -12,21 +12,20 @@ (defmethod request :fetch/profile [type _] - (let [url (str url "/profile/me")] + (let [url (str url "/w/query/profile")] (send! {:method :get :url url}))) (defmethod request :auth/login [type data] - (let [url (str url "/auth/login")] + (let [url (str url "/login")] (send! {:url url - :method :post - :auth false - :body data}))) - + :method :post + :auth false + :body data}))) (defmethod request :auth/logout [type data] - (let [url (str url "/auth/logout")] + (let [url (str url "/logout")] (send! {:url url :method :post :auth false}))) (defmethod request :update/profile diff --git a/frontend/src/uxbox/main/repo/core.cljs b/frontend/src/uxbox/main/repo/core.cljs new file mode 100644 index 000000000..02f7f8ab1 --- /dev/null +++ b/frontend/src/uxbox/main/repo/core.cljs @@ -0,0 +1,135 @@ +;; 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 + +(ns uxbox.main.repo.core + (:require + [beicon.core :as rx] + [cuerdas.core :as str] + [uxbox.main.repo.impl :as impl] + [uxbox.config :refer [url]] + [uxbox.util.http :as http] + [uxbox.util.storage :refer [storage]] + [uxbox.util.transit :as t]) + (:import [goog.Uri QueryData])) + +;; --- Low Level API + +(defn- conditional-decode + [{:keys [body headers] :as response}] + (let [contentype (get headers "content-type")] + (if (str/starts-with? contentype "application/transit+json") + (assoc response :body (t/decode body)) + response))) + +(defn- handle-http-status + [{:keys [body status] :as response}] + (if (http/success? response) + (rx/of {:status status :payload body}) + (rx/throw {:status status :payload body}))) + +(def ^:private +headers+ + {"content-type" "application/transit+json"}) + +(defn- encode-query + [params] + (let [data (QueryData.)] + (.extend data (clj->js params)) + (.toString data))) + +(defn impl-send + [{:keys [body headers auth method query url response-type] + :or {auth true response-type :text}}] + (let [headers (merge {"Accept" "application/transit+json,*/*"} + (when (map? body) +headers+) + headers) + request {:method method + :url url + :headers headers + :query-string (when query (encode-query query)) + :body (if (map? body) (t/encode body) body)} + options {:response-type response-type + :credentials? true}] + (http/send! request options))) + +(defn send! + [request] + (->> (impl-send request) + (rx/map conditional-decode) + (rx/mapcat handle-http-status))) + +;; --- High Level API + +(defn- handle-response + [response] + ;; (prn "handle-response1" response) + (cond + (http/success? response) + (rx/of (:body response)) + + (http/client-error? response) + (rx/throw (:body response)) + + :else + (rx/throw {:type :unexpected + :code (:error response)}))) + +(defn send-query! + [id params] + (let [url (str url "/w/query/" (name id))] + (->> (impl-send {:method :get :url url :query params}) + (rx/map conditional-decode) + (rx/mapcat handle-response)))) + +(defn send-mutation! + [id params] + (let [url (str url "/w/mutation/" (name id))] + (send! {:method :post + :url url + :body params}))) + +(defn- dispatch + [& args] + (first args)) + +(defmulti query dispatch) +(defmulti mutation dispatch) + +(defmethod query :default + [id params] + (send-query! id params)) + +(defmethod mutation :default + [id params] + (send-mutation! id params)) + +(defn query! + ([id] (query id {})) + ([id params] (query id params))) + +(defn mutation! + ([id] (mutation id {})) + ([id params] (mutation id params))) + +;; --- Legacy Api + +(defn req + "Perform a side effectfull action accesing + remote resources." + ([type] + (impl/request type nil)) + ([type data] + (impl/request type data))) + +(def client-error? http/client-error?) +(def server-error? http/server-error?) + +(defmethod mutation :create-image + [id params] + (let [form (js/FormData.)] + (run! (fn [[key val]] + (.append form (name key) val)) + (seq params)) + (send-mutation! id form))) diff --git a/frontend/src/uxbox/main/repo/pages.cljs b/frontend/src/uxbox/main/repo/pages.cljs index ae6356c1e..e545f5e20 100644 --- a/frontend/src/uxbox/main/repo/pages.cljs +++ b/frontend/src/uxbox/main/repo/pages.cljs @@ -8,24 +8,19 @@ "A main interface for access to remote resources." (:require [uxbox.config :refer [url]] - [uxbox.main.repo.impl :refer [request send!]])) - -(defmethod request :fetch/pages - [type data] - (let [params {:url (str url "/pages") - :method :get}] - (send! params))) + [uxbox.main.repo.impl :as rp :refer [request send!]])) (defmethod request :fetch/pages-by-project [type {:keys [project] :as params}] - (let [url (str url "/pages") - params {:project project}] + (let [url (str url "/w/query/pages-by-project") + params {:project-id project}] (send! {:method :get :url url :query params}))) (defmethod request :fetch/page-history [type {:keys [page] :as params}] - (let [url (str url "/pages/" page "/history") - query (select-keys params [:max :since :pinned]) + (let [url (str url "/w/query/page-history") + query (-> (select-keys params [:max :since :pinned]) + (assoc :id page)) params {:method :get :url url :query query}] (send! params))) @@ -44,22 +39,22 @@ (defmethod request :update/page [type {:keys [id] :as body}] - (let [params {:url (str url "/pages/" id) - :method :put + (let [params {:url (str url "/w/mutation/update-page") + :method :post :body body}] (send! params))) +(defmethod request :update/page-metadata + [type {:keys [id] :as body}] + (let [params {:url (str url "/w/mutation/update-page-metadata") + :method :post + :body body}] + (send! params))) + + (defmethod request :update/page-history [type {:keys [id page] :as data}] (let [params {:url (str url "/pages/" page "/history/" id) :method :put :body data}] (send! params))) - -(defmethod request :update/page-metadata - [type {:keys [id metadata] :as body}] - (let [body (dissoc body :data) - params {:url (str url "/pages/" id "/metadata") - :method :put - :body body}] - (send! params))) diff --git a/frontend/src/uxbox/main/repo/projects.cljs b/frontend/src/uxbox/main/repo/projects.cljs index 5c7c2f06d..742e76cce 100644 --- a/frontend/src/uxbox/main/repo/projects.cljs +++ b/frontend/src/uxbox/main/repo/projects.cljs @@ -16,7 +16,7 @@ [type data] ;; Obtain the list of projects and decode the embedded ;; page data in order to have it usable. - (send! {:url (str url "/projects") + (send! {:url (str url "/w/query/projects") :method :get})) (defmethod request :fetch/project-by-token diff --git a/frontend/src/uxbox/main/ui.cljs b/frontend/src/uxbox/main/ui.cljs index 8b202d0d9..5d928bae2 100644 --- a/frontend/src/uxbox/main/ui.cljs +++ b/frontend/src/uxbox/main/ui.cljs @@ -12,6 +12,7 @@ [lentes.core :as l] [potok.core :as ptk] [rumext.alpha :as mf] + [expound.alpha :as expound] [uxbox.builtins.icons :as i] [uxbox.main.data.auth :refer [logout]] [uxbox.main.data.projects :as dp] @@ -53,31 +54,37 @@ (defn- on-error "A default error handler." - [{:keys [status] :as error}] - (js/console.error "Unhandled Error:" - "\n - message:" (ex-message error) - "\n - data:" (pr-str (ex-data error))) - (js/console.error error) + [{:keys [type code] :as error}] (reset! st/loader false) (cond - ;; Unauthorized or Auth timeout - (and (:status error) - (or (= (:status error) 403) - (= (:status error) 419))) + (and (map? error) + (= :validation type) + (= :spec-validation code)) + (do + (println "============ SERVER RESPONSE ERROR ================") + (println (:explain error)) + (println "============ END SERVER RESPONSE ERROR ================")) + ;; Unauthorized or Auth timeout + (and (map? error) + (= :authentication type) + (= :unauthorized code)) (ts/schedule 0 #(st/emit! (rt/nav :auth/login))) - ;; Conflict - (= status 412) - (ts/schedule 100 #(st/emit! (uum/error (tr "errors.conflict")))) - ;; Network error - (= (:status error) 0) + (and (map? error) + (= :unexpected type) + (= :abort code)) (ts/schedule 100 #(st/emit! (uum/error (tr "errors.network")))) ;; Something else :else - (ts/schedule 100 #(st/emit! (uum/error (tr "errors.generic")))))) + (do + (js/console.error "Unhandled Error:" + "\n - message:" (ex-message error) + "\n - data:" (pr-str (ex-data error))) + (js/console.error error) + (ts/schedule 100 #(st/emit! (uum/error (tr "errors.generic"))))))) (set! st/*on-error* on-error) diff --git a/frontend/src/uxbox/main/ui/dashboard/icons.cljs b/frontend/src/uxbox/main/ui/dashboard/icons.cljs index 25b9a6103..39ebbb242 100644 --- a/frontend/src/uxbox/main/ui/dashboard/icons.cljs +++ b/frontend/src/uxbox/main/ui/dashboard/icons.cljs @@ -83,7 +83,7 @@ [id] (letfn [(selector [icons] (->> (vals icons) - (filter #(= id (:collection %))) + (filter #(= id (:collection-id %))) (count)))] (-> (comp (l/key :icons) (l/lens selector)) @@ -325,7 +325,7 @@ (-> (comp (l/key :icons) (l/lens (fn [icons] (->> (vals icons) - (filter #(= id (:collection %))))))) + (filter #(= id (:collection-id %))))))) (l/derive st/state))) (mf/defc grid diff --git a/frontend/src/uxbox/main/ui/dashboard/images.cljs b/frontend/src/uxbox/main/ui/dashboard/images.cljs index 95cad1c2f..f1028ae63 100644 --- a/frontend/src/uxbox/main/ui/dashboard/images.cljs +++ b/frontend/src/uxbox/main/ui/dashboard/images.cljs @@ -84,7 +84,7 @@ [id] (letfn [(selector [images] (->> (vals images) - (filter #(= id (:collection %))) + (filter #(= id (:collection-id %))) (count)))] (-> (comp (l/key :images) (l/lens selector)) @@ -310,7 +310,7 @@ (-> (comp (l/key :images) (l/lens (fn [images] (->> (vals images) - (filter #(= id (:collection %))))))) + (filter #(= id (:collection-id %))))))) (l/derive st/state))) (mf/defc grid diff --git a/frontend/src/uxbox/main/ui/workspace.cljs b/frontend/src/uxbox/main/ui/workspace.cljs index 05aed4b44..43c628182 100644 --- a/frontend/src/uxbox/main/ui/workspace.cljs +++ b/frontend/src/uxbox/main/ui/workspace.cljs @@ -63,8 +63,9 @@ [canvas page] (st/emit! (udp/watch-page-changes (:id page)) (udu/watch-page-changes (:id page)) - (udh/initialize (:id page)) - (udh/watch-page-changes (:id page)) + ;; TODO: temporary commented + ;; (udh/initialize (:id page)) + ;; (udh/watch-page-changes (:id page)) (dw/start-shapes-watcher (:id page))) (let [sub (shortcuts/init)] #(do (st/emit! ::udp/stop-page-watcher diff --git a/frontend/src/uxbox/main/ui/workspace/sidebar.cljs b/frontend/src/uxbox/main/ui/workspace/sidebar.cljs index 4a3bfbcba..977876d11 100644 --- a/frontend/src/uxbox/main/ui/workspace/sidebar.cljs +++ b/frontend/src/uxbox/main/ui/workspace/sidebar.cljs @@ -24,7 +24,7 @@ [:aside.settings-bar.settings-bar-left [:div.settings-bar-inside (when (contains? flags :sitemap) - [:& sitemap-toolbox {:project-id (:project page) + [:& sitemap-toolbox {:project-id (:project-id page) :current-page-id (:id page) :page page}]) (when (contains? flags :document-history) diff --git a/frontend/src/uxbox/main/ui/workspace/sidebar/sitemap.cljs b/frontend/src/uxbox/main/ui/workspace/sidebar/sitemap.cljs index a8e8ea3b0..83480a100 100644 --- a/frontend/src/uxbox/main/ui/workspace/sidebar/sitemap.cljs +++ b/frontend/src/uxbox/main/ui/workspace/sidebar/sitemap.cljs @@ -37,14 +37,14 @@ (dom/stop-propagation event) (modal/show! confirm-dialog {:on-accept delete})) (on-drop [item monitor] - (st/emit! (udp/rehash-pages (:project page)))) + (st/emit! (udp/rehash-pages (:project-id page)))) (on-hover [item monitor] (st/emit! (udp/move-page {:project-id (:project-id item) :page-id (:page-id item) :index index})))] (let [[dprops ref] (use-sortable {:type "page-item" :data {:page-id (:id page) - :project-id (:project page) + :project-id (:project-id page) :index index} :on-hover on-hover :on-drop on-drop})] @@ -52,7 +52,7 @@ [:div.element-list-body {:class (classnames :selected selected? :dragging (:dragging? dprops)) - :on-click #(st/emit! (rt/nav :workspace/page {:project (:project page) + :on-click #(st/emit! (rt/nav :workspace/page {:project (:project-id page) :page (:id page)})) :on-double-click #(dom/stop-propagation %) :draggable true} @@ -92,6 +92,7 @@ (mf/defc sitemap-toolbox [{:keys [project-id current-page-id] :as props}] + (prn "sitemap-toolbox" props) (let [project-iref (mf/use-memo {:deps #js [project-id] :fn #(-> (l/in [:projects project-id]) (l/derive st/state))}) diff --git a/frontend/src/uxbox/util/data.cljs b/frontend/src/uxbox/util/data.cljs index d35f657f6..1fd43f8da 100644 --- a/frontend/src/uxbox/util/data.cljs +++ b/frontend/src/uxbox/util/data.cljs @@ -203,3 +203,15 @@ ;; (let [keys# (map #(keyword (name %)) fields) ;; vals# fields] ;; (apply hash-map (interleave keys# vals#)))) + +;; (defmacro some->' +;; [x & forms] +;; `(let [x# (p/then' ~x (fn [v#] +;; (when (nil? v#) +;; (throw (ex-info "internal" {::some-interrupt true}))) +;; v#))] +;; (-> (-> x# ~@forms) +;; (p/catch' (fn [e#] +;; (if (::some-interrupt (ex-data e#)) +;; nil +;; (throw e#))))))) diff --git a/frontend/src/uxbox/util/http.cljs b/frontend/src/uxbox/util/http.cljs index 05e136b4a..a33309621 100644 --- a/frontend/src/uxbox/util/http.cljs +++ b/frontend/src/uxbox/util/http.cljs @@ -40,7 +40,9 @@ ErrorCode.TIMEOUT :timeout ErrorCode.EXCEPTION :exception ErrorCode.HTTP_ERROR :http - ErrorCode.ABORT :abort)) + ErrorCode.ABORT :abort + ErrorCode.OFFLINE :offline + nil)) (defn- translate-response-type [type] @@ -72,18 +74,18 @@ (rx/create (fn [sink] (letfn [(on-complete [event] - (if (or (= (.getLastErrorCode xhr) ErrorCode.HTTP_ERROR) - (.isSuccess xhr)) - (sink (rx/end - {:status (.getStatus xhr) - :body (.getResponse xhr) - :headers (normalize-headers - (.getResponseHeaders xhr))})) - (sink (let [type (-> (.getLastErrorCode xhr) - (translate-error-code)) - message (.getLastError xhr)] - (ex-info message {:type type})))))] - + (let [type (translate-error-code (.getLastErrorCode xhr)) + status (.getStatus xhr)] + ;; (prn "on-complete" type method url) + (if (pos? status) + (sink (rx/end + {:status status + :body (.getResponse xhr) + :headers (normalize-headers (.getResponseHeaders xhr))})) + (sink (rx/end + {:status 0 + :error (if (= type :http) :abort type) + ::xhr xhr})))))] (events/listen xhr EventType.COMPLETE on-complete) (.send xhr uri method body headers) #(.abort xhr))))))