Import backend code inside the repository.

backend/profiles.clj

@@ -0,0 +1,8 @@
+{:dev
+ {:plugins [[lein-ancient "0.6.10"]]
+  :dependencies [[clj-http "2.1.0"]]
+  :main ^:skip-aot uxbox.main}
+
+ :prod
+ {:jvm-opts ^:replace ["-Xms4g" "-Xmx4g" "-XX:+UseG1GC"
+                       "-XX:+AggressiveOpts" "-server"]}}

backend/project.clj

@@ -0,0 +1,48 @@
+(defproject uxbox-backend "0.1.0-SNAPSHOT"
+  :description "UXBox backend."
+  :url "http://uxbox.github.io"
+  :license {:name "MPL 2.0" :url "https://www.mozilla.org/en-US/MPL/2.0/"}
+  :source-paths ["src" "vendor"]
+  :javac-options ["-target" "1.8" "-source" "1.8" "-Xlint:-options"]
+  :jvm-opts ["-Dclojure.compiler.direct-linking=true"
+             ;; "-Dcom.sun.management.jmxremote.port=9090"
+             ;; "-Dcom.sun.management.jmxremote.authenticate=false"
+             ;; "-Dcom.sun.management.jmxremote.ssl=false"
+             ;; "-Dcom.sun.management.jmxremote.rmi.port=9090"
+             ;; "-Djava.rmi.server.hostname=0.0.0.0"
+             "-Dclojure.spec.check-asserts=true"
+             "-Dclojure.spec.compile-asserts=true"
+             "-XX:+UseG1GC" "-Xms1g" "-Xmx1g"]
+  :global-vars {*assert* true}
+  :dependencies [[org.clojure/clojure "1.9.0-alpha14"]
+                 [org.clojure/tools.logging "0.3.1"]
+                 [funcool/struct "1.0.0"]
+                 [funcool/suricatta "1.2.0"]
+                 [funcool/promesa "1.6.0"]
+                 [funcool/catacumba "2.0.0-SNAPSHOT"]
+
+                 [org.clojure/data.xml "0.1.0-beta2"]
+                 [org.jsoup/jsoup "1.10.1"]
+
+                 [hiccup "1.0.5"]
+                 [org.im4java/im4java "1.4.0"]
+
+                 [org.slf4j/slf4j-simple "1.7.21"]
+                 [com.layerware/hugsql-core "0.4.7"
+                  :exclusions [org.clojure/tools.reader]]
+                 [niwinz/migrante "0.1.0"]
+
+                 [buddy/buddy-sign "1.3.0" :exclusions [org.clojure/tools.reader]]
+                 [buddy/buddy-hashers "1.1.0"]
+
+                 [org.xerial.snappy/snappy-java "1.1.2.6"]
+                 [com.github.spullara.mustache.java/compiler "0.9.4"]
+                 [org.postgresql/postgresql "9.4.1212"]
+                 [org.quartz-scheduler/quartz "2.2.3"]
+                 [org.quartz-scheduler/quartz-jobs "2.2.3"]
+                 [commons-io/commons-io "2.5"]
+                 [com.draines/postal "2.0.2"]
+
+                 [hikari-cp "1.7.5"]
+                 [mount "0.1.10"]
+                 [environ "1.1.0"]])

backend/resources/builtin.edn

@@ -0,0 +1,11 @@
+{:icons
+ [{:name "Material Design (Action)"
+   :path "./material/action/svg/production"
+   :regex #"^.*_48px\.svg$"}]
+
+ :images
+ [{:name "Generic Collection 1"
+   :path "./my-images/collection1/"
+   :regex #"^.*\.(png|jpg|webp)$"}]}
+
+

backend/resources/config/default.edn

@@ -0,0 +1,37 @@
+{;; A secret key used for create tokens
+ ;; WARNING: this is a default secret key and
+ ;; it should be overwritten in production env.
+ :secret "5qjiAn-QUpawUNqGP10UZKklSqbLKcdGY3sJpq0UUACpVXGg2HOFJCBejDWVHskhRyp7iHb4rjOLXX2ZjF-5cw"
+ :smtp
+ {:host "localhost" ;; Hostname of the desired SMTP server.
+  :port 25          ;; Port of SMTP server.
+  :user nil         ;; Username to authenticate with (if authenticating).
+  :pass nil         ;; Password to authenticate with (if authenticating).
+  :ssl false        ;; Enables SSL encryption if value is truthy.
+  :tls false       ;; Enables TLS encryption if value is truthy.
+  :noop true}
+
+ :auth-options {:alg :a256kw :enc :a128cbc-hs256}
+
+ :email {:reply-to "no-reply@uxbox.io"
+         :from "no-reply@uxbox.io"}
+
+ :http {:port 6060
+        :max-body-size 52428800
+        :debug true}
+
+ :media
+ {:basedir "resources/public/media"
+  :baseuri "http://localhost:6060/media/"}
+
+ :static
+ {:basedir "resources/public/static"
+  :baseuri "http://localhost:6060/static/"}
+
+ :database
+ {:adapter "postgresql"
+  :username nil
+  :password nil
+  :database-name "uxbox"
+  :server-name "localhost"
+  :port-number 5432}}

backend/resources/config/test.edn

@@ -0,0 +1,18 @@
+{:migrations
+ {:verbose false}
+
+ :media
+ {:basedir "/tmp/uxbox/media"
+  :baseuri "http://localhost:6060/media/"}
+
+ :static
+ {:basedir "/tmp/uxbox/static"
+  :baseuri "http://localhost:6060/static/"}
+
+ :database
+ {:adapter "postgresql"
+  :username nil
+  :password nil
+  :database-name "test"
+  :server-name "localhost"
+  :port-number 5432}}

backend/resources/emails/en/register.mustache

@@ -0,0 +1,17 @@
+-- begin :subject
+Welcome to UXBOX.
+-- end
+
+-- begin :body-text
+Hello {{user}}!
+
+Welcome to UXBOX.
+
+UXBOX team.
+-- end
+
+-- begin :body-html
+<p>Hello {{user}}!</p>
+<p>Welcome to UXBOX.</p>
+<p>UXBOX team.</p>
+-- end

backend/resources/migrations/0000.main.up.sql

@@ -0,0 +1,28 @@
+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;

backend/resources/migrations/0001.txlog.up.sql

@@ -0,0 +1,17 @@
+-- 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();

backend/resources/migrations/0002.auth.up.sql

@@ -0,0 +1,49 @@
+CREATE TABLE users (
+  id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
+
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  deleted_at timestamptz DEFAULT NULL,
+
+  fullname text NOT NULL DEFAULT '',
+  username text NOT NULL,
+  email text NOT NULL,
+  photo text NOT NULL,
+  password text NOT NULL,
+  metadata bytea NOT NULL
+);
+
+-- Insert a placeholder system user.
+INSERT INTO users (id, fullname, username, email, photo, password, metadata)
+VALUES ('00000000-0000-0000-0000-000000000000'::uuid,
+        'System User',
+        '00000000-0000-0000-0000-000000000000',
+        'system@uxbox.io',
+        '',
+        '!',
+        ''::bytea);
+
+CREATE UNIQUE INDEX users_username_idx
+  ON users USING btree (username);
+
+CREATE UNIQUE INDEX users_email_idx
+  ON users USING btree (email);
+
+CREATE TRIGGER users_modified_at_tgr BEFORE UPDATE ON users
+  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,
+  token text NOT NULL,
+
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  used_at timestamptz DEFAULT NULL
+);
+
+CREATE INDEX user_pswd_recovery_user_idx
+    ON user_pswd_recovery USING btree ("user");
+
+CREATE UNIQUE INDEX user_pswd_recovery_token_idx
+    ON user_pswd_recovery USING btree (token);
+

backend/resources/migrations/0003.projects.up.sql

@@ -0,0 +1,62 @@
+-- Table
+
+CREATE TABLE IF NOT EXISTS projects (
+  id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
+  "user" 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 project_shares (
+  project uuid PRIMARY KEY REFERENCES projects(id) ON DELETE CASCADE,
+
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  token text
+);
+
+-- Indexes
+
+CREATE INDEX projects_user_idx
+    ON projects("user");
+
+CREATE UNIQUE INDEX projects_shares_token_idx
+    ON project_shares(token);
+
+-- Triggers
+
+CREATE OR REPLACE FUNCTION handle_project_create()
+  RETURNS TRIGGER AS $$
+  DECLARE
+    token text;
+  BEGIN
+    SELECT encode(digest(gen_random_bytes(128), 'sha256'), 'hex')
+      INTO token;
+
+    INSERT INTO project_shares (project, token)
+    VALUES (NEW.id, token);
+
+    RETURN NEW;
+  END;
+$$ LANGUAGE plpgsql;
+
+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();
+
+CREATE TRIGGER project_shares_modified_at_tgr
+BEFORE UPDATE ON project_shares
+   FOR EACH ROW EXECUTE PROCEDURE update_modified_at();

backend/resources/migrations/0004.pages.up.sql

@@ -0,0 +1,74 @@
+-- Tables
+
+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,
+
+  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,
+  metadata bytea NOT NULL
+);
+
+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,
+
+  created_at timestamptz NOT NULL,
+  modified_at timestamptz NOT NULL,
+  version bigint NOT NULL DEFAULT 0,
+
+  pinned bool NOT NULL DEFAULT false,
+  label text NOT NULL DEFAULT '',
+  data bytea NOT NULL
+);
+
+-- 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");
+
+-- Triggers
+
+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;
+
+    --- 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;
+
+    RETURN NEW;
+  END;
+$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();
+
+CREATE TRIGGER pages_history_modified_at_tgr BEFORE UPDATE ON pages
+   FOR EACH ROW EXECUTE PROCEDURE update_modified_at();

backend/resources/migrations/0005.kvstore.up.sql

@@ -0,0 +1,19 @@
+CREATE TABLE IF NOT EXISTS kvstore (
+  "user" 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")
+);
+
+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();

backend/resources/migrations/0006.emails.up.sql

@@ -0,0 +1,27 @@
+CREATE TYPE email_status AS ENUM ('pending', 'ok', 'failed');
+
+CREATE TABLE IF NOT EXISTS email_queue (
+  id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
+
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  deleted_at timestamptz DEFAULT NULL,
+
+  data bytea NOT NULL,
+
+  priority smallint NOT NULL DEFAULT 10
+                    CHECK (priority BETWEEN 0 and 10),
+
+  status email_status NOT NULL DEFAULT 'pending',
+  retries integer NOT NULL DEFAULT -1
+);
+
+-- Triggers
+
+CREATE TRIGGER email_queue_modified_at_tgr BEFORE UPDATE ON email_queue
+   FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
+
+-- Indexes
+
+CREATE INDEX email_status_idx
+    ON email_queue (status);

backend/resources/migrations/0007.images.up.sql

@@ -0,0 +1,59 @@
+-- Tables
+
+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,
+
+  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,
+
+  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,
+  name text NOT NULL,
+  path text NOT NULL
+);
+
+-- Indexes
+
+CREATE INDEX images_collections_user_idx
+    ON images_collections ("user");
+
+CREATE INDEX images_collection_idx
+    ON images (collection);
+
+CREATE INDEX images_user_idx
+    ON images ("user");
+
+-- 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();
+

backend/resources/migrations/0008.icons.up.sql

@@ -0,0 +1,56 @@
+-- Tables
+
+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,
+
+  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,
+
+  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
+);
+
+-- Indexes
+
+CREATE INDEX icon_colections_user_idx
+    ON icons_collections ("user");
+
+CREATE INDEX icons_user_idx
+    ON icons ("user");
+
+CREATE INDEX icons_collection_idx
+    ON icons (collection);
+
+-- 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();
+

backend/resources/migrations/XXXX.workers.up.sql

@@ -0,0 +1,11 @@
+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);

backend/resources/sql/cli.sql

@@ -0,0 +1,28 @@
+-- :name get-image-collection :? :1
+select *
+  from images_collections as cc
+ where cc.id = :id
+   and cc."user" = '00000000-0000-0000-0000-000000000000'::uuid;
+
+-- :name create-image :<! :1
+insert into images ("user", name, collection, path, width, height, mimetype)
+values ('00000000-0000-0000-0000-000000000000'::uuid, :name, :collection,
+        :path, :width, :height, :mimetype)
+returning *;
+
+-- :name delete-image :! :n
+delete from images
+ where id = :id
+   and "user" = '00000000-0000-0000-0000-000000000000'::uuid;
+
+-- :name create-image-collection
+insert into images_collections (id, "user", name)
+values (:id, '00000000-0000-0000-0000-000000000000'::uuid, :name)
+    on conflict (id)
+    do update set name = :name
+returning *;
+
+-- :name get-image
+select * from images as i
+ where i.id = :id
+   and i."user" = '00000000-0000-0000-0000-000000000000'::uuid;

backend/resources/sql/emails.sql

@@ -0,0 +1,45 @@
+-- :name insert-email :! :n
+insert into email_queue (data, priority)
+values (:data, :priority);
+
+-- :name get-pending-emails :? :*
+select eq.* from email_queue as eq
+ where eq.status = 'pending'
+   and eq.deleted_at is null
+ order by eq.priority desc,
+          eq.created_at desc;
+
+-- :name get-immediate-emails :? :*
+select eq.* from email_queue as eq
+ where eq.status = 'pending'
+   and eq.priority = 10
+   and eq.deleted_at is null
+ order by eq.priority desc,
+          eq.created_at desc;
+
+-- :name get-failed-emails :? :*
+select eq.* from email_queue as eq
+ where eq.status = 'failed'
+   and eq.deleted_at is null
+   and eq.retries < :max-retries
+ order by eq.priority desc,
+          eq.created_at desc;
+
+-- :name mark-email-as-sent :! :n
+update email_queue
+   set status = 'ok'
+ where id = :id
+   and deleted_at is null;
+
+-- :name mark-email-as-failed :! :n
+update email_queue
+   set status = 'failed',
+       retries = retries + 1
+ where id = :id
+   and deleted_at is null;
+
+-- :name delete-email :! :n
+update email_queue
+   set deleted_at = clock_timestamp()
+ where id = :id
+   and deleted_at is null;

backend/resources/sql/icons.sql

@@ -0,0 +1,67 @@
+-- :name create-icon-collection :<! :1
+insert into icons_collections (id, "user", name)
+values (:id, :user, :name)
+returning *;
+
+-- :name update-icon-collection :<! :1
+update icons_collections
+   set name = :name,
+       version = :version
+ where id = :id
+   and "user" = :user
+returning *;
+
+-- :name get-icon-collections :? :*
+select *,
+       (select count(*) from icons where collection = ic.id) as num_icons
+  from icons_collections as ic
+ where ic."user" = :user
+   and ic.deleted_at is null
+ order by ic.created_at desc;
+
+-- :name delete-icon-collection :! :n
+update icons_collections
+   set deleted_at = clock_timestamp()
+ where id = :id and "user" = :user;
+
+-- :name get-icons-by-collection :? :*
+select *
+  from icons as i
+ where i."user" = :user
+   and i.deleted_at is null
+   and i."collection" = :collection
+ order by i.created_at desc;
+
+-- :name get-icons :? :*
+select * from icons
+ where "user" = :user
+   and deleted_at is null
+   and collection is null
+order by created_at desc;
+
+-- :name get-icon :? :1
+select * from icons
+ where id = :id
+   and deleted_at is null
+   and ("user" = :user or
+        "user" = '00000000-0000-0000-0000-000000000000'::uuid);
+
+-- :name create-icon :<! :1
+insert into icons ("user", name, collection, metadata, content)
+values (:user, :name, :collection, :metadata, :content)
+returning *;
+
+-- :name update-icon :<! :1
+update icons
+   set name = :name,
+       collection = :collection,
+       version = :version
+ where id = :id
+   and "user" = :user
+returning *;
+
+-- :name delete-icon :! :n
+update icons
+   set deleted_at = clock_timestamp()
+ where id = :id
+   and "user" = :user;

backend/resources/sql/images.sql

@@ -0,0 +1,66 @@
+-- :name create-image-collection :<! :1
+insert into images_collections (id, "user", name)
+values (:id, :user, :name)
+returning *;
+
+-- :name update-image-collection :<! :1
+update images_collections
+   set name = :name,
+       version = :version
+ where id = :id
+   and "user" = :user
+returning *;
+
+-- :name get-image-collections :? :*
+select *,
+       (select count(*) from images where collection = ic.id) as num_images
+  from images_collections as ic
+ where ic."user" = :user
+   and ic.deleted_at is null
+ order by ic.created_at desc;
+
+-- :name delete-image-collection :! :n
+update images_collections
+   set deleted_at = clock_timestamp()
+ where id = :id
+   and "user" = :user;
+
+-- :name get-images-by-collection :? :*
+select * from images
+ where "user" = :user
+   and deleted_at is null
+   and collection = :collection
+order by created_at desc;
+
+-- :name get-images :? :*
+select * from images
+ where "user" = :user
+   and deleted_at is null
+   and collection is null
+order by created_at desc;
+
+-- :name get-image :? :1
+select * from images
+ where id = :id
+   and deleted_at is null
+   and ("user" = :user or
+        "user" = '00000000-0000-0000-0000-000000000000'::uuid);
+
+-- :name create-image :<! :1
+insert into images ("user", name, collection, path, width, height, mimetype)
+values (:user, :name, :collection, :path, :width, :height, :mimetype)
+returning *;
+
+-- :name update-image :<! :1
+update images
+   set name = :name,
+       collection = :collection,
+       version = :version
+ where id = :id
+   and "user" = :user
+returning *;
+
+-- :name delete-image :! :n
+update images
+   set deleted_at = clock_timestamp()
+ where id = :id and "user" = :user;

backend/resources/sql/kvstore.sql

@@ -0,0 +1,17 @@
+-- :name update-kvstore :<! :1
+insert into kvstore (key, value, "user")
+values (:key, :value, :user)
+    on conflict ("user", key)
+    do update set value = :value, version = :version
+returning *;
+
+-- :name retrieve-kvstore :? :1
+select kv.*
+  from kvstore as kv
+ where kv."user" = :user
+   and kv.key = :key;
+
+-- :name delete-kvstore :! :n
+delete from kvstore
+ where "user" = :user
+   and key = :key;

backend/resources/sql/pages.sql

@@ -0,0 +1,89 @@
+-- :name create-page :<! :1
+insert into pages (id, "user", project, name, data, metadata)
+values (:id, :user, :project, :name, :data, :metadata)
+returning *;
+
+-- :name update-page :<! :1
+update pages
+   set name = :name,
+       data = :data,
+       version = :version,
+       metadata = :metadata
+ where id = :id
+   and "user" = :user
+   and deleted_at is null
+returning *;
+
+-- :name update-page-metadata :<! :1
+update pages
+   set name = :name,
+       version = :version,
+       metadata = :metadata
+ where id = :id
+   and "user" = :user
+   and deleted_at is null
+returning *;
+
+-- :name delete-page :! :n
+update pages
+   set deleted_at = clock_timestamp()
+ where id = :id
+   and "user" = :user
+   and deleted_at is null;
+
+-- :name get-pages :? :*
+select pg.* from pages as pg
+ where pg.user = :user
+   and pg.deleted_at is null
+ order by created_at asc;
+
+-- :name get-page-by-id :? :1
+select pg.* from pages as pg
+ where pg.id = :id
+   and pg.deleted_at is null;
+
+-- :name get-pages-for-user-and-project :? :*
+select pg.*,
+       (row_number() OVER (order by created_at asc) -1) as index
+  from pages as pg
+ where pg.user = :user
+   and pg.project = :project
+   and pg.deleted_at is null
+ order by pg.created_at asc;
+
+-- :name get-pages-for-project :? :*
+select pg.*,
+       (row_number() OVER (order by created_at asc) -1) as index
+  from pages as pg
+ where pg.project = :project
+   and pg.deleted_at is null
+ order by created_at asc;
+
+-- :name create-page-history :! :n
+insert into page_history (id, "user", page, pinned, label, data, version);
+values (:id, :user, :page, :pinned :label, :data, :version);
+
+-- :name get-page-history :? :*
+select ph.*
+  from pages_history as ph
+ where ph.user = :user
+   and ph.page = :page
+   and ph.version < :since
+--~ (when (:pinned params) "and ph.pinned = true")
+ order by ph.version desc
+ limit :max;
+
+-- :name get-page-history-for-project :? :*
+select ph.*
+  from pages_history as ph
+ inner join pages as p
+       on (p.id = ph.page)
+ where p.project = :project;
+
+-- :name update-page-history :? :*
+update pages_history
+   set label = :label,
+       pinned = :pinned
+ where id = :id
+   and "user" = :user
+returning *;

backend/resources/sql/projects.sql

@@ -0,0 +1,64 @@
+-- :name create-project :<! :1
+insert into projects (id, "user", name)
+values (:id, :user, :name)
+returning *;
+
+-- :name update-project :<! :1
+update projects
+   set name = :name,
+       version = :version
+ where id = :id
+   and "user" = :user
+   and deleted_at is null
+returning *;
+
+-- :name delete-project :! :n
+update projects
+   set deleted_at = clock_timestamp()
+ where id = :id
+   and "user" = :user
+   and deleted_at is null;
+
+-- :name get-project-by-id :? :1
+select p.*
+  from projects as p
+ where p.id = :id
+   and p.deleted_at is null;
+
+-- :name get-projects :? :*
+select distinct
+       pr.*,
+       ps.token as share_token,
+       count(pg.id) over win as total_pages,
+       first_value(pg.id) over win as page_id,
+       first_value(pg.data) over win as page_data,
+       first_value(pg.name) over win as page_name,
+       first_value(pg.version) over win as page_version,
+       first_value(pg.created_at) over win as page_created_at,
+       first_value(pg.metadata) over win as page_metadata,
+       first_value(pg.modified_at) over win as page_modified_at
+  from projects as pr
+ inner join project_shares as ps
+         on (ps.project = pr.id)
+  left join pages as pg
+         on (pg.project = pr.id)
+ where pr.deleted_at is null
+   and pr."user" = :user
+window win as (partition by pr.id
+               order by pg.created_at
+               range between unbounded preceding
+                         and unbounded following)
+ order by pr.created_at asc;
+
+-- :name get-project-by-share-token :? :*
+select p.*
+  from projects as p
+ inner join project_shares as ps
+         on (p.id = ps.project)
+  where ps.token = :token;
+
+-- :name get-share-tokens-for-project
+select s.*
+  from project_shares as s
+ where s.project = :project
+ order by s.created_at desc;

backend/resources/sql/users.sql

@@ -0,0 +1,69 @@
+-- :name create-profile :<! :1
+insert into users (id, fullname, username, email, password, metadata, photo)
+values (:id, :fullname, :username, :email, :password, :metadata, '')
+returning *;
+
+-- :name get-profile :? :1
+select * from users
+ where id = :id
+   and deleted_at is null;
+
+-- :name get-profile-by-username :? :1
+select * from users
+ where (username = :username or email = :username)
+   and deleted_at is null;
+
+-- :name user-with-username-exists?
+select exists
+  (select * from users
+    where username = :username
+--~ (when (:id params) "and id != :id")
+    ) as val;
+
+-- :name user-with-email-exists?
+select exists
+  (select * from users
+    where email = :email
+--~ (when (:id params) "and id != :id")
+    ) as val;
+
+-- :name update-profile :<! :1
+update users
+   set username = :username,
+       email = :email,
+       fullname = :fullname,
+       metadata = :metadata
+ where id = :id
+   and deleted_at is null
+returning *;
+
+-- :name update-profile-password :! :n
+update users
+   set password = :password
+ where id = :id
+   and deleted_at is null
+
+-- :name update-profile-photo :! :n
+update users
+   set photo = :photo
+ where id = :id
+   and deleted_at is null
+
+-- :name create-recovery-token :! :n
+insert into user_pswd_recovery ("user", token)
+values (:user, :token);
+
+-- :name get-recovery-token
+select * from user_pswd_recovery
+ where used_at is null
+   and token = :token;
+
+-- :name recovery-token-exists? :? :1
+select exists (select * from user_pswd_recovery
+                where used_at is null
+                  and token = :token) as token_exists;
+
+-- :name mark-recovery-token-used :! :n
+update user_pswd_recovery
+   set used_at = clock_timestamp()
+ where token = :token;

backend/resources/sql/workers.sql

@@ -0,0 +1,53 @@
+-- :name acquire-task :? :1
+with recursive locked_tasks as (
+  select (j).*, pg_try_advisory_lock((j).id) as locked
+    from (
+      select j
+        from tasks as j
+       where queue = :queue
+         and status = 'pending'
+         and created_at <= now()
+       order by created_at, id
+       limit 1
+    ) as t1
+  union all (
+    select (j).*, pg_try_advisory_lock((j).id) as locked
+      from (
+        select (
+          select j
+            from tasks as j
+           where queue = :queue
+             and status = 'pending'
+             and created_at <= now()
+             and (created_at, id) > (locked_tasks.created_at, locked_tasks.id)
+          order by created_at, id
+          limit 1
+        ) as j
+        from locked_tasks
+        where locked_tasks.id is not null
+        limit 1
+      ) as t1
+  )
+)
+select id, status, error, created_at
+  from locked_tasks
+ where locked
+ limit 1;
+
+-- :name create-task :? :1
+insert into tasks (queue)
+values (:queue)
+returning *;
+
+-- :name mark-task-done
+update tasks
+   set status = 'completed',
+       completed_at = clock_timestamp()
+ where id = :id;
+
+-- :name mark-task-failed
+update tasks
+   set status = 'failed',
+       error = :error,
+       completed_at = clock_timestamp()
+ where id = :id;

backend/scripts/fixtures.sh

@@ -0,0 +1,2 @@
+#!/usr/bin/env bash
+lein run -m uxbox.fixtures/init

backend/scripts/run.sh

@@ -0,0 +1,3 @@
+#!/usr/bin/env bash
+export PATH=/opt/img/bin:$PATH
+lein trampoline run -m uxbox.main

backend/scripts/smtpd.sh

@@ -0,0 +1,2 @@
+#!/usr/bin/env bash
+python -m smtpd -n -c DebuggingServer localhost:25

backend/src/data_readers.clj

@@ -0,0 +1 @@
+{instant uxbox.util.time/from-string}

backend/src/uxbox/cli/collimp.clj

@@ -0,0 +1,172 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.cli.collimp
+  "Collection importer command line helper."
+  (:require [clojure.spec :as s]
+            [clojure.pprint :refer [pprint]]
+            [clojure.java.io :as io]
+            [mount.core :as mount]
+            [cuerdas.core :as str]
+            [suricatta.core :as sc]
+            [storages.core :as st]
+            [storages.util :as fs]
+            [uxbox.config]
+            [uxbox.db :as db]
+            [uxbox.migrations]
+            [uxbox.media :as media]
+            [uxbox.cli.sql :as sql]
+            [uxbox.util.spec :as us]
+            [uxbox.util.cli :as cli]
+            [uxbox.util.uuid :as uuid]
+            [uxbox.util.data :as data])
+  (:import [java.io Reader PushbackReader]
+           [javax.imageio ImageIO]))
+
+;; --- Constants & Specs
+
+(def ^:const +imates-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6e")
+
+(s/def ::name string?)
+(s/def ::type keyword?)
+(s/def ::path string?)
+(s/def ::regex us/regex?)
+
+(s/def ::import-entry
+  (s/keys :req-un [::name ::type ::path ::regex]))
+
+;; --- CLI Helpers
+
+
+(defn printerr
+  [& args]
+  (binding [*out* *err*]
+    (apply println args)))
+
+(defn pushback-reader
+  [reader]
+  (PushbackReader. ^Reader reader))
+
+;; --- Colors Collections Importer
+
+(def storage media/images-storage)
+
+(defn- create-image-collection
+  "Create or replace image collection by its name."
+  [conn {:keys [name] :as entry}]
+  (let [id (uuid/namespaced +imates-uuid-ns+ name)
+        sqlv (sql/create-image-collection {:id id :name name})]
+    (sc/execute conn sqlv)
+    id))
+
+(defn- retrieve-image-size
+  [path]
+  (let [path (fs/path path)
+        file (.toFile path)
+        buff (ImageIO/read file)]
+    [(.getWidth buff)
+     (.getHeight buff)]))
+
+(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})]
+    @(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/base-name localpath)
+        [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 [imageid (uuid/namespaced +imates-uuid-ns+ (str id fpath))]
+    (if-let [image (retrieve-image conn imageid)]
+      (do
+        (delete-image conn image)
+        (create-image conn id imageid fpath))
+      (create-image conn id imageid fpath))))
+
+(defn- process-images-entry
+  [conn {:keys [path regex] :as entry}]
+  {:pre [(s/valid? ::import-entry entry)]}
+  (let [id (uuid/random) #_(create-image-collection conn entry)]
+    (doseq [fpath (fs/list-files path)]
+      (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/only #{#'uxbox.config/config
+                    #'uxbox.db/datasource
+                    #'uxbox.migrations/migrations})
+      (mount/start)))
+
+(defn- stop-system
+  []
+  (mount/stop))
+
+(defn- run-importer
+  [directory data]
+  (println "Running importer on:")
+  (pprint data))
+
+(defn -main
+  [& [path]]
+  (let [[directory data] (read-import-file path)]
+    (start-system)
+    (try
+      (run-importer directory data)
+      (finally
+        (stop-system)))))

backend/src/uxbox/cli/sql.clj

@@ -0,0 +1,4 @@
+(ns uxbox.cli.sql
+  (:require [hugsql.core :as hugsql]))
+
+(hugsql/def-sqlvec-fns "sql/cli.sql" {:quoting :ansi :fn-suffix ""})

backend/src/uxbox/config.clj

@@ -0,0 +1,52 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.config
+  "A configuration management."
+  (:require [mount.core :refer [defstate]]
+            [environ.core :refer (env)]
+            [buddy.core.hash :as hash]
+            [clojure.java.io :as io]
+            [clojure.edn :as edn]
+            [uxbox.util.exceptions :as ex]
+            [uxbox.util.data :refer [deep-merge]]))
+
+;; --- Configuration Loading & Parsing
+
+(def ^:dynamic *default-config-path* "config/default.edn")
+(def ^:dynamic *local-config-path* "config/local.edn")
+
+(defn read-config
+  []
+  (let [builtin (io/resource *default-config-path*)
+        local (io/resource *local-config-path*)
+        external (io/file (:uxbox-config env))]
+    (deep-merge (edn/read-string (slurp builtin))
+                (when local (edn/read-string (slurp local)))
+                (when (and external (.exists external))
+                  (edn/read-string (slurp external))))))
+
+(defn read-test-config
+  []
+  (binding [*local-config-path* "config/test.edn"]
+    (read-config)))
+
+(defstate config
+  :start (read-config))
+
+;; --- Secret Loading & Parsing
+
+(defn- initialize-secret
+  [config]
+  (let [secret (:secret config)]
+    (when-not secret
+      (ex/raise :code ::missing-secret-key
+                :message "Missing `:secret` key in config."))
+    (hash/blake2b-256 secret)))
+
+(defstate secret
+  :start (initialize-secret config))
+

backend/src/uxbox/db.clj

@@ -0,0 +1,89 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.db
+  "Database access layer for UXBOX."
+  (:require [mount.core :as mount :refer (defstate)]
+            [promesa.core :as p]
+            [hikari-cp.core :as hikari]
+            [executors.core :as exec]
+            [suricatta.core :as sc]
+            [suricatta.proto :as scp]
+            [suricatta.types :as sct]
+            [suricatta.transaction :as sctx]
+            [uxbox.config :as cfg])
+  (:import org.jooq.TransactionContext
+           org.jooq.TransactionProvider
+           org.jooq.Configuration))
+
+;; --- State
+
+(def ^:const +defaults+
+  {:connection-timeout 30000
+   :idle-timeout 600000
+   :max-lifetime 1800000
+   :minimum-idle 10
+   :maximum-pool-size 10
+   :adapter "postgresql"
+   :username ""
+   :password ""
+   :database-name ""
+   :server-name "localhost"
+   :port-number 5432})
+
+(defn create-datasource
+  [config]
+  (let [dbconf (merge +defaults+ config)]
+    (hikari/make-datasource dbconf)))
+
+(defstate datasource
+  :start (create-datasource (:database cfg/config))
+  :stop (hikari/close-datasource datasource))
+
+;; --- Suricatta Async Adapter
+
+(defn transaction
+  "Asynchronous transaction handling."
+  {:internal true}
+  [ctx func]
+  (let [^Configuration conf (.derive (scp/-config ctx))
+        ^TransactionContext txctx (sctx/transaction-context conf)
+        ^TransactionProvider provider (.transactionProvider conf)]
+    (doto conf
+      (.data "suricatta.rollback" false)
+      (.data "suricatta.transaction" true))
+    (try
+      (.begin provider txctx)
+      (->> (func (sct/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
+  [& args]
+  (exec/submit #(apply sc/fetch args)))
+
+(defn execute
+  [& args]
+  (exec/submit #(apply sc/execute args)))

backend/src/uxbox/emails.clj

@@ -0,0 +1,14 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.emails
+  "Main api for send emails."
+  (:require [uxbox.emails.core :as core]))
+
+(def send! core/send!)
+(def render core/render)
+
+(load "emails/users")

backend/src/uxbox/emails/core.clj

@@ -0,0 +1,89 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.emails.core
+  (:require [hiccup.core :refer (html)]
+            [hiccup.page :refer (html4)]
+            [suricatta.core :as sc]
+            [uxbox.db :as db]
+            [uxbox.config :as cfg]
+            [uxbox.sql :as sql]
+            [uxbox.emails.layouts :as layouts]
+            [uxbox.util.blob :as blob]
+            [uxbox.util.transit :as t]))
+
+(def emails
+  "A global state for registring emails."
+  (atom {}))
+
+(defmacro defemail
+  [type & args]
+  (let [email (apply hash-map args)]
+    `(do
+       (swap! emails assoc ~type ~email)
+       nil)))
+
+(defn- render-subject
+  [{:keys [subject]} context]
+  (cond
+    (delay? subject) (deref subject)
+    (ifn? subject) (subject context)
+    (string? subject) subject
+    :else (throw (ex-info "Invalid subject." {}))))
+
+(defn- render-body
+  [[type bodyfn] layout context]
+  (let [layoutfn (get layout type)]
+    {:content (cond-> (bodyfn context)
+                layoutfn (layoutfn context)
+                (= type :text/html) (html4))
+     ::type type
+     :type (subs (str type) 1)}))
+
+(defn- render-body-alternatives
+  [{:keys [layout body] :as email} context]
+  (reduce #(conj %1 (render-body %2 layout context)) [:alternatives] body))
+
+(defn render-email
+  [email context]
+  (let [config (:email cfg/config)
+        from (or (:email/from context)
+                 (:from config))
+        reply-to (or (:email/reply-to context)
+                     (:reply-to 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)))))

backend/src/uxbox/emails/layouts.clj

@@ -0,0 +1,228 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.emails.layouts
+  (:require [uxbox.media :as md]))
+
+(def default-embedded-styles
+  "/* GLOBAL */
+   * {
+     margin:0;
+     padding:0;
+     font-family: Arial, sans-serif;
+     font-size: 100%;
+     line-height: 1.6;
+   }
+
+   img {
+     max-width: 100%;
+     width: 100%;
+   }
+
+   .img-header {
+     border-top-left-radius: 5px;
+     border-top-right-radius: 5px;
+   }
+
+   body {
+     -webkit-font-smoothing:antialiased;
+     -webkit-text-size-adjust:none;
+     width: 100%!important;
+     height: 100%;
+   }
+
+   /* ELEMENTS */
+   a {
+     color: #78dbbe;
+     text-decoration:none;
+     font-weight: bold;
+   }
+
+   .btn-primary {
+     text-decoration:none;
+     color: #fff;
+     background-color: #78dbbe;
+     padding: 10px 30px;
+     font-weight: bold;
+     margin: 20px 0;
+     text-align: center;
+     cursor: pointer;
+     display: inline-block;
+     border-radius: 4px;
+   }
+
+   .btn-primary:hover {
+     color: #FFF;
+     background-color: #8eefcf;
+   }
+
+   .last {
+     margin-bottom: 0;
+   }
+
+   .first{
+     margin-top: 0;
+   }
+
+   .logo {
+     background-color: #f6f6f6;
+     padding: 10px;
+     text-align: center;
+     padding-bottom: 25px;
+   }
+   .logo h2 {
+     color: #777;
+     font-size: 20px;
+     font-weight: bold;
+     margin-top: 15px;
+   }
+   .logo img {
+     max-width: 150px;
+   }
+
+   /* BODY */
+   table.body-wrap {
+     width: 100%;
+     padding: 20px;
+   }
+
+   table.body-wrap .container{
+     border-radius: 5px;
+     color: #ababab;
+   }
+
+
+   /* FOOTER */
+   table.footer-wrap {
+     width: 100%;
+     clear:both!important;
+   }
+
+   .footer-wrap .container p {
+     font-size: 12px;
+     color:#666;
+
+   }
+
+   table.footer-wrap a{
+     color: #999;
+   }
+
+
+   /* TYPOGRAPHY */
+   h1,h2,h3{
+     font-family: Arial, sans-serif;
+     line-height: 1.1;
+     margin-bottom:15px;
+     color:#000;
+     margin: 40px 0 10px;
+     line-height: 1.2;
+     font-weight:200;
+   }
+
+   h1 {
+     color: #777;
+     font-size: 28px;
+     font-weight: bold;
+   }
+   h2 {
+     font-size: 24px;
+   }
+   h3 {
+     font-size: 18px;
+   }
+
+   p, ul {
+     margin-bottom: 10px;
+     font-weight: normal;
+   }
+
+   ul li {
+     margin-left:5px;
+     list-style-position: inside;
+   }
+
+   /* RESPONSIVE */
+
+   /* Set a max-width, and make it display as block so it will automatically stretch to that width, but will also shrink down on a phone or something */
+   .container {
+     display: block !important;
+     max-width: 620px !important;
+     margin: 0 auto !important; /* makes it centered */
+     clear: both !important;
+   }
+
+   /* This should also be a block element, so that it will fill 100% of the .container */
+   .content {
+     padding: 20px;
+     max-width: 620px;
+     margin: 0 auto;
+     display: block;
+   }
+
+   /* Let's make sure tables in the content area are 100% wide */
+   .content table {
+     width: 100%;
+   }")
+
+(defn- default-html
+  [body context]
+  [:html
+   [:head
+    [:meta {:http-equiv "Content-Type"
+            :content "text/html; charset=UTF-8"}]
+    [:meta {:name "viewport"
+            :content "width=device-width"}]
+    [:title "title"]
+    [:style default-embedded-styles]]
+   [:body {:bgcolor "#f6f6f6"
+           :cz-shortcut-listen "true"}
+    [:table.body-wrap
+     [:tbody
+      [:tr
+       [:td]
+       [:td.container {:bgcolor "#FFFFFF"}
+        [:div.logo
+         [:img {:src (md/resolve-asset "images/email/logo.png")
+                :alt "UXBOX"}]]
+        body]
+       [:td]]]]
+    [:table.footer-wrap
+     [:tbody
+      [:tr
+       [:td]
+       [:td.container
+        [:div.content
+         [:table
+          [:tbody
+           [:tr
+            [:td
+             [:div {:style "text-align: center;"}
+              [:a {:href "#" :target "_blank"}
+               [:img {:style "display: inline-block; width: 25px; margin-right: 5px;"
+                      :src (md/resolve-asset "images/email/twitter.png")}]]
+              [:a {:href "#" :target "_blank"}
+               [:img {:style "display: inline-block; width: 25px; margin-right: 5px;"
+                      :src (md/resolve-asset "images/email/facebook.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})

backend/src/uxbox/emails/users.clj

@@ -0,0 +1,77 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.emails.users
+  (:require [uxbox.media :as md]
+            [uxbox.emails.core :refer (defemail)]
+            [uxbox.emails.layouts :as layouts]))
+
+;; --- User Register
+
+(defn- register-body-html
+  [{:keys [name] :as ctx}]
+  [:div
+   [:img.img-header {:src (md/resolve-asset "images/email/img-header.jpg")
+                     :alt "UXBOX"}]
+   [:div.content
+    [:table
+     [:tbody
+      [:tr
+       [:td
+        [:h1 "Hi " name]
+        [:p "Welcome to uxbox."]
+        [:p
+         [:a.btn-primary {:href "#"} "Sign in"]]
+        [:p "Sincerely," [:br] [:strong "The UXBOX Team"]]
+        #_[:p "P.S. Having trouble signing up? please contact "
+         [:a {:href "#"} "Support email"]]]]]]]])
+
+(defn- register-body-text
+  [{:keys [name] :as ctx}]
+  (str "Hi " name "\n\n"
+       "Welcome to uxbox!\n\n"
+       "Sincerely, the UXBOX team.\n"))
+
+(defemail :users/register
+  :layout layouts/default
+  :subject "UXBOX: Welcome!"
+  :body {:text/html register-body-html
+         :text/plain register-body-text})
+
+;; --- Password Recovery
+
+(defn- password-recovery-body-html
+  [{:keys [name token] :as ctx}]
+  [:div
+   [:img.img-header {:src (md/resolve-asset "images/img-header.jpg")
+                     :alt "UXBOX"}]
+   [:div.content
+    [:table
+     [:tbody
+      [:tr
+       [:td
+        [:h1 "Hi " name]
+        [:p "A password recovery is requested."]
+        [:p
+         "Please, follow the following url in order to"
+         "change your password."
+         [:a {:href "#"} "http://uxbox.io/..."]]
+        [:p "Sincerely," [:br] [:strong "The UXBOX Team"]]]]]]]])
+
+(defn- password-recovery-body-text
+  [{:keys [name token] :as ctx}]
+  (str "Hi " name "\n\n"
+       "A password recovery is requested.\n\n"
+       "Please follow the following url in order to change the password:\n\n"
+       "  http://uxbox.io/recovery/" token "\n\n\n"
+       "Sincerely, the UXBOX team.\n"))
+
+(defemail :users/password-recovery
+  :layout layouts/default
+  :subject "Password recovery requested."
+  :body {:text/html password-recovery-body-html
+         :text/plain password-recovery-body-text})
+

backend/src/uxbox/fixtures.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) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.fixtures
+  "A initial fixtures."
+  (:require [buddy.hashers :as hashers]
+            [buddy.core.codecs :as codecs]
+            [catacumba.serializers :as sz]
+            [mount.core :as mount]
+            [clj-uuid :as uuid]
+            [suricatta.core :as sc]
+            [uxbox.config :as cfg]
+            [uxbox.db :as db]
+            [uxbox.migrations]
+            [uxbox.util.transit :as t]
+            [uxbox.services.users :as susers]
+            [uxbox.services.projects :as sproj]
+            [uxbox.services.pages :as spag]))
+
+(defn- mk-uuid
+  [prefix i]
+  (uuid/v5 uuid/+namespace-oid+ (str prefix i)))
+
+(defn- data-encode
+  [data]
+  (-> (t/encode data)
+      (codecs/bytes->str)))
+
+(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 (data-encode {})
+                       :password "123123"
+                       :email (str "user" i ".test@uxbox.io")}))
+
+(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)}))
+
+(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 nil
+                     :metadata {:width 1024
+                                :height 768
+                                :layout "tablet"}
+                     :name (str "page " i)}))
+
+(def num-users 50)
+(def num-projects 5)
+(def num-pages 5)
+
+(defn init
+  []
+  (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))

backend/src/uxbox/frontend.clj

@@ -0,0 +1,155 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend
+  (:require [mount.core :refer [defstate]]
+            [catacumba.core :as ct]
+            [catacumba.http :as http]
+            [catacumba.serializers :as sz]
+            [catacumba.handlers.auth :as cauth]
+            [catacumba.handlers.parse :as cparse]
+            [catacumba.handlers.misc :as cmisc]
+            [uxbox.config :as cfg]
+            [uxbox.frontend.auth :as auth]
+            [uxbox.frontend.users :as users]
+            [uxbox.frontend.errors :as errors]
+            [uxbox.frontend.projects :as projects]
+            [uxbox.frontend.pages :as pages]
+            [uxbox.frontend.images :as images]
+            [uxbox.frontend.icons :as icons]
+            [uxbox.frontend.kvstore :as kvstore]
+            [uxbox.frontend.svgparse :as svgparse]
+            [uxbox.frontend.debug-emails :as dbgemails]
+            [uxbox.util.response :refer [rsp]]
+            [uxbox.util.uuid :as uuid]))
+
+;; --- Top Level Handlers
+
+(defn- welcome-api
+  "A GET entry point for the api that shows
+  a welcome message."
+  [context]
+  (let [body {:message "Welcome to UXBox api."}]
+    (-> (sz/encode body :json)
+        (http/ok {:content-type "application/json"}))))
+
+(defn- debug-only
+  [context]
+  (if (-> cfg/config :server :debug)
+    (ct/delegate)
+    (http/not-found "")))
+
+;; --- Config
+
+(def cors-conf
+  {:origin "*"
+   :max-age 3600
+   :allow-methods #{:post :put :get :delete :trace}
+   :allow-headers #{:x-requested-with :content-type :authorization}})
+
+;; --- Routes
+
+(defn routes
+  ([] (routes cfg/config))
+  ([config]
+   (let [auth-opts {:secret cfg/secret
+                    :options (:auth-options cfg/config)}]
+     (ct/routes
+      [[:any (cauth/auth (cauth/jwe-backend auth-opts))]
+       [:any (cmisc/autoreloader)]
+
+       [:get "api" #'welcome-api]
+       [:assets "media" {:dir "public/media"}]
+       [:assets "static" {:dir "public/static"}]
+
+       [:prefix "debug"
+        [:any debug-only]
+        [:get "emails" #'dbgemails/list-emails]
+        [:get "emails/email" #'dbgemails/show-email]]
+
+       [:prefix "api"
+        [:any (cmisc/cors cors-conf)]
+        [:any (cparse/body-params)]
+        [:error #'errors/handler]
+
+        [:post "auth/token" #'auth/login]
+        [:post "auth/register" #'users/register-user]
+        [:get  "auth/recovery/:token" #'users/validate-recovery-token]
+        [:post "auth/recovery" #'users/request-recovery]
+        [:put  "auth/recovery" #'users/recover-password]
+
+        [:get "projects-by-token/:token" #'projects/retrieve-project-by-share-token]
+
+        ;; SVG Parse
+        [:post "svg/parse" #'svgparse/parse]
+
+        [:any #'auth/authorization]
+
+        ;; KVStore
+        [:put "kvstore" #'kvstore/update]
+        [:get "kvstore/:key" #'kvstore/retrieve]
+        [:delete "kvstore/:key" #'kvstore/delete]
+
+        ;; Projects
+        [:get "projects/:id/pages" #'pages/list-pages-by-project]
+        [:put "projects/:id" #'projects/update-project]
+        [:delete "projects/:id" #'projects/delete-project]
+        [:post "projects" #'projects/create-project]
+        [:get "projects" #'projects/list-projects]
+
+        ;; Image Collections
+        [:put "library/image-collections/:id" #'images/update-collection]
+        [:delete "library/image-collections/:id" #'images/delete-collection]
+        [:get "library/image-collections" #'images/list-collections]
+        [:post "library/image-collections" #'images/create-collection]
+        [:get "library/image-collections/:id/images" #'images/list-images]
+        [:get "library/image-collections/images" #'images/list-images]
+
+        ;; Images
+        [:put "library/images/copy" #'images/copy-image]
+        [:delete "library/images/:id" #'images/delete-image]
+        [:get "library/images/:id" #'images/retrieve-image]
+        [:put "library/images/:id" #'images/update-image]
+        [:post "library/images" #'images/create-image]
+
+        ;; Icon Collections
+        [:put "library/icon-collections/:id" #'icons/update-collection]
+        [:delete "library/icon-collections/:id" #'icons/delete-collection]
+        [:get "library/icon-collections" #'icons/list-collections]
+        [:post "library/icon-collections" #'icons/create-collection]
+        [:get "library/icon-collections/:id/icons" #'icons/list-icons]
+        [:get "library/icon-collections/icons" #'icons/list-icons]
+
+        ;; Icons
+        [:put "library/icons/copy" #'icons/copy-icon]
+        [:delete "library/icons/:id" #'icons/delete-icon]
+        [:put "library/icons/:id" #'icons/update-icon]
+        [:post "library/icons" #'icons/create-icon]
+
+        ;; Pages
+        [:put "pages/:id/metadata" #'pages/update-page-metadata]
+        [:get "pages/:id/history" #'pages/retrieve-page-history]
+        [:put "pages/:id/history/:hid" #'pages/update-page-history]
+        [:put "pages/:id" #'pages/update-page]
+        [:delete "pages/:id" #'pages/delete-page]
+        [:post "pages" #'pages/create-page]
+
+        ;; Profile
+        [:get "profile/me" #'users/retrieve-profile]
+        [:put "profile/me" #'users/update-profile]
+        [:put "profile/me/password" #'users/update-password]
+        [:post "profile/me/photo" #'users/update-photo]]]))))
+
+;; --- State Initialization
+
+(defn- start-server
+  [config]
+  (let [config (:http config)]
+    (ct/run-server (routes config) config)))
+
+(defstate server
+  :start (start-server cfg/config)
+  :stop (.stop server))

backend/src/uxbox/frontend/auth.clj

@@ -0,0 +1,33 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.auth
+  (:require [clojure.spec :as s]
+            [catacumba.core :as ct]
+            [catacumba.http :as http]
+            [promesa.core :as p]
+            [uxbox.util.spec :as us]
+            [uxbox.services :as sv]
+            [uxbox.util.uuid :as uuid]
+            [uxbox.util.response :refer (rsp)]))
+
+(s/def ::scope string?)
+(s/def ::login (s/keys :req-un [::us/username ::us/password ::scope]))
+
+(defn login
+  [{data :data}]
+  (let [data (us/conform ::login data)
+        message (assoc data :type :login)]
+    (->> (sv/novelty message)
+         (p/map #(http/ok (rsp %))))))
+
+;; TODO: improve authorization
+
+(defn authorization
+  [{:keys [identity] :as context}]
+  (if identity
+    (ct/delegate {:identity (uuid/from-string (:id identity))})
+    (http/forbidden (rsp nil))))

backend/src/uxbox/frontend/debug_emails.clj

@@ -0,0 +1,68 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.debug-emails
+  "A helper namespace for just render emails."
+  (:require [clojure.edn :as edn]
+            [catacumba.http :as http]
+            [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"}))))

backend/src/uxbox/frontend/errors.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) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.errors
+  "A errors handling for frontend api."
+  (:require [catacumba.core :as ct]
+            [catacumba.http :as http]
+            [uxbox.util.response :refer (rsp)]))
+
+(defmulti handle-exception #(:type (ex-data %)))
+
+(defmethod handle-exception :validation
+  [err]
+  (println "\n*********** stack trace ***********")
+  (.printStackTrace err)
+  (println "\n********* end stack trace *********")
+  (let [response (ex-data err)]
+    (http/bad-request (rsp response))))
+
+(defmethod handle-exception :default
+  [err]
+  (println "\n*********** stack trace ***********")
+  (.printStackTrace err)
+  (println "\n********* end stack trace *********")
+  (let [response (ex-data err)]
+    (http/internal-server-error (rsp response))))
+
+;; --- Entry Point
+
+(defn- handle-data-access-exception
+  [err]
+  (let [err (.getCause err)
+        state (.getSQLState err)
+        message (.getMessage err)]
+    (case state
+      "P0002"
+      (-> (rsp {:message message
+                :payload nil
+                :type :occ})
+          (http/precondition-failed))
+
+      (do
+        (.printStackTrace err)
+        (-> (rsp {:message message
+                  :type :unexpected
+                  :payload nil})
+            (http/internal-server-error))))))
+
+(defn- handle-unexpected-exception
+  [err]
+  (.printStackTrace err)
+  (let [message (.getMessage err)]
+    (-> (rsp {:message message
+              :type :unexpected
+              :payload nil})
+        (http/internal-server-error))))
+
+(defn handler
+  [context err]
+  (cond
+    (instance? clojure.lang.ExceptionInfo err)
+    (handle-exception err)
+
+    (instance? java.util.concurrent.CompletionException err)
+    (handler context (.getCause err))
+
+    (instance? org.jooq.exception.DataAccessException err)
+    (handle-data-access-exception err)
+
+    :else
+    (handle-unexpected-exception err)))

backend/src/uxbox/frontend/icons.clj

@@ -0,0 +1,156 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.icons
+  (:require [clojure.spec :as s]
+            [promesa.core :as p]
+            [catacumba.http :as http]
+            [storages.core :as st]
+            [uxbox.util.spec :as us]
+            [uxbox.services :as sv]
+            [uxbox.util.response :refer (rsp)]
+            [uxbox.util.uuid :as uuid]))
+
+;; --- Constants & Config
+
+(s/def ::collection (s/nilable ::us/uuid-string))
+
+(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 ::mimetype string?)
+(s/def ::metadata
+  (s/keys :opt-un [::width ::height ::view-box ::mimetype]))
+
+(s/def ::content string?)
+
+;; --- Create Collection
+
+(s/def ::create-collection
+  (s/keys :req-un [::us/name] :opt-un [::us/id]))
+
+(defn create-collection
+  [{user :identity data :data}]
+  (let [data (us/conform ::create-collection data)
+        message (assoc data
+                       :type :create-icon-collection
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map (fn [result]
+                  (let [loc (str "/api/library/icons/" (:id result))]
+                    (http/created loc (rsp result))))))))
+
+;; --- Update Collection
+
+(s/def ::update-collection
+  (s/merge ::create-collection (s/keys :req-un [::us/version])))
+
+(defn update-collection
+  [{user :identity params :route-params data :data}]
+  (let [data (us/conform ::update-collection data)
+        message (assoc data
+                       :id (uuid/from-string (:id params))
+                       :type :update-icon-collection
+                       :user user)]
+    (-> (sv/novelty message)
+        (p/then #(http/ok (rsp %))))))
+
+;; --- Delete Collection
+
+(defn delete-collection
+  [{user :identity params :route-params}]
+  (let [message {:id (uuid/from-string (:id params))
+                 :type :delete-icon-collection
+                 :user user}]
+    (-> (sv/novelty message)
+        (p/then (fn [v] (http/no-content))))))
+
+;; --- List collections
+
+(defn list-collections
+  [{user :identity}]
+  (let [params {:user user
+                :type :list-icon-collections}]
+    (-> (sv/query params)
+        (p/then #(http/ok (rsp %))))))
+
+;; --- Create Icon
+
+(s/def ::create-icon
+  (s/keys :req-un [::metadata ::us/name ::metadata ::content]
+          :opt-un [::us/id ::collection]))
+
+(defn create-icon
+  [{user :identity data :data :as request}]
+  (let [{:keys [id name content metadata collection]} (us/conform ::create-icon data)
+        id (or id (uuid/random))]
+    (->> (sv/novelty {:id id
+                      :type :create-icon
+                      :user user
+                      :name name
+                      :collection collection
+                      :metadata metadata
+                      :content content})
+         (p/map (fn [entry]
+                  (let [loc (str "/api/library/icons/" (:id entry))]
+                    (http/created loc (rsp entry))))))))
+
+;; --- Update Icon
+
+(s/def ::update-icon
+  (s/keys :req-un [::us/name ::us/version ::collection] :opt-un [::us/id]))
+
+(defn update-icon
+  [{user :identity params :route-params data :data}]
+  (let [data (us/conform ::update-icon data)
+        message (assoc data
+                       :id (uuid/from-string (:id params))
+                       :type :update-icon
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Copy Icon
+
+(s/def ::copy-icon
+  (s/keys :req-un [:us/id ::collection]))
+
+(defn copy-icon
+  [{user :identity data :data}]
+  (let [data (us/conform ::copy-icon data)
+        message (assoc data
+                       :user user
+                       :type :copy-icon)]
+    (->> (sv/novelty message)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Delete Icon
+
+(defn delete-icon
+  [{user :identity params :route-params}]
+  (let [message {:id (uuid/from-string (:id params))
+                 :type :delete-icon
+                 :user user}]
+    (->> (sv/novelty message)
+         (p/map (fn [v] (http/no-content))))))
+
+;; --- List collections
+
+(s/def ::list-icons
+  (s/keys :opt-un [::us/id]))
+
+(defn list-icons
+  [{user :identity route-params :route-params}]
+  (let [{:keys [id]} (us/conform ::list-icons route-params)
+        params {:collection id
+                :type :list-icons
+                :user user}]
+    (->> (sv/query params)
+         (p/map rsp)
+         (p/map http/ok))))

backend/src/uxbox/frontend/images.clj

@@ -0,0 +1,196 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.images
+  (:require [clojure.spec :as s]
+            [promesa.core :as p]
+            [catacumba.http :as http]
+            [storages.core :as st]
+            [storages.util :as path]
+            [uxbox.media :as media]
+            [uxbox.images :as images]
+            [uxbox.util.spec :as us]
+            [uxbox.services :as sv]
+            [uxbox.util.response :refer (rsp)]
+            [uxbox.util.uuid :as uuid]))
+
+;; --- Constants & Config
+
+(s/def ::file ::us/uploaded-file)
+(s/def ::width ::us/integer-string)
+(s/def ::height ::us/integer-string)
+(s/def ::collection (s/nilable ::us/uuid-string))
+(s/def ::mimetype string?)
+
+(def +thumbnail-options+ {:src :path
+                          :dst :thumbnail
+                          :size [300 110]
+                          :quality 92
+                          :format "webp"})
+
+(def populate-thumbnails
+  #(images/populate-thumbnails % +thumbnail-options+))
+
+(def populate-urls
+  #(images/populate-urls % media/images-storage :path :url))
+
+;; --- Create Collection
+
+(s/def ::create-collection
+  (s/keys :req-un [::us/name] :opt-un [::us/id]))
+
+(defn create-collection
+  [{user :identity data :data}]
+  (let [data (us/conform ::create-collection data)
+        message (assoc data
+                       :type :create-image-collection
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map (fn [result]
+                  (let [loc (str "/api/library/images/" (:id result))]
+                    (http/created loc (rsp result))))))))
+
+;; --- Update Collection
+
+(s/def ::update-collection
+  (s/merge ::create-collection (s/keys :req-un [::us/version])))
+
+(defn update-collection
+  [{user :identity params :route-params data :data}]
+  (let [data (us/conform ::update-collection data)
+        message (assoc data
+                       :id (uuid/from-string (:id params))
+                       :type :update-image-collection
+                       :user user)]
+    (-> (sv/novelty message)
+        (p/then #(http/ok (rsp %))))))
+
+;; --- Delete Collection
+
+(defn delete-collection
+  [{user :identity params :route-params}]
+  (let [message {:id (uuid/from-string (:id params))
+                 :type :delete-image-collection
+                 :user user}]
+    (-> (sv/novelty message)
+        (p/then (fn [v] (http/no-content))))))
+
+;; --- List collections
+
+(defn list-collections
+  [{user :identity}]
+  (let [params {:user user
+                :type :list-image-collections}]
+    (-> (sv/query params)
+        (p/then #(http/ok (rsp %))))))
+
+;; --- Retrieve Image
+
+(s/def ::retrieve-image
+  (s/keys :req-un [::us/id]))
+
+(defn retrieve-image
+  [{user :identity params :route-params}]
+  (let [params (us/conform ::retrieve-image params)
+        params (assoc params :user user :type :retrieve-image)]
+    (->> (sv/query params)
+         (p/map (fn [result]
+                  (if result
+                    (-> (populate-thumbnails result)
+                        (populate-urls)
+                        (rsp)
+                        (http/ok))
+                    (http/not-found "")))))))
+
+;; --- Create Image
+
+(s/def ::create-image
+  (s/keys :req-un [::file ::width ::height ::mimetype]
+          :opt-un [::us/id ::collection]))
+
+(defn create-image
+  [{user :identity data :data}]
+  (let [{:keys [file id width height
+                mimetype collection]} (us/conform ::create-image data)
+        id (or id (uuid/random))
+        filename (path/base-name file)
+        storage media/images-storage]
+    (letfn [(persist-image-entry [path]
+              (sv/novelty {:id id
+                           :type :create-image
+                           :user user
+                           :width width
+                           :height height
+                           :mimetype mimetype
+                           :collection collection
+                           :name filename
+                           :path (str path)}))
+            (create-response [entry]
+              (let [loc (str "/api/library/images/" (:id entry))]
+                (http/created loc (rsp entry))))]
+      (->> (st/save storage filename file)
+           (p/mapcat persist-image-entry)
+           (p/map populate-thumbnails)
+           (p/map populate-urls)
+           (p/map create-response)))))
+
+;; --- Update Image
+
+(s/def ::update-image
+  (s/keys :req-un [::us/name ::us/version ::collection] :opt-un [::us/id]))
+
+(defn update-image
+  [{user :identity params :route-params data :data}]
+  (let [data (us/conform ::update-image data)
+        message (assoc data
+                       :id (uuid/from-string (:id params))
+                       :type :update-image
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map populate-thumbnails)
+         (p/map populate-urls)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Copy Image
+
+(s/def ::copy-image
+  (s/keys :req-un [::us/id ::collection]))
+
+(defn copy-image
+  [{user :identity data :data}]
+  (let [data (us/conform ::copy-image data)
+        params (assoc data :user user :type :copy-image)]
+    (->> (sv/novelty params)
+         (p/map populate-thumbnails)
+         (p/map populate-urls)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Delete Image
+
+(defn delete-image
+  [{user :identity params :route-params}]
+  (let [message {:id (uuid/from-string (:id params))
+                 :type :delete-image
+                 :user user}]
+    (->> (sv/novelty message)
+         (p/map (fn [v] (http/no-content))))))
+
+;; --- List collections
+
+(s/def ::list-images
+  (s/keys :opt-un [::us/id]))
+
+(defn list-images
+  [{user :identity route-params :route-params}]
+  (let [{:keys [id]} (us/conform ::list-images route-params)
+        params {:collection id
+                :type :list-images
+                :user user}]
+    (->> (sv/query params)
+         (p/map (partial map populate-thumbnails))
+         (p/map (partial map populate-urls))
+         (p/map rsp)
+         (p/map http/ok))))

backend/src/uxbox/frontend/kvstore.clj

@@ -0,0 +1,60 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.kvstore
+  (:refer-clojure :exclude [update])
+  (:require [clojure.spec :as s]
+            [promesa.core :as p]
+            [catacumba.http :as http]
+            [uxbox.media :as media]
+            [uxbox.util.spec :as us]
+            [uxbox.services :as sv]
+            [uxbox.util.response :refer (rsp)]
+            [uxbox.util.uuid :as uuid]))
+
+(s/def ::version integer?)
+(s/def ::key string?)
+(s/def ::value any?)
+
+;; --- Retrieve
+
+(s/def ::retrieve (s/keys :req-un [::key]))
+
+(defn retrieve
+  [{user :identity params :route-params}]
+  (let [data (us/conform ::retrieve params)
+        params (assoc data
+                      :type :retrieve-kvstore
+                      :user user)]
+    (->> (sv/query params)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Update (or Create)
+
+(s/def ::update (s/keys :req-un [::key ::value]
+                        :opt-un [::version]))
+
+(defn update
+  [{user :identity data :data}]
+  (let [data (us/conform ::update data)
+        params (assoc data
+                      :type :update-kvstore
+                      :user user)]
+    (->> (sv/novelty params)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Delete
+
+(s/def ::delete (s/keys :req-un [::key]))
+
+(defn delete
+  [{user :identity params :route-params}]
+  (let [data (us/conform ::delete params)
+        params (assoc data
+                      :type :delete-kvstore
+                      :user user)]
+    (->> (sv/novelty params)
+         (p/map (fn [_] (http/no-content))))))

backend/src/uxbox/frontend/pages.clj

@@ -0,0 +1,119 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.pages
+  (:require [clojure.spec :as s]
+            [promesa.core :as p]
+            [catacumba.http :as http]
+            [uxbox.util.spec :as us]
+            [uxbox.services :as sv]
+            [uxbox.util.response :refer (rsp)]
+            [uxbox.util.uuid :as uuid]))
+
+;; --- List Pages
+
+(defn list-pages-by-project
+  [{user :identity params :route-params}]
+  (let [params {:user user
+                :project (uuid/from-string (:id params))
+                :type :list-pages-by-project}]
+    (-> (sv/query params)
+        (p/then #(http/ok (rsp %))))))
+
+;; --- Create Page
+
+(s/def ::data any?)
+(s/def ::metadata any?)
+(s/def ::project ::us/id)
+(s/def ::create-page
+  (s/keys :req-un [::data ::metadata ::project ::us/name]
+          :opt-un [::us/id]))
+
+(defn create-page
+  [{user :identity data :data}]
+  (let [data (us/conform ::create-page data)
+        message (assoc data
+                       :type :create-page
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map (fn [result]
+                  (let [loc (str "/api/pages/" (:id result))]
+                    (http/created loc (rsp result))))))))
+
+;; --- Update Page
+
+(s/def ::update-page
+  (s/merge ::create-page (s/keys :req-un [::us/version])))
+
+(defn update-page
+  [{user :identity params :route-params data :data}]
+  (let [data (us/conform ::update-page data)
+        message (assoc data
+                       :id (uuid/from-string (:id params))
+                       :type :update-page
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Update Page Metadata
+
+(s/def ::update-page-metadata
+  (s/keys :req-un [::us/id ::metadata ::project ::us/name]))
+
+(defn update-page-metadata
+  [{user :identity params :route-params data :data}]
+  (let [data (us/conform ::update-page-metadata data)
+        message (assoc data
+                       :id (uuid/from-string (:id params))
+                       :type :update-page-metadata
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Delete Page
+
+(defn delete-page
+  [{user :identity params :route-params}]
+  (let [message {:id (uuid/from-string (:id params))
+                 :type :delete-page
+                 :user user}]
+    (-> (sv/novelty message)
+        (p/then (fn [v] (http/no-content))))))
+
+;; --- Retrieve Page History
+
+(s/def ::max (s/and ::us/integer-string ::us/positive-integer))
+(s/def ::since ::us/integer-string)
+(s/def ::pinned ::us/boolean-string)
+
+(s/def ::retrieve-page-history
+  (s/keys :opt-un [::max ::since ::pinned]))
+
+(defn retrieve-page-history
+  [{user :identity params :route-params query :query-params}]
+  (let [query (us/conform ::retrieve-page-history query)
+        message (assoc query
+                       :id (uuid/from-string (:id params))
+                       :type :list-page-history
+                       :user user)]
+    (->> (sv/query message)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Update Page History
+
+(s/def ::label string?)
+(s/def ::update-page-history
+  (s/keys :req-un [::label ::pinned]))
+
+(defn update-page-history
+  [{user :identity params :route-params data :data}]
+  (let [data (us/conform ::update-page-history data)
+        message (assoc data
+                       :type :update-page-history
+                       :id (uuid/from-string (:hid params))
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map #(http/ok (rsp %))))))

backend/src/uxbox/frontend/projects.clj

@@ -0,0 +1,73 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.projects
+  (:require [clojure.spec :as s]
+            [promesa.core :as p]
+            [catacumba.http :as http]
+            [uxbox.util.spec :as us]
+            [uxbox.services :as sv]
+            [uxbox.util.response :refer (rsp)]
+            [uxbox.util.uuid :as uuid]))
+
+;; --- List Projects
+
+(defn list-projects
+  [{user :identity}]
+  (let [message {:user user :type :list-projects}]
+    (->> (sv/query message)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Create Projects
+
+(s/def ::create-project
+  (s/keys :req-un [::us/name] :opt-un [::us/id]))
+
+(defn create-project
+  [{user :identity data :data}]
+  (let [data (us/conform ::create-project data)
+        message (assoc data
+                       :type :create-project
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map (fn [result]
+                  (let [loc (str "/api/projects/" (:id result))]
+                    (http/created loc (rsp result))))))))
+
+;; --- Update Project
+
+(s/def ::update-project
+  (s/keys :req-un [::us/name ::us/version]))
+
+(defn update-project
+  [{user :identity params :route-params data :data}]
+  (let [data (us/conform ::update-project data)
+        message (assoc data
+                       :id (uuid/from-string (:id params))
+                       :type :update-project
+                       :user user)]
+    (-> (sv/novelty message)
+        (p/then #(http/ok (rsp %))))))
+
+;; --- Delete Project
+
+(defn delete-project
+  [{user :identity params :route-params}]
+  (let [message {:id (uuid/from-string (:id params))
+                 :type :delete-project
+                 :user user}]
+    (-> (sv/novelty message)
+        (p/then (fn [v] (http/no-content))))))
+
+
+;; --- Retrieve project
+
+(defn retrieve-project-by-share-token
+  [{params :route-params}]
+  (let [message {:token (:token params)
+                 :type :retrieve-project-by-share-token}]
+    (->> (sv/query message)
+         (p/map #(http/ok (rsp %))))))

backend/src/uxbox/frontend/svgparse.clj

@@ -0,0 +1,22 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.svgparse
+  "A frontend exposed endpoints for svgparse functionality."
+  (:require [clojure.spec :as s]
+            [promesa.core :as p]
+            [catacumba.http :as http]
+            [uxbox.util.spec :as us]
+            [uxbox.services :as sv]
+            [uxbox.util.response :refer (rsp)]
+            [uxbox.util.uuid :as uuid]))
+
+(defn parse
+  [{body :body :as context}]
+  (let [message {:data (slurp body)
+                 :type :parse-svg}]
+    (->> (sv/query message)
+         (p/map #(http/ok (rsp %))))))

backend/src/uxbox/frontend/users.clj

@@ -0,0 +1,149 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.frontend.users
+  (:require [clojure.spec :as s]
+            [promesa.core :as p]
+            [catacumba.http :as http]
+            [storages.core :as st]
+            [storages.util :as path]
+            [uxbox.media :as media]
+            [uxbox.images :as images]
+            [uxbox.util.spec :as us]
+            [uxbox.services :as sv]
+            [uxbox.services.users :as svu]
+            [uxbox.util.response :refer (rsp)]
+            [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)))
+
+;; --- Retrieve Profile
+
+(defn retrieve-profile
+  [{user :identity}]
+  (let [message {:user user
+                 :type :retrieve-profile}]
+    (->> (sv/query message)
+         (p/map resolve-thumbnail)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Update Profile
+
+(s/def ::fullname string?)
+(s/def ::metadata any?)
+(s/def ::update-profile
+  (s/keys :req-un [::us/id ::us/username ::us/email
+                   ::fullname ::metadata]))
+
+(defn update-profile
+  [{user :identity data :data}]
+  (let [data (us/conform ::update-profile data)
+        message (assoc data
+                       :type :update-profile
+                       :user user)]
+    (->> (sv/novelty message)
+         (p/map resolve-thumbnail)
+         (p/map #(http/ok (rsp %))))))
+
+;; --- Update Password
+
+(s/def ::old-password ::us/password)
+(s/def ::update-password
+  (s/keys :req-un [::us/password ::old-password]))
+
+(defn update-password
+  [{user :identity data :data}]
+  (let [data (us/conform ::update-password data)
+        message (assoc data
+                      :type :update-profile-password
+                      :user user)]
+    (-> (sv/novelty message)
+        (p/then #(http/ok (rsp %))))))
+
+;; --- Update Profile Photo
+
+(s/def ::file ::us/uploaded-file)
+(s/def ::update-photo (s/keys :req-un [::file]))
+
+(defn update-photo
+  [{user :identity data :data}]
+  (letfn [(store-photo [file]
+            (let [filename (path/base-name file)
+                  storage media/images-storage]
+              (st/save storage filename file)))
+          (assign-photo [path]
+            (sv/novelty {:user user
+                         :path (str path)
+                         :type :update-profile-photo}))
+          (create-response [_]
+            (http/no-content))]
+    (let [{:keys [file]} (us/conform ::update-photo data)]
+      (->> (store-photo file)
+           (p/mapcat assign-photo)
+           (p/map create-response)))))
+
+;; --- Register User
+
+(s/def ::register
+  (s/keys :req-un [::us/username ::us/email ::us/password ::fullname]))
+
+(defn register-user
+  [{data :data}]
+  (let [data (us/conform ::register data)
+        message (assoc data :type :register-profile)]
+    (->> (sv/novelty message)
+         (p/map #(http/ok (rsp %))))))
+
+
+;; --- Request Password Recovery
+
+;; FIXME: rename for consistency
+
+(s/def ::request-recovery
+  (s/keys :req-un [::us/username]))
+
+(defn request-recovery
+  [{data :data}]
+  (let [data (us/conform ::request-recovery data)
+        message (assoc data :type :request-profile-password-recovery)]
+    (->> (sv/novelty message)
+         (p/map (fn [_] (http/no-content))))))
+
+;; --- Password Recovery
+
+;; FIXME: rename for consistency
+
+(s/def ::token string?)
+(s/def ::password-recovery
+  (s/keys :req-un [::token ::us/password]))
+
+(defn recover-password
+  [{data :data}]
+  (let [data (us/conform ::password-recovery data)
+        message (assoc data :type :recover-profile-password)]
+    (->> (sv/novelty message)
+         (p/map (fn [_] (http/no-content))))))
+
+;; --- Valiadate Recovery Token
+
+(defn validate-recovery-token
+  [{params :route-params}]
+  (let [message {:type :validate-profile-password-recovery-token
+                 :token (:token params)}]
+    (->> (sv/query message)
+         (p/map (fn [v]
+                  (if v
+                    (http/no-content)
+                    (http/not-found "")))))))

backend/src/uxbox/images.clj

@@ -0,0 +1,66 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.images
+  "Image postprocessing."
+  (:require [storages.core :as st]
+            [storages.util :as path]
+            [clojure.spec :as s]
+            [uxbox.util.spec :as us]
+            [uxbox.media :as media]
+            [uxbox.util.images :as images]
+            [uxbox.util.data :refer (dissoc-in)]))
+
+;; FIXME: add spec for thumbnail config
+
+(defn make-thumbnail
+  [path {:keys [size format quality] :as cfg}]
+  (let [parent (path/parent path)
+        [filename ext] (path/split-ext path)
+
+        suffix-parts [(nth size 0) (nth size 1) quality format]
+        final-name (apply str filename "-" (interpose "." suffix-parts))
+        final-path (path/path parent final-name)
+
+        images-storage media/images-storage
+        thumbs-storage media/thumbnails-storage]
+    (if @(st/exists? thumbs-storage final-path)
+      (str (st/public-url thumbs-storage final-path))
+      (if @(st/exists? images-storage path)
+        (let [datapath @(st/lookup images-storage path)
+              content (images/thumbnail datapath cfg)
+              path @(st/save thumbs-storage final-path content)]
+          (str (st/public-url thumbs-storage path)))
+        nil))))
+
+(defn populate-thumbnail
+  [entry {:keys [src dst] :as cfg}]
+  (assert (map? entry) "`entry` should be map")
+
+  (let [src (if (vector? src) src [src])
+        dst (if (vector? dst) dst [dst])
+        src (get-in entry src)]
+     (if (empty? src)
+       entry
+       (assoc-in entry dst (make-thumbnail src cfg)))))
+
+(defn populate-thumbnails
+  [entry & settings]
+  (reduce populate-thumbnail entry settings))
+
+(defn populate-urls
+  [entry storage src dst]
+  (assert (map? entry) "`entry` should be map")
+  (assert (st/storage? storage) "`storage` should be a valid storage instance.")
+  (let [src (if (vector? src) src [src])
+        dst (if (vector? dst) dst [dst])
+        value (get-in entry src)]
+    (if (empty? value)
+      entry
+      (let [url (str (st/public-url storage value))]
+        (-> entry
+            (dissoc-in src)
+            (assoc-in dst url))))))

backend/src/uxbox/locks.clj

@@ -0,0 +1,21 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.locks
+  "Advirsory locks for specific handling concurrent modifications
+  on particular objects in the database."
+  (: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))

backend/src/uxbox/main.clj

@@ -0,0 +1,92 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.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]
+            [mount.core :as mount]
+            [buddy.core.codecs :as codecs]
+            [buddy.core.codecs.base64 :as b64]
+            [buddy.core.nonce :as nonce]
+            [uxbox.config :as cfg]
+            [uxbox.migrations]
+            [uxbox.db]
+            [uxbox.frontend]
+            [uxbox.scheduled-jobs])
+  (:gen-class))
+
+;; --- Development Stuff
+
+(defn- start
+  []
+  (mount/start))
+
+(defn- start-minimal
+  []
+  (-> (mount/only #{#'uxbox.config/config
+                    #'uxbox.db/datasource
+                    #'uxbox.migrations/migrations})
+      (mount/start)))
+
+(defn- stop
+  []
+  (mount/stop))
+
+(defn- refresh
+  []
+  (stop)
+  (repl/refresh))
+
+(defn- refresh-all
+  []
+  (stop)
+  (repl/refresh-all))
+
+(defn- go
+  "starts all states defined by defstate"
+  []
+  (start)
+  :ready)
+
+(defn- reset
+  []
+  (stop)
+  (repl/refresh :after 'uxbox.main/start))
+
+(defn make-secret
+  []
+  (-> (nonce/random-bytes 64)
+      (b64/encode true)
+      (codecs/bytes->str)))
+
+;; --- Entry point (only for uberjar)
+
+(defn test-vars
+  [& vars]
+  (repl/refresh)
+  (test/test-vars
+   (map (fn [sym]
+          (require (symbol (namespace sym)))
+          (resolve sym))
+        vars)))
+
+(defn test-ns
+  [ns]
+  (repl/refresh)
+  (test/test-ns ns))
+
+(defn test-all
+  ([] (test/run-all-tests #"^uxbox.tests.*"))
+  ([re] (test/run-all-tests re)))
+
+;; --- Entry point (only for uberjar)
+
+(defn -main
+  [& args]
+  (mount/start))

backend/src/uxbox/media.clj

@@ -0,0 +1,39 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.media
+  "A media storage impl for uxbox."
+  (:require [mount.core :as mount :refer (defstate)]
+            [clojure.java.io :as io]
+            [cuerdas.core :as str]
+            [storages.core :as st]
+            [storages.fs.local :refer (filesystem)]
+            [storages.fs.misc :refer (hashed scoped)]
+            [uxbox.config :refer (config)]))
+
+;; --- State
+
+(defstate static-storage
+  :start (let [{:keys [basedir baseuri]} (:static config)]
+           (filesystem {:basedir basedir :baseuri baseuri})))
+
+(defstate media-storage
+  :start (let [{:keys [basedir baseuri]} (:media config)]
+           (filesystem {:basedir basedir :baseuri baseuri})))
+
+(defstate images-storage
+  :start (-> media-storage
+             (scoped "images")
+             (hashed)))
+
+(defstate thumbnails-storage
+  :start (scoped media-storage "thumbs"))
+
+;; --- Public Api
+
+(defn resolve-asset
+  [path]
+  (str (st/public-url static-storage path)))

backend/src/uxbox/migrations.clj

@@ -0,0 +1,78 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.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]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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]]})
+
+(defn- migrate
+  []
+  (let [options (:migrations cfg/config {})]
+    (with-open [mctx (mg/context db/datasource options)]
+      (mg/migrate mctx +migrations+)
+      nil)))
+
+(defstate migrations
+  :start (migrate))

backend/src/uxbox/portation.clj

@@ -0,0 +1,114 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.portation
+  "Support for export/import operations of projects."
+  (:refer-clojure :exclude [with-open])
+  (:require [clojure.java.io :as io]
+            [suricatta.core :as sc]
+            [storages.util :as path]
+            [uxbox.db :as db]
+            [uxbox.sql :as sql]
+            [uxbox.util.uuid :as uuid]
+            [uxbox.util.closeable :refer (with-open)]
+            [uxbox.util.tempfile :as tmpfile]
+            [uxbox.util.transit :as t]
+            [uxbox.util.snappy :as snappy]))
+
+;; --- 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-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-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 (tmpfile/create)]
+    (write-data path id)
+    path))
+
+;; --- 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- 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-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- 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 (path/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))))

backend/src/uxbox/scheduled_jobs.clj

@@ -0,0 +1,23 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.scheduled-jobs
+  "Time-based scheduled jobs."
+  (:require [mount.core :as mount :refer (defstate)]
+            [uxbox.config :as cfg]
+            [uxbox.db]
+            [uxbox.util.quartz :as qtz]))
+
+(defn- initialize
+  []
+  (let [nss #{'uxbox.scheduled-jobs.garbage
+              'uxbox.scheduled-jobs.emails}]
+    (-> (qtz/scheduler)
+        (qtz/start! {:search-on nss}))))
+
+(defstate scheduler
+  :start (initialize)
+  :stop (qtz/stop! scheduler))

backend/src/uxbox/scheduled_jobs/emails.clj

@@ -0,0 +1,123 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.scheduled-jobs.emails
+  "Email sending async tasks."
+  (:require [clojure.tools.logging :as log]
+            [suricatta.core :as sc]
+            [postal.core :as postal]
+            [uxbox.db :as db]
+            [uxbox.config :as cfg]
+            [uxbox.sql :as sql]
+            [uxbox.util.quartz :as qtz]
+            [uxbox.util.blob :as blob]
+            [uxbox.util.transit :as t]
+            [uxbox.util.data :as data]))
+
+;; --- Impl details
+
+(defn- decode-email-data
+  [{:keys [data] :as result}]
+  (merge result (when data
+                  {:data (-> data blob/decode t/decode)})))
+
+(defn- fetch-pending-emails
+  [conn]
+  (let [sqlv (sql/get-pending-emails)]
+    (->> (sc/fetch conn sqlv)
+         (map data/normalize-attrs)
+         (map decode-email-data))))
+
+(defn- fetch-immediate-emails
+  [conn]
+  (let [sqlv (sql/get-immediate-emails)]
+    (->> (sc/fetch conn sqlv)
+         (map data/normalize-attrs)
+         (map decode-email-data))))
+
+(defn- fetch-failed-emails
+  [conn]
+  (let [sqlv (sql/get-pending-emails)]
+    (->> (sc/fetch conn sqlv)
+         (map data/normalize-attrs)
+         (map decode-email-data))))
+
+(defn- mark-email-as-sent
+  [conn id]
+  (let [sqlv (sql/mark-email-as-sent {:id id})]
+    (sc/execute conn sqlv)))
+
+(defn- mark-email-as-failed
+  [conn id]
+  (let [sqlv (sql/mark-email-as-failed {:id id})]
+    (sc/execute conn sqlv)))
+
+(defn- send-email-to-console
+  [{:keys [id data] :as entry}]
+  (println "******** start email:" id "**********")
+  (println (->> (:body data)
+                (filter #(= (:uxbox.emails.core/type %) :text/plain))
+                (first)
+                (:content)))
+  (println "********** end email:" id "**********")
+  {:error :SUCCESS})
+
+(defn- send-email
+  [{:keys [id data] :as entry}]
+  (let [config (:smtp 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)))))

backend/src/uxbox/scheduled_jobs/garbage.clj

@@ -0,0 +1,28 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.scheduled-jobs.garbage
+  "Garbage Collector related tasks."
+  (:require [suricatta.core :as sc]
+            [uxbox.db :as db]
+            [uxbox.util.quartz :as qtz]))
+
+;; --- Delete projects
+
+;; TODO: move inline sql into resources/sql directory
+
+(defn clean-deleted-projects
+  "Task that cleans the deleted projects."
+  {::qtz/repeat? true
+   ::qtz/interval (* 1000 3600 24)
+   ::qtz/job true}
+  []
+  (with-open [conn (db/connection)]
+    (sc/atomic conn
+      (let [sql (str "DELETE FROM projects "
+                     " WHERE deleted_at is not null AND "
+                     "       (now()-deleted_at)::interval > '10 day'::interval;")]
+        (sc/execute conn sql)))))

backend/src/uxbox/services.clj

@@ -0,0 +1,61 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services
+  "Main namespace for access to all uxbox services."
+  (:require [suricatta.core :as sc]
+            [executors.core :as exec]
+            [promesa.core :as p]
+            [uxbox.db :as db]
+            [uxbox.services.core :as core]
+            [uxbox.util.transit :as t]
+            [uxbox.util.blob :as blob]))
+
+;; Load relevant subnamespaces with the implementation
+(load "services/auth")
+(load "services/projects")
+(load "services/pages")
+(load "services/images")
+(load "services/icons")
+(load "services/kvstore")
+
+;; --- Implementation
+
+(def ^:private encode (comp blob/encode t/encode))
+
+(defn- insert-txlog
+  [data]
+  (with-open [conn (db/connection)]
+    (let [sql (str "INSERT INTO txlog (payload) VALUES (?)")
+          sqlv [sql (encode data)]]
+      (sc/execute conn sqlv))))
+
+(defn- handle-novelty
+  [data]
+  (let [rs (core/novelty data)
+        rs (if (p/promise? rs) rs (p/resolved rs))]
+    (p/map (fn [v]
+             (insert-txlog data)
+             v) rs)))
+
+(defn- handle-query
+  [data]
+  (let [result (core/query data)]
+    (if (p/promise? result)
+      result
+      (p/resolved result))))
+
+;; --- Public Api
+
+(defn novelty
+  [data]
+  (->> (exec/submit (partial handle-novelty data))
+       (p/mapcat identity)))
+
+(defn query
+  [data]
+  (->> (exec/submit (partial handle-query data))
+       (p/mapcat identity)))

backend/src/uxbox/services/auth.clj

@@ -0,0 +1,47 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.auth
+  (:require [clojure.spec :as s]
+            [suricatta.core :as sc]
+            [buddy.hashers :as hashers]
+            [buddy.sign.jwt :as jwt]
+            [buddy.core.hash :as hash]
+            [uxbox.config :as cfg]
+            [uxbox.util.spec :as us]
+            [uxbox.db :as db]
+            [uxbox.services.core :as core]
+            [uxbox.services.users :as users]
+            [uxbox.util.exceptions :as ex]))
+
+;; --- Login
+
+(defn- check-user-password
+  [user password]
+  (hashers/check password (:password user)))
+
+(defn generate-token
+  [user]
+  (let [data {:id (:id user)}
+        opts (:auth-options cfg/config)]
+    (jwt/encrypt data cfg/secret opts)))
+
+(s/def ::scope string?)
+(s/def ::login
+  (s/keys :req-un [::us/username ::us/password ::scope]))
+
+(defmethod core/novelty :login
+  [{:keys [username password scope] :as params}]
+  (s/assert ::login 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))
+      (if (check-user-password user password)
+        {:token (generate-token user)}
+        (ex/raise :type :validation
+                  :code ::wrong-credentials)))))

backend/src/uxbox/services/core.clj

@@ -0,0 +1,27 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.core
+  (:require [clojure.walk :as walk]
+            [cuerdas.core :as str]
+            [uxbox.util.exceptions :as ex]))
+
+(defmulti novelty :type)
+
+(defmulti query :type)
+
+(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))
+

backend/src/uxbox/services/icons.clj

@@ -0,0 +1,228 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.icons
+  "Icons library related services."
+  (:require [clojure.spec :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 ratpack.form.UploadedFile
+           org.apache.commons.io.FilenameUtils))
+
+;; --- 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 ::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))
+
+;; --- 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-icon-collection params)]
+    (-> (sc/fetch-one conn sqlv)
+        (data/normalize))))
+
+(s/def ::create-icon-collection
+  (s/keys :req-un [::user ::us/name]
+          :opt-un [::us/id]))
+
+(defmethod core/novelty :create-icon-collection
+  [params]
+  (s/assert ::create-icon-collection params)
+  (with-open [conn (db/connection)]
+    (create-collection conn params)))
+
+;; --- 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
+  [{: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)))
+
+;; --- 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))))
+
+(s/def ::list-icons
+  (s/keys :req-un [::user ::collection]))
+
+(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)))

backend/src/uxbox/services/images.clj

@@ -0,0 +1,236 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.images
+  "Images library related services."
+  (:require [clojure.spec :as s]
+            [promesa.core :as p]
+            [suricatta.core :as sc]
+            [buddy.core.codecs :as codecs]
+            [storages.core :as st]
+            [storages.util :as path]
+            [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 ratpack.form.UploadedFile
+           org.apache.commons.io.FilenameUtils))
+
+(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?))
+
+;; --- 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]))
+
+(defmethod core/novelty :create-image-collection
+  [params]
+  (s/assert ::create-image-collection params)
+  (with-open [conn (db/connection)]
+    (create-collection conn params)))
+
+;; --- 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-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)))
+
+;; --- 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))))
+
+(defmethod core/query :list-image-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-image-collection {:id id :user user})]
+    (pos? (sc/execute conn sqlv))))
+
+(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)))
+
+;; --- Retrieve Image
+
+(defn retrieve-image
+  [conn {:keys [user id]}]
+  (let [sqlv (sql/get-image {:user user :id id})]
+    (some-> (sc/fetch-one conn sqlv)
+            (data/normalize-attrs))))
+
+(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)))
+
+;; --- 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))))
+
+(s/def ::create-image
+  (s/keys :req-un [::user ::us/name ::path ::width ::height ::mimetype]
+          :opt-un [::us/id]))
+
+(defmethod core/novelty :create-image
+  [params]
+  (s/assert ::create-image params)
+  (with-open [conn (db/connection)]
+    (create-image conn params)))
+
+;; --- 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]))
+
+(defmethod core/novelty :update-image
+  [params]
+  (s/assert ::update-image params)
+  (with-open [conn (db/connection)]
+    (update-image conn params)))
+
+;; --- 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 (path/base-name path)
+          path @(st/save storage filename path)
+          image (assoc image
+                       :path (str path)
+                       :collection collection)
+          image (dissoc image :id)]
+      (create-image conn image))))
+
+(defmethod core/novelty :copy-image
+  [params]
+  (s/assert ::copy-image params)
+  (with-open [conn (db/connection)]
+    (sc/apply-atomic conn copy-image params)))
+
+;; --- Delete Image
+
+(defn delete-image
+  [conn {:keys [user id]}]
+  (let [sqlv (sql/delete-image {:id id :user user})]
+    (pos? (sc/execute conn sqlv))))
+
+(s/def ::delete-image
+  (s/keys :req-un [::user]
+          :opt-un [::us/id]))
+
+(defmethod core/novelty :delete-image
+  [params]
+  (s/assert ::delete-image params)
+  (with-open [conn (db/connection)]
+    (delete-image conn params)))
+
+;; --- 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)))

backend/src/uxbox/services/kvstore.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) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.kvstore
+  (:require [clojure.spec :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]))
+
+(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))
+
+;; --- Update KVStore
+
+(s/def ::update-kvstore
+  (s/keys :req-un [::key ::value ::user ::version]))
+
+(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))))
+
+(defmethod core/novelty :update-kvstore
+  [params]
+  (s/assert ::update-kvstore params)
+  (with-open [conn (db/connection)]
+    (sc/apply-atomic conn update-kvstore params)))
+
+;; --- Retrieve KVStore
+
+(s/def ::retrieve-kvstore
+  (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)))
+
+;; --- 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)))

backend/src/uxbox/services/pages.clj

@@ -0,0 +1,226 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.pages
+  (:require [clojure.spec :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]))
+
+(declare decode-page-data)
+(declare decode-page-metadata)
+(declare encode-data)
+
+(s/def ::data any?)
+(s/def ::user uuid?)
+(s/def ::project 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))))
+
+(s/def ::create-page
+  (s/keys :req-un [::data ::user ::project ::us/name ::metadata]
+          :opt-un [::us/id]))
+
+(defmethod core/novelty :create-page
+  [params]
+  (s/assert ::create-page params)
+  (with-open [conn (db/connection)]
+    (create-page conn params)))
+
+;; --- 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))))
+
+(s/def ::update-page
+  (s/merge ::create-page (s/keys :req-un [::us/version])))
+
+(defmethod core/novelty :update-page
+  [params]
+  (s/assert ::update-page params)
+  (with-open [conn (db/connection)]
+    (update-page conn params)))
+
+;; --- 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))))
+
+(s/def ::update-page-metadata
+  (s/keys :req-un [::user ::project ::us/name ::us/version ::metadata]
+          :opt-un [::us/id ::data]))
+
+(defmethod core/novelty :update-page-metadata
+  [params]
+  (s/assert ::update-page-metadata params)
+  (with-open [conn (db/connection)]
+    (update-page-metadata conn params)))
+
+;; --- 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))))
+
+(s/def ::delete-page
+  (s/keys :req-un [::user ::us/id]))
+
+(defmethod core/novelty :delete-page
+  [params]
+  (s/assert ::delete-page params)
+  (with-open [conn (db/connection)]
+    (delete-page conn params)))
+
+;; --- List Pages by Project
+
+(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 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 ::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)))
+
+;; --- 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-page-data
+  [{:keys [data] :as result}]
+  (s/assert ::us/bytes data)
+  (merge result (when data
+                  {:data (-> data blob/decode t/decode)})))
+
+(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))))

backend/src/uxbox/services/projects.clj

@@ -0,0 +1,143 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.projects
+  (:require [clojure.spec :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]))
+
+(s/def ::token string?)
+(s/def ::data string?)
+(s/def ::user uuid?)
+(s/def ::project uuid?)
+
+;; --- Create Project
+
+(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))))
+
+(s/def ::create-project
+  (s/keys :req-un [::user ::us/name]
+          :opt-un [::us/id]))
+
+(defmethod core/novelty :create-project
+  [params]
+  (s/assert ::create-project params)
+  (with-open [conn (db/connection)]
+    (create-project conn params)))
+
+;; --- 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))))
+
+(s/def ::update-project
+  (s/merge ::create-project (s/keys :req-un [::us/version])))
+
+(defmethod core/novelty :update-project
+  [params]
+  (s/assert ::update-project params)
+  (with-open [conn (db/connection)]
+    (update-project conn params)))
+
+;; --- 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))))
+
+(s/def ::delete-project
+  (s/keys :req-un [::us/id ::user]))
+
+(defmethod core/novelty :delete-project
+  [params]
+  (s/assert ::delete-project params)
+  (with-open [conn (db/connection)]
+    (delete-project conn params)))
+
+;; --- 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)))))
+
+(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)})))
+
+

backend/src/uxbox/services/svgparse.clj

@@ -0,0 +1,95 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.svgparse
+  (:require [clojure.spec :as s]
+            [cuerdas.core :as str]
+            [uxbox.util.spec :as us]
+            [uxbox.services.core :as core]
+            [uxbox.util.exceptions :as ex])
+  (: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]))
+
+;; --- Implementation
+
+(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- 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-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 Exception e
+      (.printStackTrace e)
+      (ex/raise :code ::unexpected))))
+
+;; --- 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
+  [data]
+  {:pre [(instance? InputStream data)]}
+  (parse-string (slurp data)))
+
+(defmethod core/query :parse-svg
+  [{:keys [data] :as params}]
+  {:pre [(string? data)]}
+  (parse-string data))

backend/src/uxbox/services/users.clj

@@ -0,0 +1,317 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.services.users
+  (:require [clojure.spec :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.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]))
+
+(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)
+
+(s/def ::user uuid?)
+(s/def ::fullname string?)
+(s/def ::metadata any?)
+(s/def ::old-password string?)
+(s/def ::path string?)
+
+;; --- Retrieve User Profile (own)
+
+(defmethod core/query :retrieve-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))))
+
+;; --- Update User Profile (own)
+
+(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 ::username-already-exists))))
+
+(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))))
+
+(s/def ::update-profile
+  (s/keys :req-un [::us/id ::us/username ::us/email ::fullname ::metadata]))
+
+(defmethod core/novelty :update-profile
+  [params]
+  (s/assert ::update-profile params)
+  (with-open [conn (db/connection)]
+    (sc/apply-atomic conn update-profile params)))
+
+;; --- Update Password
+
+(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))
+
+(s/def ::update-password
+  (s/keys :req-un [::user ::us/password ::old-password]))
+
+(defmethod core/novelty :update-profile-password
+  [params]
+  (s/assert ::update-password params)
+  (with-open [conn (db/connection)]
+    (->> params
+         (validate-old-password conn)
+         (update-password conn))))
+
+;; --- 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 ::update-photo
+  (s/keys :req-un [::user ::path]))
+
+(defmethod core/novelty :update-profile-photo
+  [params]
+  (s/assert ::update-photo params)
+  (with-open [conn (db/connection)]
+    (update-photo conn params)))
+
+;; --- Create User
+
+(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))
+      (ex/raise :type :validation
+                :code ::email-already-exists))
+    (when (:val (sc/fetch-one conn sqlv2))
+      (ex/raise :type :validation
+                :code ::username-already-exists))))
+
+(defn- register-user
+  "Create the user entry onthe 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)
+        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))
+
+(s/def ::register
+  (s/keys :req-un [::us/username ::us/email ::us/password ::fullname]))
+
+(defmethod core/novelty :register-profile
+  [params]
+  (s/assert ::register params)
+  (with-open [conn (db/connection)]
+    (sc/apply-atomic conn register-user params)))
+
+;; --- 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- 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- mark-token-as-used
+  [conn token]
+  (let [sqlv (sql/mark-recovery-token-used {:token token})]
+    (pos? (sc/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- 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- 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))
+
+(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))))
+
+(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)))
+
+;; --- 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-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-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))))
+
+;; --- Attrs Helpers
+
+(defn- decode-user-data
+  [{:keys [metadata] :as result}]
+  (merge result (when metadata
+                  {:metadata (-> metadata blob/decode t/decode)})))
+
+(defn trim-user-attrs
+  "Only selects a publicy visible user attrs."
+  [user]
+  (select-keys user [:id :username :fullname
+                     :password :metadata :email
+                     :created-at :photo]))

backend/src/uxbox/sql.clj

@@ -0,0 +1,18 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.sql
+  (:require [hugsql.core :as hugsql]))
+
+(hugsql/def-sqlvec-fns "sql/projects.sql" {:quoting :ansi :fn-suffix ""})
+(hugsql/def-sqlvec-fns "sql/pages.sql" {:quoting :ansi :fn-suffix ""})
+(hugsql/def-sqlvec-fns "sql/users.sql" {:quoting :ansi :fn-suffix ""})
+(hugsql/def-sqlvec-fns "sql/emails.sql" {:quoting :ansi :fn-suffix ""})
+(hugsql/def-sqlvec-fns "sql/images.sql" {:quoting :ansi :fn-suffix ""})
+(hugsql/def-sqlvec-fns "sql/icons.sql" {:quoting :ansi :fn-suffix ""})
+(hugsql/def-sqlvec-fns "sql/kvstore.sql" {:quoting :ansi :fn-suffix ""})
+(hugsql/def-sqlvec-fns "sql/workers.sql" {:quoting :ansi :fn-suffix ""})
+

backend/src/uxbox/util/blob.clj

@@ -0,0 +1,21 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.blob
+  "A generic blob storage encoding. Mainly used for
+  page data, page options and txlog payload storage."
+  (:require [uxbox.util.snappy :as snappy]))
+
+(defn encode
+  "Encode data into compressed blob."
+  [data]
+  (snappy/compress data))
+
+(defn decode
+  "Decode blob into string."
+  [^bytes data]
+  (snappy/uncompress data))
+

backend/src/uxbox/util/cli.clj

@@ -0,0 +1,12 @@
+(ns uxbox.util.cli
+  "Command line interface helpers.")
+
+(defn exit!
+  ([] (exit! 0))
+  ([code]
+   (System/exit code)))
+
+(defmacro print-err!
+  [& args]
+  `(binding [*out* *err*]
+     (println ~@args)))

backend/src/uxbox/util/closeable.clj

@@ -0,0 +1,31 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.closeable
+  "A closeable abstraction. A drop in replacement for
+  clojure builtin `with-open` syntax abstraction."
+  (:refer-clojure :exclude [with-open]))
+
+(defprotocol ICloseable
+  (-close [_] "Close the resource."))
+
+(defmacro with-open
+  [bindings & body]
+  {:pre [(vector? bindings)
+         (even? (count bindings))
+         (pos? (count bindings))]}
+  (reduce (fn [acc bindings]
+            `(let ~(vec bindings)
+               (try
+                 ~acc
+                 (finally
+                   (-close ~(first bindings))))))
+          `(do ~@body)
+          (reverse (partition 2 bindings))))
+
+(extend-protocol ICloseable
+  java.lang.AutoCloseable
+  (-close [this] (.close this)))

backend/src/uxbox/util/data.clj

@@ -0,0 +1,52 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.data
+  "Data transformations utils."
+  (:require [clojure.walk :as walk]
+            [cuerdas.core :as str]))
+
+(defn dissoc-in
+  [m [k & ks :as keys]]
+  (if ks
+    (if-let [nextmap (get m k)]
+      (let [newmap (dissoc-in nextmap ks)]
+        (if (seq newmap)
+          (assoc m k newmap)
+          (dissoc m k)))
+      m)
+    (dissoc m k)))
+
+(defn normalize-attrs
+  "Recursively transforms all map keys from strings to keywords."
+  [m]
+  (letfn [(tf [[k v]]
+            (let [ks (-> (name k)
+                         (str/replace "_" "-"))]
+              [(keyword ks) v]))
+          (walker [x]
+            (if (map? x)
+              (into {} (map tf) x)
+              x))]
+    (walk/postwalk walker m)))
+
+(defn strip-delete-attrs
+  [m]
+  (dissoc m :deleted-at))
+
+(defn normalize
+  "Perform a common normalization transformation
+  for a entity (database retrieved) data structure."
+  [m]
+  (-> m normalize-attrs strip-delete-attrs))
+
+(defn deep-merge
+  [& maps]
+  (letfn [(merge' [& maps]
+            (if (every? map? maps)
+              (apply merge-with merge' maps)
+              (last maps)))]
+    (apply merge' (remove nil? maps))))

backend/src/uxbox/util/exceptions.clj

@@ -0,0 +1,21 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.exceptions
+  "A helpers for work with exceptions.")
+
+(defn error
+  [& {:keys [type code message] :or {type :unexpected} :as payload}]
+  {:pre [(keyword? type) (keyword? code)]}
+  (let [message (if message
+                  (str message " / " (pr-str code) "")
+                  (pr-str code))
+        payload (assoc payload :type type)]
+    (ex-info message payload)))
+
+(defmacro raise
+  [& args]
+  `(throw (error ~@args)))

backend/src/uxbox/util/images.clj

@@ -0,0 +1,44 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.images
+  "Images transformation utils."
+  (:require [clojure.java.io :as io])
+  (:import org.im4java.core.IMOperation
+           org.im4java.core.ConvertCmd
+           org.im4java.process.Pipe
+           java.io.ByteArrayInputStream
+           java.io.ByteArrayOutputStream))
+
+;; Related info on how thumbnails generation
+;;  http://www.imagemagick.org/Usage/thumbnails/
+
+(defn thumbnail
+  ([input] (thumbnail input nil))
+  ([input {:keys [size quality format]
+           :or {format "jpg"
+                quality 92
+                size [200 200]}
+           :as opts}]
+   {:pre [(vector? size)]}
+   (with-open [out (ByteArrayOutputStream.)
+               in (io/input-stream input)]
+     (let [[width height] size
+           pipe (Pipe. in out)
+           op (doto (IMOperation.)
+                (.addRawArgs ^java.util.List ["-"])
+                (.autoOrient)
+                ;; (.thumbnail (int width) (int height) "^")
+                ;; (.gravity "center")
+                ;; (.extent (int width) (int height))
+                (.resize (int width) (int height) "^")
+                (.quality (double quality))
+                (.addRawArgs ^java.util.List [(str format ":-")]))
+           cmd (doto (ConvertCmd.)
+                 (.setInputProvider pipe)
+                 (.setOutputConsumer pipe))]
+       (.run cmd op (make-array Object 0))
+       (ByteArrayInputStream. (.toByteArray out))))))

backend/src/uxbox/util/quartz.clj

@@ -0,0 +1,139 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.quartz
+  "A lightweight abstraction layer for quartz job scheduling library."
+  (:import java.util.Properties
+           org.quartz.Scheduler
+           org.quartz.SchedulerException
+           org.quartz.impl.StdSchedulerFactory
+           org.quartz.Job
+           org.quartz.JobBuilder
+           org.quartz.JobDataMap
+           org.quartz.JobExecutionContext
+           org.quartz.TriggerBuilder
+           org.quartz.CronScheduleBuilder
+           org.quartz.SimpleScheduleBuilder
+           org.quartz.PersistJobDataAfterExecution
+           org.quartz.DisallowConcurrentExecution))
+
+;; --- Implementation
+
+(defn- map->props
+  [data]
+  (let [p (Properties.)]
+    (run! (fn [[k v]] (.setProperty p (name k) (str v))) (seq data))
+    p))
+
+(deftype JobImpl []
+  Job
+  (execute [_ context]
+    (let [^JobDataMap data (.. context getJobDetail getJobDataMap)
+          args (.get data "arguments")
+          state (.get data "state")
+          callable (.get data "callable")]
+      (if state
+        (apply callable state args)
+        (apply callable args)))))
+
+(defn- resolve-var
+  [sym]
+  (let [ns (symbol (namespace sym))
+        func (symbol (name sym))]
+    (require ns)
+    (resolve func)))
+
+(defn- build-trigger
+  [opts]
+  (let [repeat? (::repeat? opts true)
+        interval (::interval opts 1000)
+        cron (::cron opts)
+        group (::group opts "uxbox")
+        schdl (if cron
+                (CronScheduleBuilder/cronSchedule cron)
+                (let [schdl (SimpleScheduleBuilder/simpleSchedule)
+                      schdl (if (number? repeat?)
+                              (.withRepeatCount schdl repeat?)
+                              (.repeatForever schdl))]
+                  (.withIntervalInMilliseconds schdl interval)))
+        name (str (:name opts) "-trigger")
+        bldr (doto (TriggerBuilder/newTrigger)
+               (.startNow)
+               (.withIdentity name group)
+               (.withSchedule schdl))]
+    (.build bldr)))
+
+(defn- build-job-detail
+  [fvar args]
+  (let [opts (meta fvar)
+        state (::state opts)
+        group (::group opts "uxbox")
+        name  (str (:name opts))
+        data  {"callable" @fvar
+               "arguments" (into [] args)
+               "state" (if state (atom state) nil)}
+        bldr (doto (JobBuilder/newJob JobImpl)
+               (.storeDurably false)
+               (.usingJobData (JobDataMap. data))
+               (.withIdentity name group))]
+    (.build bldr)))
+
+(defn- make-scheduler-props
+  [{:keys [name daemon? threads thread-priority]
+    :or {name "uxbox-scheduler"
+         daemon? true
+         threads 1
+         thread-priority Thread/MIN_PRIORITY}}]
+  (map->props
+   {"org.quartz.threadPool.threadCount" threads
+    "org.quartz.threadPool.threadPriority" thread-priority
+    "org.quartz.threadPool.makeThreadsDaemons" (if daemon? "true" "false")
+    "org.quartz.scheduler.instanceName" name
+    "org.quartz.scheduler.makeSchedulerThreadDaemon" (if daemon? "true" "false")}))
+
+;; --- Public Api
+
+(defn scheduler
+  "Create a new scheduler instance."
+  ([] (scheduler nil))
+  ([opts]
+   (let [props (make-scheduler-props opts)
+         factory (StdSchedulerFactory. props)]
+     (.getScheduler factory))))
+
+(declare schedule!)
+
+(defn start!
+  ([schd]
+   (start! schd nil))
+  ([schd {:keys [delay search-on]}]
+   ;; Start the scheduler
+   (if (number? delay)
+     (.startDelayed schd (int delay))
+     (.start schd))
+
+   (when (coll? search-on)
+     (run! (fn [ns]
+             (require ns)
+             (doseq [v (vals (ns-publics ns))]
+               (when (::job (meta v))
+                 (schedule! schd v))))
+           search-on))
+   schd))
+
+(defn stop!
+  [scheduler]
+  (.shutdown ^Scheduler scheduler true))
+
+;; TODO: add proper handling of `:delay` option that should allow
+;; execute a task firstly delayed until some milliseconds or at certain time.
+
+(defn schedule!
+  [schd f & args]
+  (let [vf (if (symbol? f) (resolve-var f) f)
+        job (build-job-detail vf args)
+        trigger (build-trigger (meta vf))]
+    (.scheduleJob ^Scheduler schd job trigger)))

backend/src/uxbox/util/response.clj

@@ -0,0 +1,66 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.response
+  "A lightweigt reponse type definition.
+
+  At first instance it allows set the appropriate
+  content-type headers and encode the body using
+  the builtin transit abstraction.
+
+  In future it will allow easy adapt for the content
+  negotiation that is coming to catacumba."
+  (:require [catacumba.impl.handlers :as ch]
+            [catacumba.impl.context :as ctx]
+            [buddy.core.hash :as hash]
+            [buddy.core.codecs :as codecs]
+            [buddy.core.codecs.base64 :as b64]
+            [uxbox.util.transit :as t])
+  (:import ratpack.handling.Context
+           ratpack.http.Response
+           ratpack.http.Request
+           ratpack.http.Headers
+           ratpack.http.MutableHeaders))
+
+(defn digest
+  [^bytes data]
+  (-> (hash/blake2b-256 data)
+      (b64/encode true)
+      (codecs/bytes->str)))
+
+(defn- etag-match?
+  [^Request request ^String new-tag]
+  (let [^Headers headers (.getHeaders request)]
+    (when-let [etag (.get headers "if-none-match")]
+      (= etag new-tag))))
+
+(deftype Rsp [data]
+  ch/ISend
+  (-send [_ ctx]
+    (let [^Response response (ctx/get-response* ctx)
+          ^Request  request (ctx/get-request* ctx)
+          ^MutableHeaders headers (.getHeaders response)
+          ^String method (.. request getMethod getName toLowerCase)
+          data (t/encode data)]
+      (if (= method "get")
+        (let [etag (digest data)]
+          (if (etag-match? request etag)
+            (do
+              (.set headers "etag" etag)
+              (.status response 304)
+              (.send response))
+            (do
+              (.set headers "content-type" "application/transit+json")
+              (.set headers "etag" etag)
+              (ch/-send data ctx))))
+        (do
+          (.set headers "content-type" "application/transit+json")
+          (ch/-send data ctx))))))
+
+(defn rsp
+  "A shortcut for create a response instance."
+  [data]
+  (Rsp. data))

backend/src/uxbox/util/snappy.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) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.snappy
+  "A lightweight abstraction layer for snappy compression library."
+  (:require [buddy.core.codecs :as codecs])
+  (:import org.xerial.snappy.Snappy
+           org.xerial.snappy.SnappyFramedInputStream
+           org.xerial.snappy.SnappyFramedOutputStream
+
+           java.io.OutputStream
+           java.io.InputStream))
+
+
+(defn compress
+  "Compress data unsing snappy compression algorithm."
+  [data]
+  (-> (codecs/to-bytes data)
+      (Snappy/compress)))
+
+(defn uncompress
+  "Uncompress data using snappy compression algorithm."
+  [data]
+  (-> (codecs/to-bytes data)
+      (Snappy/uncompress)))
+
+(defn input-stream
+  "Create a Snappy framed input stream."
+  [^InputStream istream]
+  (SnappyFramedInputStream. istream))
+
+(defn output-stream
+  "Create a Snappy framed output stream."
+  ([ostream]
+   (output-stream ostream nil))
+  ([^OutputStream ostream {:keys [block-size] :or {block-size 65536}}]
+   (SnappyFramedOutputStream. ostream (int block-size) 1.0)))

backend/src/uxbox/util/spec.clj

@@ -0,0 +1,113 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.spec
+  (:refer-clojure :exclude [keyword uuid vector boolean map set])
+  (:require [clojure.spec :as s]
+            [cuerdas.core :as str]
+            [uxbox.util.exceptions :as ex])
+  (:import java.time.Instant))
+
+;; --- Constants
+
+(def email-rx
+  #"^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+$")
+
+(def uuid-rx
+  #"^[0-9a-f]{8}-[0-9a-f]{4}-[1-5][0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}$")
+
+;; --- Public Api
+
+(defn conform
+  [spec data]
+  (let [result (s/conform spec data)]
+    (if (= result ::s/invalid)
+      (ex/raise :type :validation
+                :code ::invalid
+                :message (s/explain-str spec data)
+                :context (s/explain-data spec data))
+      result)))
+
+;; --- Predicates
+
+(defn email?
+  [v]
+  (and string?
+       (re-matches email-rx v)))
+
+(defn instant?
+  [v]
+  (instance? Instant v))
+
+(defn path?
+  [v]
+  (instance? java.nio.file.Path v))
+
+(defn regex?
+  [v]
+  (instance? java.util.regex.Pattern v))
+
+;; --- Conformers
+
+(defn- uuid-conformer
+  [v]
+  (cond
+    (uuid? v) v
+    (string? v)
+    (cond
+      (re-matches uuid-rx v)
+      (java.util.UUID/fromString v)
+
+      (str/empty? v)
+      nil
+
+      :else
+      ::s/invalid)
+    :else ::s/invalid))
+
+(defn- integer-conformer
+  [v]
+  (cond
+    (integer? v) v
+    (string? v)
+    (if (re-matches #"^[-+]?\d+$" v)
+      (Long/parseLong v)
+      ::s/invalid)
+    :else ::s/invalid))
+
+(defn boolean-conformer
+  [v]
+  (cond
+    (boolean? v) v
+    (string? v)
+    (if (re-matches #"^(?:t|true|false|f|0|1)$" v)
+      (contains? #{"t" "true" "1"} v)
+      ::s/invalid)
+    :else ::s/invalid))
+
+(defn boolean-unformer
+  [v]
+  (if v "true" "false"))
+
+;; --- Default Specs
+
+(s/def ::integer-string (s/conformer integer-conformer str))
+(s/def ::uuid-string (s/conformer uuid-conformer str))
+(s/def ::boolean-string (s/conformer boolean-conformer boolean-unformer))
+(s/def ::positive-integer #(< 0 % Long/MAX_VALUE))
+(s/def ::uploaded-file #(instance? ratpack.form.UploadedFile %))
+(s/def ::uuid uuid?)
+(s/def ::bytes bytes?)
+(s/def ::path path?)
+
+(s/def ::id ::uuid-string)
+(s/def ::name string?)
+(s/def ::username string?)
+(s/def ::password string?)
+(s/def ::version integer?)
+(s/def ::email email?)
+(s/def ::token string?)
+

backend/src/uxbox/util/tempfile.clj

@@ -0,0 +1,17 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.tempfile
+  "A temporal file abstractions."
+  (:require [storages.core :as st]
+            [storages.util :as path])
+  (:import [java.nio.file Files]))
+
+(defn create
+  "Create a temporal file."
+  [& {:keys [suffix prefix]}]
+  (->> (path/make-file-attrs "rwxr-xr-x")
+       (Files/createTempFile prefix suffix)))

backend/src/uxbox/util/template.clj

@@ -0,0 +1,56 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.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))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Impl
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private
+  ^DefaultMustacheFactory
+  +mustache-factory+ (DefaultMustacheFactory.))
+
+(defprotocol ITemplate
+  "A basic template rendering abstraction."
+  (-render [template context]))
+
+(extend-type Mustache
+  ITemplate
+  (-render [template context]
+    (with-out-str
+      (let [scope (HashMap. (walk/stringify-keys context))]
+        (.execute template *out* scope)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Public Api
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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)))

backend/src/uxbox/util/time.clj

@@ -0,0 +1,76 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.time
+  (:require [suricatta.proto :as proto]
+            [cognitect.transit :as t])
+  (:import java.time.Instant
+           java.sql.Timestamp))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Serialization Layer conversions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare from-string)
+
+(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})
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Persistence Layer Conversions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(extend-protocol proto/IParamType
+  Instant
+  (-render [self ctx]
+    (if (proto/-inline? ctx)
+      (str "'" (.toString self) "'::timestamptz")
+      "?::timestamptz"))
+
+  (-bind [self ctx]
+    (when-not (proto/-inline? ctx)
+      (let [stmt (proto/-statement ctx)
+            idx  (proto/-next-bind-index ctx)
+            obj (Timestamp/from self)]
+        (.setTimestamp stmt idx obj)))))
+
+(extend-protocol proto/ISQLType
+  Timestamp
+  (-convert [self]
+    (.toInstant self)))
+
+(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))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn from-string
+  [s]
+  {:pre [(string? s)]}
+  (Instant/parse s))
+
+(defn now
+  []
+  (Instant/now))

backend/src/uxbox/util/token.clj

@@ -0,0 +1,24 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.token
+  "Facilities for generate random tokens."
+  (:require [buddy.core.nonce :as nonce]
+            [buddy.core.hash :as hash]
+            [buddy.core.codecs :as codecs]
+            [buddy.core.codecs.base64 :as b64]))
+
+(defn random
+  "Returns a 32 bytes randomly generated token
+  with 1024 random seed. The output is encoded
+  using urlsafe variant of base64."
+  []
+  (-> (nonce/random-bytes 1024)
+      (hash/blake2b-256)
+      (b64/encode true)
+      (codecs/bytes->str)))
+
+

backend/src/uxbox/util/transit.clj

@@ -0,0 +1,71 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.transit
+  (:require [cognitect.transit :as t]
+            [catacumba.handlers.parse :as cparse]
+            [uxbox.util.time :as dt])
+  (:import ratpack.http.TypedData
+           ratpack.handling.Context
+           java.io.ByteArrayInputStream
+           java.io.ByteArrayOutputStream))
+
+;; --- Handlers
+
+(def ^:private +reader-handlers+
+  dt/+read-handlers+)
+
+(def ^:private +write-handlers+
+  dt/+write-handlers+)
+
+;; --- Low-Level Api
+
+(defn reader
+  ([istream]
+   (reader istream nil))
+  ([istream {:keys [type] :or {type :json}}]
+   (t/reader istream type {:handlers +reader-handlers+})))
+
+(defn read!
+  "Read value from streamed transit reader."
+  [reader]
+  (t/read reader))
+
+(defn writer
+  ([ostream]
+   (writer ostream nil))
+  ([ostream {:keys [type] :or {type :json}}]
+   (t/writer ostream type {:handlers +write-handlers+})))
+
+(defn write!
+  [writer data]
+  (t/write writer data))
+
+
+;; --- Catacumba Extension
+
+(defmethod cparse/parse-body :application/transit+json
+  [^Context ctx ^TypedData body]
+  (let [reader (reader (.getInputStream body) {:type :json})]
+    (read! reader)))
+
+;; --- High-Level Api
+
+(defn decode
+  ([data]
+   (decode data nil))
+  ([data opts]
+   (with-open [input (ByteArrayInputStream. data)]
+     (read! (reader input opts)))))
+
+(defn encode
+  ([data]
+   (encode data nil))
+  ([data opts]
+   (with-open [out (ByteArrayOutputStream.)]
+     (let [w (writer out opts)]
+       (write! w data)
+       (.toByteArray out)))))

backend/src/uxbox/util/uuid.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) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(ns uxbox.util.uuid
+  (:require [clj-uuid :as uuid])
+  (:import java.util.UUID))
+
+(def ^:const zero uuid/+null+)
+
+(def random
+  "Alias for clj-uuid/v4."
+  uuid/v4)
+
+(defn namespaced
+  [ns data]
+  (uuid/v5 ns data))
+
+(defn from-string
+  "Parse string uuid representation into proper UUID instance."
+  [s]
+  (UUID/fromString s))
+

backend/src/uxbox/util/workers.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) 2016 Andrey Antukh <niwi@niwi.nz>
+
+(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]))
+
+(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-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-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))
+
+      clojure.lang.IDeref
+      (deref [_]
+        (.join thread))
+
+       clojure.lang.IBlockingDeref
+       (deref [_ ms default]
+         (.join thread ms)
+         default))))

backend/test/storages/tests.clj

@@ -0,0 +1,106 @@
+(ns storages.tests
+  (:require [clojure.test :as t]
+            [storages.core :as st]
+            [storages.fs.local :as fs]
+            [storages.fs.misc :as misc])
+  (:import java.io.File
+           org.apache.commons.io.FileUtils))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Test Fixtures
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- clean-temp-directory
+  [next]
+  (next)
+  (let [directory (File. "/tmp/catacumba/")]
+    (FileUtils/deleteDirectory directory)))
+
+(t/use-fixtures :each clean-temp-directory)
+
+;; --- Tests: FileSystemStorage
+
+(t/deftest test-localfs-store-and-lookup
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})
+        rpath  @(st/save storage "test.txt" "my content")
+        fpath @(st/lookup storage rpath)
+        fdata (slurp fpath)]
+    (t/is (= (str fpath) "/tmp/catacumba/test/test.txt"))
+    (t/is (= "my content" fdata))))
+
+(t/deftest test-localfs-store-and-get-public-url
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})
+        rpath  @(st/save storage "test.txt" "my content")
+        ruri (st/public-url storage rpath)]
+    (t/is (= (str ruri) "http://localhost:5050/test.txt"))))
+
+(t/deftest test-localfs-store-and-lookup-with-subdirs
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})
+        rpath  @(st/save storage "somepath/test.txt" "my content")
+        fpath @(st/lookup storage rpath)
+        fdata (slurp fpath)]
+    (t/is (= (str fpath) "/tmp/catacumba/test/somepath/test.txt"))
+    (t/is (= "my content" fdata))))
+
+(t/deftest test-localfs-store-and-delete-and-check
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})
+        rpath  @(st/save storage "test.txt" "my content")]
+    (t/is @(st/delete storage rpath))
+    (t/is (not @(st/exists? storage rpath)))))
+
+(t/deftest test-localfs-store-duplicate-file-raises-exception
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})]
+    (t/is @(st/save storage "test.txt" "my content"))
+    (t/is (thrown? java.util.concurrent.ExecutionException
+                   @(st/save storage "test.txt" "my content")))))
+
+(t/deftest test-localfs-access-unauthorized-path
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})]
+    (t/is (thrown? java.util.concurrent.ExecutionException
+                   @(st/lookup storage "../test.txt")))
+    (t/is (thrown? java.util.concurrent.ExecutionException
+                   @(st/lookup storage "/test.txt")))))
+
+;; --- Tests: ScopedPathStorage
+
+(t/deftest test-localfs-scoped-store-and-lookup
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})
+        storage (misc/scoped storage "some/prefix")
+        rpath  @(st/save storage "test.txt" "my content")
+        fpath @(st/lookup storage rpath)
+        fdata (slurp fpath)]
+    (t/is (= (str fpath) "/tmp/catacumba/test/some/prefix/test.txt"))
+    (t/is (= "my content" fdata))))
+
+(t/deftest test-localfs-scoped-store-and-delete-and-check
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})
+        storage (misc/scoped storage "some/prefix")
+        rpath  @(st/save storage "test.txt" "my content")]
+    (t/is @(st/delete storage rpath))
+    (t/is (not @(st/exists? storage rpath)))))
+
+(t/deftest test-localfs-scoped-store-duplicate-file-raises-exception
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})
+        storage (misc/scoped storage "some/prefix")]
+    (t/is @(st/save storage "test.txt" "my content"))
+    (t/is (thrown? java.util.concurrent.ExecutionException
+                   @(st/save storage "test.txt" "my content")))))
+
+(t/deftest test-localfs-scoped-access-unauthorized-path
+  (let [storage (fs/filesystem {:basedir "/tmp/catacumba/test"
+                                :baseuri "http://localhost:5050/"})
+        storage (misc/scoped storage "some/prefix")]
+    (t/is (thrown? java.util.concurrent.ExecutionException
+                   @(st/lookup storage "../test.txt")))
+    (t/is (thrown? java.util.concurrent.ExecutionException
+                   @(st/lookup storage "/test.txt")))))
+

backend/test/uxbox/tests/_files/sample1.svg

@@ -0,0 +1,20 @@
+<svg xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:cc="http://creativecommons.org/ns#" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:svg="http://www.w3.org/2000/svg" xmlns="http://www.w3.org/2000/svg" xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" width="500" height="500" viewBox="0 0 500.00001 500.00001" id="svg2" version="1.1" sodipodi:docname="lock.svg">
+  <defs id="defs4"/>
+  <sodipodi:namedview id="base" pagecolor="#ffffff" bordercolor="#666666" borderopacity="1.0" showgrid="false" units="px"/>
+  <metadata id="metadata7">
+    <rdf:RDF>
+      <cc:Work rdf:about="">
+        <dc:format>
+
+
+          image/svg+xml
+
+
+        </dc:format>
+        <dc:type rdf:resource="http://purl.org/dc/dcmitype/StillImage"/>
+      </cc:Work>
+    </rdf:RDF>
+  </metadata>
+  <use id="use32130" xlink:href="#symbol16714" transform="matrix(0.48875855,0,0,0.48875855,266.5973,18.208584)" x="0" y="0" width="100%" height="100%"/>
+  <path id="path4498" d="m110.60416 499.33847c-22.177988-4.50776-39.962038-21.75589-46.405198-45.0068-1.977315-7.13539-2.016513-9.26603-2.016513-109.60819 0-98.645 0.06949-102.60306 1.929042-109.87383 4.423652-17.29632 16.524827-32.63809 31.819424-40.34039l7.825735-3.94103 0.60407-49.32264c0.65846-53.763135 0.62011-53.373185 6.83197-69.481055 8.21794-21.30983 30.46536-44.049766 55.16981-56.391163 10.20624-5.09865 24.27131-9.8702562 37.2909-12.6510232 12.29719-2.62647101 13.38097-2.69147701 45.36838-2.72123901 36.82119-0.03426 43.33148 0.691327 63.09496 7.03207001 22.66364 7.2712112 38.73778 16.8847932 54.33879 32.4988162 11.05888 11.068109 16.97809 19.704479 22.16356 32.337529 5.96869 14.54116 6.15544 16.63373 6.17191 69.157365 0.008 26.25671 0.33839 48.1887 0.73367 48.73773 0.39527 0.54903 4.20746 2.70218 8.47153 4.7848 15.26633 7.45624 27.42013 22.8142 31.8923 40.30023 1.85931 7.2698 1.92905 11.22683 1.92905 109.45314 0 98.71665-0.0614 102.15316-1.95844 109.64831-2.76597 10.92815-7.22084 19.12549-14.77309 27.18364-7.14127 7.61966-13.97588 12.19324-24.11727 16.13877l-6.5947 2.56569-137.92851 0.14728c-75.86068 0.081-139.6893-0.21059-141.84138-0.64801zm275.44488-42.36785c3.21442-1.69982 4.97898-3.57704 7.00136-7.44832l2.70384-5.17574 0-101.43074 0-101.43073-2.51453-5.046c-1.49217-2.99441-3.82602-5.85656-5.74021-7.03959-3.20494-1.98076-4.09399-1.99357-138.31459-1.99357l-135.08891 0-3.61136 3.17081c-7.68721 6.74946-7.17152-1.28062-7.19562 112.04559-0.019 89.01071 0.15867 101.46341 1.49253 104.6558 1.77442 4.24679 4.66753 7.5951 8.75726 10.13513 2.8251 1.7546 7.88585 1.82277 135.57367 1.82629l132.63902 0.004 4.29754-2.2726zM210.87134 414.7115c0-0.81959 3.52158-15.55592 7.82573-32.74738 4.30416-17.19147 7.82573-31.96021 7.82573-32.81943 0-0.85925-2.41047-3.76528-5.3566-6.45788-9.7665-8.92602-14.60162-22.54037-12.4537-35.0661 1.56659-9.13564 4.34066-14.72784 10.7286-21.62759 23.40741-25.28278 65.56256-12.69769 71.62135 21.382 2.17751 12.24808-2.24683 25.13545-11.97693 34.88693l-5.77232 5.785 8.32828 33.30344c4.58055 18.31689 8.11305 33.65168 7.84999 34.07733-0.26305 0.42563-18.0602 0.77387-39.54921 0.77387-34.34393 0-39.07092-0.18029-39.07092-1.49019zM354.66915 143.45686c0-49.238655-0.0768-50.006535-6.08212-60.826955-10.93104-19.69552-35.55506-34.687-65.08507-39.62477-14.60005-2.441306-62.54427-1.62974-74.64943 1.26361-30.35851 7.25623-52.8469 24.27954-61.66065 46.676-2.28452 5.80515-2.31336 6.34422-2.63922 49.320085-0.1812 23.89793-0.0718 44.47715 0.24301 45.73161l0.57244 2.28083 104.65052 0 104.65052 0 0-44.82041z"/>
+</svg>

backend/test/uxbox/tests/_files/sample2.svg

@@ -0,0 +1,54 @@
+<?xml version="1.0" encoding="UTF-8" standalone="no"?>
+<svg
+   xmlns:dc="http://purl.org/dc/elements/1.1/"
+   xmlns:cc="http://creativecommons.org/ns#"
+   xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
+   xmlns:svg="http://www.w3.org/2000/svg"
+   xmlns="http://www.w3.org/2000/svg"
+   xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd"
+   xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape"
+   width="500"
+   height="500"
+   viewBox="0 0 500 500.00001"
+   id="svg2"
+   version="1.1"
+   inkscape:version="0.91 r13725"
+   sodipodi:docname="play.svg">
+  <metadata
+     id="metadata10">
+    <rdf:RDF>
+      <cc:Work
+         rdf:about="">
+        <dc:format>image/svg+xml</dc:format>
+        <dc:type
+           rdf:resource="http://purl.org/dc/dcmitype/StillImage" />
+      </cc:Work>
+    </rdf:RDF>
+  </metadata>
+  <defs
+     id="defs8" />
+  <sodipodi:namedview
+     pagecolor="#ffffff"
+     bordercolor="#666666"
+     borderopacity="1"
+     objecttolerance="10"
+     gridtolerance="10"
+     guidetolerance="10"
+     inkscape:pageopacity="0"
+     inkscape:pageshadow="2"
+     inkscape:window-width="1920"
+     inkscape:window-height="1056"
+     id="namedview6"
+     showgrid="false"
+     inkscape:zoom="0.472"
+     inkscape:cx="250"
+     inkscape:cy="250"
+     inkscape:window-x="0"
+     inkscape:window-y="24"
+     inkscape:window-maximized="1"
+     inkscape:current-layer="svg2" />
+  <path
+     d="m 121.67073,70.753329 0,359.389241 c 0,12.19281 8.74009,22.00921 23.46146,21.00294 14.72137,-1.00628 22.01162,-5.33889 27.30623,-10.32034 71.43412,-52.70054 141.82816,-106.26647 212.71245,-159.42587 7.89079,-6.55446 17.48742,-12.31195 23.29965,-20.13673 5.24872,-9.68035 -1.12541,-20.67448 -11.37732,-26.63162 C 320.53204,173.95026 244.16396,113.11502 166.1641,53.583899 c -4.02348,-2.658979 -9.04841,-4.760077 -22.40044,-4.800328 -13.35284,-0.04025 -22.09293,9.776148 -22.09293,21.968958 z m 44.01841,39.302621 c 32.61935,25.56497 124.45828,97.72763 175.71703,139.98708 3.07839,5.93701 -5.40168,9.45575 -9.37686,13.25704 -54.54483,42.67403 -111.22136,83.65914 -166.34097,125.8727 z"
+     id="path4"
+     inkscape:connector-curvature="0" />
+</svg>

backend/test/uxbox/tests/helpers.clj

@@ -0,0 +1,209 @@
+(ns uxbox.tests.helpers
+  (:refer-clojure :exclude [await])
+  (:require [clj-http.client :as http]
+            [buddy.hashers :as hashers]
+            [buddy.core.codecs :as codecs]
+            [catacumba.serializers :as sz]
+            [mount.core :as mount]
+            [storages.core :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]))
+
+(def +base-url+ "http://localhost:5050")
+
+(defn state-init
+  [next]
+  (let [config (cfg/read-test-config)]
+    (-> (mount/only #{#'uxbox.config/config
+                      #'uxbox.config/secret
+                      #'uxbox.db/datasource
+                      #'uxbox.migrations/migrations
+                      #'uxbox.media/static-storage
+                      #'uxbox.media/media-storage
+                      #'uxbox.media/images-storage
+                      #'uxbox.media/thumbnails-storage})
+        (mount/swap {#'uxbox.config/config config})
+        (mount/start))
+    (try
+      (next)
+      (finally
+        (mount/stop)))))
+
+(defn database-reset
+  [next]
+  (state-init
+   (fn []
+     (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;"))))
+     (try
+       (next)
+       (finally
+         (st/clear! uxbox.media/media-storage)
+         (st/clear! uxbox.media/static-storage))))))
+
+(defmacro await
+  [expr]
+  `(try
+     (deref ~expr)
+     (catch Exception e#
+       (.getCause e#))))
+
+(defn- strip-response
+  [{:keys [status headers body]}]
+  (if (= (get headers "content-type") "application/transit+json")
+    [status (-> (codecs/str->bytes body)
+                (t/decode))]
+    [status body]))
+
+(defn http-get
+  ([user uri] (http-get user uri nil))
+  ([user uri {:keys [query] :as opts}]
+   (let [headers (when user
+                   {"Authorization" (str "Token " (usa/generate-token user))})
+         params (merge {:headers headers}
+                       (when query
+                         {: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 (merge
+                  {"content-type" "application/transit+json"}
+                  (when user
+                    {"Authorization" (str "Token " (usa/generate-token user))}))
+         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 (merge
+                  (when user
+                    {"Authorization" (str "Token " (usa/generate-token user))}))
+        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 (merge
+                  {"content-type" "application/transit+json"}
+                  (when user
+                    {"Authorization" (str "Token " (usa/generate-token user))}))
+         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 (when user
+                   {"Authorization" (str "Token " (usa/generate-token user))})
+         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")
+                  user (assoc "authorization"
+                              (str "Token " (usa/generate-token user))))
+        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))))))
+
+(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)))
+
+(defmacro try-on
+  [& body]
+  `(try
+     (let [result# (do ~@body)]
+       [nil result#])
+     (catch Throwable e#
+       [e# nil])))
+
+(defn exception?
+  [v]
+  (instance? Throwable v))
+
+(defn ex-info?
+  [v]
+  (instance? clojure.lang.ExceptionInfo v))
+
+(defn ex-of-type?
+  [e type]
+  (let [data (ex-data e)]
+    (= type (:type data))))
+
+(defn ex-with-code?
+  [e code]
+  (let [data (ex-data e)]
+    (= code (:code data))))
+

backend/test/uxbox/tests/test_auth.clj

@@ -0,0 +1,53 @@
+(ns uxbox.tests.test-auth
+  (:require [clojure.test :as t]
+            [promesa.core :as p]
+            [clj-http.client :as http]
+            [catacumba.testing :refer (with-server)]
+            [buddy.hashers :as hashers]
+            [uxbox.db :as db]
+            [uxbox.frontend :as uft]
+            [uxbox.services.users :as usu]
+            [uxbox.services :as usv]
+            [uxbox.tests.helpers :as th]))
+
+(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))]
+    (with-server {:handler (uft/routes)}
+      (let [data {:username "user1"
+                  :password "user1"
+                  :metadata "1"
+                  :scope "foobar"}
+            uri (str th/+base-url+ "/api/auth/token")
+            [status data] (th/http-post uri {:body data})]
+        ;; (println "RESPONSE:" status data)
+        (t/is (= status 200))
+        (t/is (contains? data :token))))))
+
+(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))]
+    (with-server {:handler (uft/routes)}
+      (let [data {:username "user1"
+                  :password "user2"
+                  :metadata "2"
+                  :scope "foobar"}
+            uri (str th/+base-url+ "/api/auth/token")
+            [status data] (th/http-post uri {:body data})]
+        ;; (println "RESPONSE:" status data)
+        (t/is (= 400 status))
+        (t/is (= (:type data) :validation))
+        (t/is (= (:code data) :uxbox.services.auth/wrong-credentials))))))
+

backend/test/uxbox/tests/test_icons.clj

@@ -0,0 +1,163 @@
+(ns uxbox.tests.test-icons
+  (:require [clojure.test :as t]
+            [promesa.core :as p]
+            [suricatta.core :as sc]
+            [clj-uuid :as uuid]
+            [clojure.java.io :as io]
+            [catacumba.testing :refer (with-server)]
+            [buddy.core.codecs :as codecs]
+            [uxbox.db :as db]
+            [uxbox.sql :as sql]
+            [uxbox.frontend :as uft]
+            [uxbox.services.icons :as icons]
+            [uxbox.services :as usv]
+            [uxbox.tests.helpers :as th]))
+
+(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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+      (with-server {:handler (uft/routes)}
+        (let [uri (str th/+base-url+ "/api/library/icons")
+              data {:name "sample.jpg"
+                    :content "<g></g>"
+                    :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 "<g></g>"
+                :metadata {}
+                :collection nil}
+          icon (icons/create-icon conn data)]
+      (with-server {:handler (uft/routes)}
+        (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 "<g></g>"
+                :metadata {}
+                :collection nil}
+          icon (icons/create-icon conn data)]
+      (with-server {:handler (uft/routes)}
+        (let [uri (str th/+base-url+ "/api/library/icons/copy")
+              body {:id (:id icon) :collection nil}
+              params {:body body}
+              [status data] (th/http-put user uri params)]
+          (println "RESPONSE:" status data)
+          (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 "<g></g>"
+                :metadata {}
+                :collection nil}
+          icon (icons/create-icon conn data)]
+      (with-server {:handler (uft/routes)}
+        (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"
+;;                 :path "some/path"
+;;                 :collection nil}
+;;           icon (icons/create-icon conn data)]
+;;       (with-server {:handler (uft/routes)}
+;;         (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))))))))

backend/test/uxbox/tests/test_images.clj

@@ -0,0 +1,169 @@
+(ns uxbox.tests.test-images
+  (:require [clojure.test :as t]
+            [promesa.core :as p]
+            [suricatta.core :as sc]
+            [clojure.java.io :as io]
+            [catacumba.testing :refer (with-server)]
+            [storages.core :as st]
+            [uxbox.db :as db]
+            [uxbox.sql :as sql]
+            [uxbox.media :as media]
+            [uxbox.frontend :as uft]
+            [uxbox.services.images :as images]
+            [uxbox.services :as usv]
+            [uxbox.tests.helpers :as th]))
+
+(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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+;;       (with-server {:handler (uft/routes)}
+;;         (let [uri (str th/+base-url+ "/api/library/images")
+;;               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 (= 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)]
+      (with-server {:handler (uft/routes)}
+        (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)]
+      (with-server {:handler (uft/routes)}
+        (let [uri (str th/+base-url+ "/api/library/images/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)]
+      (with-server {:handler (uft/routes)}
+        (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"
+;;                 :collection nil}
+;;           img (images/create-image conn data)]
+;;       (with-server {:handler (uft/routes)}
+;;         (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))))))))