🎉 Add media-object lifecycle handling.

.gitignore

@@ -15,6 +15,7 @@ node_modules
 /backend/target/
 /backend/resources/public/media
 /backend/dist/
+/backend/logs/
 /backend/-
 /frontend/npm-debug.log
 /frontend/target/

backend/deps.edn

@@ -67,6 +67,7 @@
    {com.bhauman/rebel-readline {:mvn/version "0.1.4"}
     org.clojure/tools.namespace {:mvn/version "1.0.0"}
     org.clojure/test.check {:mvn/version "1.0.0"}
+    clj-kondo/clj-kondo {:mvn/version "RELEASE"}
 
     fipp/fipp {:mvn/version "0.6.21"}
     criterium/criterium {:mvn/version "0.4.5"}
@@ -74,8 +75,7 @@
    :extra-paths ["tests"]}
 
   :lint
-  {:extra-deps {clj-kondo/clj-kondo {:mvn/version "RELEASE"}}
+  {:main-opts ["-m" "clj-kondo.main"]}
-   :main-opts ["-m" "clj-kondo.main"]}
 
   :tests
   {:extra-deps {lambdaisland/kaocha {:mvn/version "0.0-581"}}

backend/resources/log4j2.xml

@@ -1,15 +1,40 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="info" monitorInterval="60">
+<Configuration status="info" monitorInterval="30">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="%d{HH:mm:ss.SSS} [%t] %-5level %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
     </Console>
+
+    <RollingFile name="file-debug" fileName="logs/app-debug.log" filePattern="logs/app-debug-%i.log">
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
+      <Policies>
+        <SizeBasedTriggeringPolicy size="50M"/>
+      </Policies>
+      <DefaultRolloverStrategy max="9"/>
+    </RollingFile>
+
+    <RollingFile name="file" fileName="logs/app.log" filePattern="logs/app-%i.log">
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
+      <Policies>
+        <SizeBasedTriggeringPolicy size="20M"/>
+      </Policies>
+      <DefaultRolloverStrategy max="9"/>
+    </RollingFile>
   </Appenders>
+
   <Loggers>
-    <Logger name="com.zaxxer.hikari" level="info" additivity="false"></Logger>
+    <Logger name="com.zaxxer.hikari" level="error" additivity="false">
-    <Logger name="io.lettuce.core" level="info" additivity="false"></Logger>
+      <AppenderRef ref="console"/>
-    <Logger name="io.netty" level="info" additivity="false"></Logger>
+    </Logger>
-    <Root level="debug">
+
+    <Logger name="io.lettuce" level="error" additivity="false" />
+
+    <Logger name="uxbox" level="debug" additivity="false">
+      <AppenderRef ref="file-debug" level="debug" />
+      <AppenderRef ref="file" level="info" />
+    </Logger>
+
+    <Root level="info">
       <AppenderRef ref="console"/>
     </Root>
   </Loggers>

backend/resources/migrations/0003-add-project-tables.sql

@@ -38,7 +38,6 @@ CREATE INDEX project_profile_rel__project_id__idx
     ON project_profile_rel(project_id);
 
 
-
 CREATE TABLE file (
   id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
   project_id uuid NOT NULL REFERENCES project(id) ON DELETE CASCADE,
@@ -77,7 +76,6 @@ CREATE TRIGGER file_profile_rel__modified_at__tgr
 BEFORE UPDATE ON file_profile_rel
    FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
 
-
 CREATE TABLE file_image (
   id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
   file_id uuid NOT NULL REFERENCES file(id) ON DELETE CASCADE,
@@ -168,7 +166,6 @@ BEFORE UPDATE ON page
    FOR EACH ROW EXECUTE PROCEDURE handle_page_update();
 
 
-
 CREATE TABLE page_version (
   id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
 
@@ -220,3 +217,4 @@ CREATE INDEX page_change__page_id__idx
 CREATE TRIGGER page_change__modified_at__tgr
 BEFORE UPDATE ON page_change
    FOR EACH ROW EXECUTE PROCEDURE update_modified_at();
+

backend/resources/migrations/0018-add-file-trimming-triggers.sql

@@ -0,0 +1,25 @@
+ALTER TABLE file
+  ADD COLUMN has_media_trimmed boolean DEFAULT false;
+
+CREATE INDEX file__modified_at__has_media_trimed__idx
+    ON file(modified_at)
+ WHERE has_media_trimmed IS false;
+
+CREATE FUNCTION on_media_object_insert()
+  RETURNS TRIGGER AS $$
+  BEGIN
+    UPDATE file
+       SET has_media_trimmed = false,
+           modified_at = now()
+     WHERE id = NEW.file_id;
+    RETURN NEW;
+  END;
+$$ LANGUAGE plpgsql;
+
+CREATE TRIGGER media_object__insert__tgr
+AFTER INSERT ON media_object
+   FOR EACH ROW EXECUTE PROCEDURE on_media_object_insert();
+
+CREATE TRIGGER media_thumbnail__on_delete__tgr
+ AFTER DELETE ON media_thumbnail
+   FOR EACH ROW EXECUTE PROCEDURE handle_delete();

backend/resources/migrations/0019-add-improved-scheduled-tasks.sql

@@ -0,0 +1,24 @@
+DROP TABLE scheduled_task;
+
+CREATE TABLE scheduled_task (
+  id text PRIMARY KEY,
+
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  modified_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+
+  cron_expr text NOT NULL
+);
+
+CREATE TABLE scheduled_task_history (
+  id uuid DEFAULT uuid_generate_v4(),
+  task_id text NOT NULL REFERENCES scheduled_task(id),
+
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  is_error boolean NOT NULL DEFAULT false,
+  reason text NULL DEFAULT NULL,
+
+  PRIMARY KEY (id, created_at)
+);
+
+CREATE INDEX scheduled_task_history__task_id__idx
+    ON scheduled_task_history(task_id);

backend/resources/migrations/0020-minor-fixes-to-media-object.sql

@@ -0,0 +1,8 @@
+alter table media_object drop column modified_at;
+alter index image_pkey rename to media_object_pkey;
+alter index image__file_id__idx rename to media_bject__file_id__idx;
+alter table media_object rename constraint image_file_id_fkey to media_object_file_id_fkey;
+alter trigger image__on_delete__tgr on media_object rename to media_object__on_delete__tgr;
+drop trigger image__modified_at__tgr on media_object;
+
+

backend/resources/migrations/0021-http-session-improvements.sql

@@ -0,0 +1,4 @@
+alter table http_session drop constraint http_session_pkey;
+alter table http_session add primary key (id, profile_id);
+alter table http_session drop column modified_at;
+drop index http_session__profile_id__idx;

backend/scripts/repl

@@ -0,0 +1,6 @@
+#!/usr/bin/env bash
+set -ex
+
+# clojure -Ojmx-remote -A:dev -e "(set! *warn-on-reflection* true)" -m rebel-readline.main
+# clojure -Ojmx-remote -A:dev -J-XX:+UnlockExperimentalVMOptions -J-XX:+UseZGC -J-Xms128m -J-Xmx128m -m rebel-readline.main
+clojure -Ojmx-remote -A:dev -J-Xms128m -J-Xmx128m -m rebel-readline.main

backend/src/data_readers.clj

@@ -1,3 +1,3 @@
 {uxbox/instant uxbox.util.time/from-string
  uxbox/cron uxbox.util.time/cron
- uxbox/duration uxbox.util.time/parse-duration}
+ uxbox/duration uxbox.util.time/duration}

backend/src/uxbox/config.clj

@@ -17,7 +17,7 @@
    [mount.core :refer [defstate]]
    [uxbox.common.exceptions :as ex]
    [uxbox.common.spec :as us]
-   [uxbox.util.time :as tm]))
+   [uxbox.util.time :as dt]))
 
 (def defaults
   {:http-server-port 6060
@@ -45,6 +45,12 @@
    :registration-domain-whitelist ""
    :debug-humanize-transit true
 
+   ;; This is the time should transcurr after the last page
+   ;; modification in order to make the file ellegible for
+   ;; trimming. The value only supports s(econds) m(inutes) and
+   ;; h(ours) as time unit.
+   :file-trimming-max-age "72h"
+
    ;; LDAP auth disabled by default. Set ldap-auth-host to enable
    ;:ldap-auth-host "ldap.mysupercompany.com"
    ;:ldap-auth-port 389
@@ -53,6 +59,7 @@
    ;:ldap-auth-ssl false
    ;:ldap-auth-starttls false
    ;:ldap-auth-base-dn "ou=People,dc=ldap,dc=mysupercompany,dc=com"
+
    :ldap-auth-user-query "(|(uid=$username)(mail=$username))"
    :ldap-auth-username-attribute "uid"
    :ldap-auth-email-attribute "mail"
@@ -103,6 +110,7 @@
 (s/def ::ldap-auth-email-attribute ::us/string)
 (s/def ::ldap-auth-fullname-attribute ::us/string)
 (s/def ::ldap-auth-avatar-attribute ::us/string)
+(s/def ::file-trimming-threshold ::dt/duration)
 
 (s/def ::config
   (s/keys :opt-un [::http-server-cors
@@ -128,6 +136,7 @@
                    ::smtp-password
                    ::smtp-tls
                    ::smtp-ssl
+                   ::file-trimming-max-age
                    ::debug-humanize-transit
                    ::allow-demo-users
                    ::registration-enabled
@@ -148,12 +157,13 @@
 
 (defn env->config
   [env]
-  (reduce-kv (fn [acc k v]
+  (reduce-kv
-               (cond-> acc
+   (fn [acc k v]
-                 (str/starts-with? (name k) "uxbox-")
+     (cond-> acc
-                 (assoc (keyword (subs (name k) 6)) v)))
+       (str/starts-with? (name k) "uxbox-")
-             {}
+       (assoc (keyword (subs (name k) 6)) v)))
-             env))
+   {}
+   env))
 
 (defn read-config
   [env]
@@ -174,4 +184,4 @@
   :start (read-config env))
 
 (def default-deletion-delay
-  (tm/duration {:hours 48}))
+  (dt/duration {:hours 48}))

backend/src/uxbox/http.clj

@@ -14,12 +14,12 @@
    [reitit.ring :as rring]
    [ring.adapter.jetty9 :as jetty]
    [uxbox.config :as cfg]
-   [uxbox.http.debug :as debug]
-   [uxbox.http.errors :as errors]
-   [uxbox.http.handlers :as handlers]
    [uxbox.http.auth :as auth]
    [uxbox.http.auth.google :as google]
    [uxbox.http.auth.ldap :as ldap]
+   [uxbox.http.debug :as debug]
+   [uxbox.http.errors :as errors]
+   [uxbox.http.handlers :as handlers]
    [uxbox.http.middleware :as middleware]
    [uxbox.http.session :as session]
    [uxbox.http.ws :as ws]
@@ -52,28 +52,26 @@
      ["/login-ldap" {:handler ldap/auth
                      :method :post}]
 
-     ["/w" {:middleware [session/auth]}
+     ["/w" {:middleware [session/middleware]}
       ["/query/:type" {:get handlers/query-handler}]
       ["/mutation/:type" {:post handlers/mutation-handler}]]]]))
 
-(defstate app
-  :start (rring/ring-handler
-          (create-router)
-          (constantly {:status 404, :body ""})
-          {:middleware [[middleware/development-resources]
-                        [middleware/development-cors]
-                        [middleware/metrics]]}))
-
 (defn start-server
-  [cfg app]
+  []
   (let [wsockets {"/ws/notifications" ws/handler}
-        options  {:port (:http-server-port cfg)
+        options  {:port (:http-server-port cfg/config)
                   :h2c? true
                   :join? false
                   :allow-null-path-info true
-                  :websockets wsockets}]
+                  :websockets wsockets}
-    (jetty/run-jetty app options)))
+        handler  (rring/ring-handler
+                  (create-router)
+                  (constantly {:status 404, :body ""})
+                  {:middleware [[middleware/development-resources]
+                                [middleware/development-cors]
+                                [middleware/metrics]]})]
+    (jetty/run-jetty handler options)))
 
 (defstate server
-  :start (start-server cfg/config app)
+  :start (start-server)
   :stop (.stop server))

backend/src/uxbox/http/session.clj

@@ -10,17 +10,23 @@
 (ns uxbox.http.session
   (:require
    [uxbox.db :as db]
-   [uxbox.services.tokens :as tokens]
+   [uxbox.services.tokens :as tokens]))
-   [uxbox.common.uuid :as uuid]))
+
+(defn extract-auth-token
+  [request]
+  (get-in request [:cookies "auth-token" :value]))
 
 (defn retrieve
-  "Retrieves a user id associated with the provided auth token."
+  [conn token]
-  [token]
   (when token
-    (-> (db/query db/pool :http-session {:id token})
+    (-> (db/exec-one! conn ["select profile_id from http_session where id = ?" token])
-        (first)
         (:profile-id))))
 
+(defn retrieve-from-request
+  [conn request]
+  (->> (extract-auth-token request)
+       (retrieve conn)))
+
 (defn create
   [profile-id user-agent]
   (let [id (tokens/next-token)]
@@ -39,21 +45,13 @@
   ([id opts]
    {"auth-token" (merge opts {:value id :path "/" :http-only true})}))
 
-(defn extract-auth-token
+(defn wrap-session
-  [req]
-  (get-in req [:cookies "auth-token" :value]))
-
-(defn wrap-auth
   [handler]
   (fn [request]
-    (let [token (get-in request [:cookies "auth-token" :value])
+    (if-let [profile-id (retrieve-from-request db/pool request)]
-          profile-id (retrieve token)]
+      (handler (assoc request :profile-id profile-id))
-      (if profile-id
+      (handler request))))
-        (handler (assoc request :profile-id profile-id))
-        (handler request)))))
 
-;; TODO: maybe rename to wrap-session?
+(def middleware
-
+  {:nane ::middleware
-(def auth
+   :compile (constantly wrap-session)})
-  {:nane ::auth
-   :compile (constantly wrap-auth)})

backend/src/uxbox/http/ws.clj

@@ -18,7 +18,7 @@
    [ring.middleware.params :refer [wrap-params]]
    [uxbox.common.spec :as us]
    [uxbox.db :as db]
-   [uxbox.http.session :refer [wrap-auth]]
+   [uxbox.http.session :refer [wrap-session]]
    [uxbox.services.notifications :as nf]))
 
 (s/def ::file-id ::us/uuid)
@@ -47,7 +47,7 @@
 
 (def handler
   (-> websocket
-      (wrap-auth)
+      (wrap-session)
       (wrap-keyword-params)
       (wrap-cookies)
       (wrap-params)))

backend/src/uxbox/migrations.clj

@@ -83,7 +83,24 @@
 
     {:desc "Link files to libraries"
      :name "0017-link-files-to-libraries"
-     :fn (mg/resource "migrations/0017-link-files-to-libraries.sql")}]})
+     :fn (mg/resource "migrations/0017-link-files-to-libraries.sql")}
+
+    {:desc "Add file triming triggers"
+     :name "0018-add-file-trimming-triggers"
+     :fn (mg/resource "migrations/0018-add-file-trimming-triggers.sql")}
+
+    {:desc "Improve scheduled task tables"
+     :name "0019-add-improved-scheduled-tasks"
+     :fn (mg/resource "migrations/0019-add-improved-scheduled-tasks.sql")}
+
+    {:desc "Minor fixes to media object"
+     :name "0020-minor-fixes-to-media-object"
+     :fn (mg/resource "migrations/0020-minor-fixes-to-media-object.sql")}
+
+    {:desc "Improve http session tables"
+     :name "0021-http-session-improvements"
+     :fn (mg/resource "migrations/0021-http-session-improvements.sql")}
+    ]})
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Entry point

backend/src/uxbox/services/mutations/media.clj

@@ -93,37 +93,35 @@
                                              :mtype (:content-type content)}})
         path  (persist-media-object-on-fs content)
         opts  (assoc thumbnail-options
-                    :input {:mtype (:mtype info)
+                     :input {:mtype (:mtype info)
-                            :path path})
+                             :path path})
         thumb (if-not (= (:mtype info) "image/svg+xml")
                 (persist-media-thumbnail-on-fs opts)
                 (assoc info
                        :path path
                        :quality 0))
 
-        media-object-id (or id (uuid/next))
+        id (or id (uuid/next))
 
-        media-object (-> (db/insert! conn :media-object
+        media-object (db/insert! conn :media-object
-                                     {:id media-object-id
+                                 {:id id
-                                      :file-id file-id
+                                  :file-id file-id
-                                      :is-local is-local
+                                  :is-local is-local
-                                      :name name
+                                  :name name
-                                      :path (str path)
+                                  :path (str path)
-                                      :width (:width info)
+                                  :width (:width info)
-                                      :height (:height info)
+                                  :height (:height info)
-                                      :mtype  (:mtype info)})
+                                  :mtype  (:mtype info)})
-                         (media/resolve-urls :path :uri))
 
-        media-thumbnail (-> (db/insert! conn :media-thumbnail
+        media-thumbnail (db/insert! conn :media-thumbnail
-                                        {:id (uuid/next)
+                                    {:id (uuid/next)
-                                         :media-object-id media-object-id
+                                     :media-object-id id
-                                         :path (str (:path thumb))
+                                     :path (str (:path thumb))
-                                         :width (:width thumb)
+                                     :width (:width thumb)
-                                         :height (:height thumb)
+                                     :height (:height thumb)
-                                         :quality (:quality thumb)
+                                     :quality (:quality thumb)
-                                         :mtype (:mtype thumb)})
+                                     :mtype (:mtype thumb)})]
-                            (media/resolve-urls :path :uri))]
+    (assoc media-object :thumb-path (:path media-thumbnail))))
-    (assoc media-object :thumb-uri (:uri media-thumbnail))))
 
 (def ^:private sql:select-file-for-update
   "select file.*,

backend/src/uxbox/services/tokens.clj

@@ -19,9 +19,9 @@
    [uxbox.db :as db]))
 
 (defn next-token
-  ([] (next-token 64))
+  ([] (next-token 96))
   ([n]
-   (-> (sodi.prng/random-bytes n)
+   (-> (sodi.prng/random-nonce n)
        (sodi.util/bytes->b64s))))
 
 (def default-duration

backend/src/uxbox/tasks.clj

@@ -5,54 +5,47 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2020 UXBOX Labs SL
 
 (ns uxbox.tasks
-  "Async tasks abstraction (impl)."
   (:require
+   [cuerdas.core :as str]
    [clojure.spec.alpha :as s]
    [clojure.tools.logging :as log]
-   [mount.core :as mount :refer [defstate]]
    [uxbox.common.spec :as us]
-   [uxbox.config :as cfg]
+   [uxbox.common.uuid :as uuid]
    [uxbox.db :as db]
-   [uxbox.metrics :as mtx]
+   [uxbox.util.time :as dt]
-   [uxbox.tasks.sendmail]
+   [uxbox.metrics :as mtx]))
-   [uxbox.tasks.gc]
-   [uxbox.tasks.remove-media]
-   [uxbox.tasks.delete-profile]
-   [uxbox.tasks.delete-object]
-   [uxbox.tasks.impl :as impl]
-   [uxbox.util.time :as dt]))
 
-;; --- State initialization
+(s/def ::name ::us/string)
+(s/def ::delay
+  (s/or :int ::us/integer
+        :duration dt/duration?))
+(s/def ::queue ::us/string)
 
-(def ^:private tasks
+(s/def ::task-options
-  {"delete-profile" #'uxbox.tasks.delete-profile/handler
+  (s/keys :req-un [::name]
-   "delete-object" #'uxbox.tasks.delete-object/handler
+          :opt-un [::delay ::props ::queue]))
-   "remove-media" #'uxbox.tasks.remove-media/handler
-   "sendmail" #'uxbox.tasks.sendmail/handler})
 
-(def ^:private schedule
+(def ^:private sql:insert-new-task
-  [{:id "remove-deleted-media"
+  "insert into task (id, name, props, queue, priority, max_retries, scheduled_at)
-    :cron (dt/cron "1 1 */1 * * ? *")
+   values (?, ?, ?, ?, ?, ?, clock_timestamp() + ?)
-    :fn #'uxbox.tasks.gc/remove-media}])
+   returning id")
-
-(defstate worker
-  :start (impl/start-worker! {:tasks tasks :name "worker1"})
-  :stop (impl/stop! worker))
-
-(defstate scheduler-worker
-  :start (impl/start-scheduler-worker! {:schedule schedule})
-  :stop (impl/stop! scheduler-worker))
-
-;; --- Public API
 
 (defn submit!
   ([opts] (submit! db/pool opts))
-  ([conn opts]
+  ([conn {:keys [name delay props queue priority max-retries]
-   (s/assert ::impl/task-options opts)
+          :or {delay 0 props {} queue "default" priority 100 max-retries 3}
-   (impl/submit! conn opts)))
+          :as options}]
+   (us/verify ::task-options options)
+   (let [duration  (dt/duration delay)
+         interval  (db/interval duration)
+         props     (db/tjson props)
+         id        (uuid/next)]
+     (log/info (str/format "Submit task '%s' to be executed in '%s'." name (str duration)))
+     (db/exec-one! conn [sql:insert-new-task id name props queue priority max-retries interval])
+     id)))
 
 (mtx/instrument-with-counter!
  {:var #'submit!

backend/src/uxbox/tasks/delete_object.clj

@@ -5,7 +5,7 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2020 UXBOX Labs SL
 
 (ns uxbox.tasks.delete-object
   "Generic task for permanent deletion of objects."
@@ -41,44 +41,27 @@
   :id "tasks__delete_object"
   :help "Timing of remove-object task."})
 
-(defmethod handle-deletion :image
-  [conn {:keys [id] :as props}]
-  (let [sql "delete from image where id=? and deleted_at is not null"]
-    (db/exec-one! conn [sql id])))
-
-(defmethod handle-deletion :image-collection
-  [conn {:keys [id] :as props}]
-  (let [sql "delete from image_collection
-              where id=? and deleted_at is not null"]
-    (db/exec-one! conn [sql id])))
-
-(defmethod handle-deletion :icon
-  [conn {:keys [id] :as props}]
-  (let [sql "delete from icon where id=? and deleted_at is not null"]
-    (db/exec-one! conn [sql id])))
-
-(defmethod handle-deletion :icon-collection
-  [conn {:keys [id] :as props}]
-  (let [sql "delete from icon_collection
-              where id=? and deleted_at is not null"]
-    (db/exec-one! conn [sql id])))
-
 (defmethod handle-deletion :file
   [conn {:keys [id] :as props}]
   (let [sql "delete from file where id=? and deleted_at is not null"]
     (db/exec-one! conn [sql id])))
 
-(defmethod handle-deletion :file-image
+(defmethod handle-deletion :project
   [conn {:keys [id] :as props}]
-  (let [sql "delete from file_image where id=? and deleted_at is not null"]
+  (let [sql "delete from project where id=? and deleted_at is not null"]
+    (db/exec-one! conn [sql id])))
+
+(defmethod handle-deletion :media-object
+  [conn {:keys [id] :as props}]
+  (let [sql "delete from media_object where id=? and deleted_at is not null"]
+    (db/exec-one! conn [sql id])))
+
+(defmethod handle-deletion :color
+  [conn {:keys [id] :as props}]
+  (let [sql "delete from color where id=? and deleted_at is not null"]
     (db/exec-one! conn [sql id])))
 
 (defmethod handle-deletion :page
   [conn {:keys [id] :as props}]
   (let [sql "delete from page where id=? and deleted_at is not null"]
     (db/exec-one! conn [sql id])))
-
-(defmethod handle-deletion :page-version
-  [conn {:keys [id] :as props}]
-  (let [sql "delete from page_version where id=? and deleted_at is not null"]
-    (db/exec-one! conn [sql id])))

backend/src/uxbox/tasks/delete_profile.clj

@@ -5,7 +5,7 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2020 UXBOX Labs SL
 
 (ns uxbox.tasks.delete-profile
   "Task for permanent deletion of profiles."

backend/src/uxbox/tasks/gc.clj

@@ -5,7 +5,7 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2016-2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2020 UXBOX Labs SL
 
 (ns uxbox.tasks.gc
   (:require
@@ -18,11 +18,30 @@
    [uxbox.common.spec :as us]
    [uxbox.config :as cfg]
    [uxbox.db :as db]
+   [uxbox.tasks :as tasks]
    [uxbox.media-storage :as mst]
    [uxbox.util.blob :as blob]
    [uxbox.util.storage :as ust]))
 
-(def ^:private sql:delete-items
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Task: Remove deleted media
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; The main purpose of this task is analize the `pending_to_delete`
+;; table. This table stores the references to the physical files on
+;; the file system thanks to `handle_delete()` trigger.
+
+;; Example:
+;; (1) You delete an media-object. (2) This media object is marked as
+;; deleted. (3) A task (`delete-object`) is scheduled for permanent
+;; delete the object.  - If that object stores media, the database
+;; will execute the `handle_delete()` trigger which will place
+;; filesystem paths into the `pendint_to_delete` table. (4) This
+;; task (`remove-deleted-media`) permanently delete the file from the
+;; filesystem when is executed (by scheduler).
+
+(def ^:private
+  sql:retrieve-peding-to-delete
   "with items_part as (
      select i.id
        from pending_to_delete as i
@@ -34,31 +53,24 @@
     where id in (select id from items_part)
    returning *")
 
-(defn- impl-remove-media
+(defn remove-deleted-media
-  [result]
-  (run! (fn [item]
-          (let [path1 (get item "path")
-                path2 (get item "thumb_path")]
-            (ust/delete! mst/media-storage path1)
-            (ust/delete! mst/media-storage path2)))
-        result))
-
-(defn- decode-row
-  [{:keys [data] :as row}]
-  (cond-> row
-    (db/pgobject? data) (assoc :data (db/decode-pgobject data))))
-
-(defn- get-items
-  [conn]
-  (->> (db/exec! conn [sql:delete-items 10])
-       (map decode-row)
-       (map :data)))
-
-(defn remove-media
   [{:keys [props] :as task}]
-  (db/with-atomic [conn db/pool]
+  (letfn [(decode-row [{:keys [data] :as row}]
-    (loop [result (get-items conn)]
+            (cond-> row
-      (when-not (empty? result)
+              (db/pgobject? data) (assoc :data (db/decode-pgobject data))))
-        (impl-remove-media result)
+          (retrieve-items [conn]
-        (recur (get-items conn))))))
+            (->> (db/exec! conn [sql:retrieve-peding-to-delete 10])
+                 (map decode-row)
+                 (map :data)))
+          (remove-media [rows]
+            (run! (fn [item]
+                    (let [path (get item "path")]
+                      (ust/delete! mst/media-storage path)))
+                  rows))]
+    (loop []
+      (let [rows (retrieve-items db/pool)]
+        (when-not (empty? rows)
+          (remove-media rows)
+          (recur))))))
+
 

backend/src/uxbox/tasks/impl.clj

@@ -302,31 +302,3 @@
   (.close ^java.lang.AutoCloseable worker))
 
 ;; --- Submit API
-
-(s/def ::name ::us/string)
-(s/def ::delay
-  (s/or :int ::us/integer
-        :duration dt/duration?))
-(s/def ::queue ::us/string)
-
-(s/def ::task-options
-  (s/keys :req-un [::name]
-          :opt-un [::delay ::props ::queue]))
-
-(def ^:private sql:insert-new-task
-  "insert into task (id, name, props, queue, priority, max_retries, scheduled_at)
-   values (?, ?, ?, ?, ?, ?, clock_timestamp() + ?)
-   returning id")
-
-(defn submit!
-  [conn {:keys [name delay props queue priority max-retries key]
-         :or {delay 0 props {} queue "default" priority 100 max-retries 3}
-         :as options}]
-  (us/verify ::task-options options)
-  (let [duration  (dt/duration delay)
-        interval  (db/interval duration)
-        props     (db/tjson props)
-        id        (uuid/next)]
-    (log/info (str/format "Submit task '%s' to be executed in '%s'." name (str duration)))
-    (db/exec-one! conn [sql:insert-new-task id name props queue priority max-retries interval])
-    id))

backend/src/uxbox/tasks/remove_media.clj

@@ -5,7 +5,7 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2020 UXBOX Labs SL
 
 (ns uxbox.tasks.remove-media
   "Demo accounts garbage collector."

backend/src/uxbox/tasks/trim_file.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/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns uxbox.tasks.trim-file
+  (:require
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [uxbox.common.exceptions :as ex]
+   [uxbox.common.spec :as us]
+   [uxbox.config :as cfg]
+   [uxbox.db :as db]
+   [uxbox.tasks :as tasks]
+   [uxbox.util.blob :as blob]
+   [uxbox.util.time :as dt]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Task: Trim File
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; This is the task responsible of removing unnecesary media-objects
+;; associated with file but not used by any page.
+
+(defn decode-row
+  [{:keys [data metadata changes] :as row}]
+  (cond-> row
+    (bytes? data) (assoc :data (blob/decode data))))
+
+(def sql:retrieve-files-to-trim
+  "select id from file as f
+    where f.has_media_trimmed is false
+      and f.modified_at < now() - ?::interval
+    order by f.modified_at asc
+    limit 10")
+
+(defn retrieve-candidates
+  [conn]
+  (let [interval (:file-trimming-max-age cfg/config)]
+    (->> (db/exec! conn [sql:retrieve-files-to-trim interval])
+         (map :id))))
+
+(defn collect-used-media
+  [pages]
+  (let [xf (comp (filter #(= :image (:type %)))
+                 (map :metadata)
+                 (map :id))]
+    (reduce conj #{} (->> pages
+                          (map :data)
+                          (map :objects)
+                          (mapcat vals)
+                          (filter #(= :image (:type %)))
+                          (map :metadata)
+                          (map :id)))))
+
+(defn process-file
+  [file-id]
+  (log/debugf "Processing file: '%s'." file-id)
+  (db/with-atomic [conn db/pool]
+    (let [mobjs  (db/query conn :media-object {:file-id file-id})
+          pages  (->> (db/query conn :page {:file-id file-id})
+                      (map decode-row))
+          used   (collect-used-media pages)
+          unused (into #{} (comp (map :id)
+                                 (remove #(contains? used %))) mobjs)]
+      (log/debugf "Collected media ids: '%s'." (pr-str used))
+      (log/debugf "Unused media ids: '%s'." (pr-str unused))
+
+      (db/update! conn :file
+                  {:has-media-trimmed true}
+                  {:id file-id})
+
+      (doseq [id unused]
+        (tasks/submit! conn {:name "delete-object"
+                             ;; :delay cfg/default-deletion-delay
+                             :delay 10000
+                             :props {:id id :type :media-object}})
+
+        (db/update! conn :media-object
+                    {:deleted-at (dt/now)}
+                    {:id id}))
+      nil)))
+
+(defn handler
+  [{:keys [props] :as task}]
+  (log/debug "Running 'trim-file' task.")
+  (loop []
+    (let [files (retrieve-candidates db/pool)]
+      (when (seq files)
+        (run! process-file files)
+        (recur)))))

backend/src/uxbox/util/async.clj

@@ -5,19 +5,24 @@
 ;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
 
 (ns uxbox.util.async
-  (:require [clojure.core.async :as a]))
+  (:require
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [clojure.core.async :as a])
+  (:import
+   java.util.concurrent.Executor))
 
 (defmacro go-try
   [& body]
   `(a/go
      (try
        ~@body
-       (catch Throwable e# e#))))
+       (catch Exception e# e#))))
 
 (defmacro <?
   [ch]
   `(let [r# (a/<! ~ch)]
-     (if (instance? Throwable r#)
+     (if (instance? Exception r#)
        (throw r#)
        r#)))
 
@@ -26,6 +31,26 @@
   `(a/thread
      (try
        ~@body
-       (catch Throwable e#
+       (catch Exception e#
          e#))))
 
+
+(s/def ::executor #(instance? Executor %))
+
+(defn thread-call
+  [^Executor executor f]
+  (let [c (a/chan 1)]
+    (try
+      (.execute executor
+                (fn []
+                  (try
+                    (let [ret (try (f) (catch Exception e e))]
+                      (when-not (nil? ret)
+                        (a/>!! c ret)))
+                    (finally
+                      (a/close! c)))))
+      c
+      (catch java.util.concurrent.RejectedExecutionException e
+        (a/offer! c e)
+        (a/close! c)
+        c))))

backend/src/uxbox/util/time.clj

@@ -71,8 +71,7 @@
 
 (defn parse-duration
   [s]
-  (assert (string? s))
+  (Duration/parse (str "PT" s)))
-  (Duration/parse s))
 
 (extend-protocol clojure.core/Inst
   java.time.Duration
@@ -85,6 +84,22 @@
 (defmethod print-dup Duration [o w]
   (print-method o w))
 
+(letfn [(conformer [v]
+          (cond
+            (duration? v) v
+            (string? v)
+            (try
+              (parse-duration v)
+              (catch java.time.format.DateTimeParseException e
+                ::s/invalid))
+
+            :else
+            ::s/invalid))
+        (unformer [v]
+          (subs (str v) 2))]
+  (s/def ::duration (s/conformer conformer unformer)))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Cron Expression
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/uxbox/worker.clj

@@ -0,0 +1,63 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns uxbox.worker
+  (:require
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [mount.core :as mount :refer [defstate]]
+   [uxbox.common.spec :as us]
+   [uxbox.config :as cfg]
+   [uxbox.db :as db]
+   [uxbox.metrics :as mtx]
+   [uxbox.tasks.delete-object]
+   [uxbox.tasks.delete-profile]
+   [uxbox.tasks.gc]
+   [uxbox.tasks.remove-media]
+   [uxbox.tasks.sendmail]
+   [uxbox.tasks.trim-file]
+   [uxbox.util.time :as dt]
+   [uxbox.worker-impl :as impl]))
+
+;; --- State initialization
+
+(def ^:private tasks
+  {"delete-profile" #'uxbox.tasks.delete-profile/handler
+   "delete-object" #'uxbox.tasks.delete-object/handler
+   "remove-media" #'uxbox.tasks.remove-media/handler
+   "sendmail" #'uxbox.tasks.sendmail/handler})
+
+(def ^:private schedule
+  [{:id "remove-deleted-media"
+    :cron (dt/cron "0 0 0 */1 * ? *") ;; daily
+    :fn #'uxbox.tasks.gc/remove-deleted-media}
+   {:id "trim-file"
+    :cron (dt/cron "0 0 0 */1 * ? *") ;; daily
+    :fn #'uxbox.tasks.trim-file/handler}
+   ])
+
+
+(defstate executor
+  :start (impl/thread-pool {:idle-timeout 10000
+                            :min-threads 0
+                            :max-threads 256})
+  :stop (impl/stop! executor))
+
+(defstate worker
+  :start (impl/start-worker!
+          {:tasks tasks
+           :name "worker1"
+           :batch-size 1
+           :executor executor})
+  :stop (impl/stop! worker))
+
+(defstate scheduler-worker
+  :start (impl/start-scheduler-worker! {:schedule schedule
+                                        :executor executor})
+  :stop (impl/stop! scheduler-worker))

backend/src/uxbox/worker_impl.clj

@@ -0,0 +1,357 @@
+;; 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/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns uxbox.worker-impl
+  (:require
+   [cuerdas.core :as str]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [promesa.exec :as px]
+   [uxbox.common.exceptions :as ex]
+   [uxbox.common.spec :as us]
+   [uxbox.common.uuid :as uuid]
+   [uxbox.config :as cfg]
+   [uxbox.db :as db]
+   [uxbox.util.async :as aa]
+   [uxbox.util.blob :as blob]
+   [uxbox.util.time :as dt])
+  (:import
+   org.eclipse.jetty.util.thread.QueuedThreadPool
+   java.util.concurrent.ExecutorService
+   java.util.concurrent.Executors
+   java.util.concurrent.Executor
+   java.time.Duration
+   java.time.Instant
+   java.util.Date))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tasks
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private
+  sql:mark-as-retry
+  "update task
+      set scheduled_at = clock_timestamp() + '10 seconds'::interval,
+          modified_at = clock_timestamp(),
+          error = ?,
+          status = 'retry',
+          retry_num = retry_num + ?
+    where id = ?")
+
+(defn- mark-as-retry
+  [conn {:keys [task error inc-by]
+         :or {inc-by 1}}]
+  (let [explain (ex-message error)
+        sqlv [sql:mark-as-retry explain inc-by (:id task)]]
+    (db/exec-one! conn sqlv)
+    nil))
+
+(defn- mark-as-failed
+  [conn {:keys [task error]}]
+  (let [explain (ex-message error)]
+    (db/update! conn :task
+                {:error explain
+                 :modified-at (dt/now)
+                 :status "failed"}
+                {:id (:id task)})
+    nil))
+
+(defn- mark-as-completed
+  [conn {:keys [task] :as opts}]
+  (let [now (dt/now)]
+    (db/update! conn :task
+                {:completed-at now
+                 :modified-at now
+                 :status "completed"}
+                {:id (:id task)})
+    nil))
+
+(defn- decode-task-row
+  [{:keys [props] :as row}]
+  (when row
+    (cond-> row
+      (db/pgobject? props) (assoc :props (db/decode-transit-pgobject props)))))
+
+
+(defn- log-task-error
+  [item err]
+  (log/error (str/format "Unhandled exception on task '%s' (retry: %s)\n" (:name item) (:retry-num item))
+             (str/format "Props: %s\n" (pr-str (:props item)))
+             (with-out-str
+               (.printStackTrace ^Throwable err (java.io.PrintWriter. *out*)))))
+
+(defn- handle-task
+  [tasks {:keys [name] :as item}]
+  (let [task-fn (get tasks name)]
+    (if task-fn
+      (task-fn item)
+      (do
+        (log/warn "no task handler found for" (pr-str name))
+        nil))))
+
+(defn- run-task
+  [{:keys [tasks conn]} item]
+  (try
+    (log/debugf "Started task '%s/%s/%s'." (:name item) (:id item) (:retry-num item))
+    (handle-task tasks item)
+    {:status :completed :task item}
+    (catch Exception e
+      (let [data (ex-data e)]
+        (cond
+          (and (= ::retry (:type data))
+               (= ::noop (:strategy data)))
+          {:status :retry :task item :error e :inc-by 0}
+
+          (and (< (:retry-num item)
+                  (:max-retries item))
+               (= ::retry (:type data)))
+          {:status :retry :task item :error e}
+
+          :else
+          (do
+            (log/errorf e "Unhandled exception on task '%s' (retry: %s)\nProps: %s"
+                        (:name item) (:retry-num item) (pr-str (:props item)))
+            (if (>= (:retry-num item) (:max-retries item))
+              {:status :failed :task item :error e}
+              {:status :retry :task item :error e})))))
+    (finally
+      (log/debugf "Finished task '%s/%s/%s'." (:name item) (:id item) (:retry-num item)))))
+
+(def ^:private
+  sql:select-next-tasks
+  "select * from task as t
+    where t.scheduled_at <= now()
+      and t.queue = ?
+      and (t.status = 'new' or t.status = 'retry')
+    order by t.priority desc, t.scheduled_at
+    limit ?
+      for update skip locked")
+
+(defn- event-loop-fn*
+  [{:keys [tasks executor batch-size] :as opts}]
+  (db/with-atomic [conn db/pool]
+    (let [queue (:queue opts "default")
+          items (->> (db/exec! conn [sql:select-next-tasks queue batch-size])
+                     (map decode-task-row)
+                     (seq))
+          opts  (assoc opts :conn conn)]
+
+      (if (nil? items)
+        ::empty
+        (let [results (->> items
+                           (map #(partial run-task opts %))
+                           (map #(px/submit! executor %)))]
+          (doseq [res results]
+            (let [res (deref res)]
+              (case (:status res)
+                :retry (mark-as-retry conn res)
+                :failed (mark-as-failed conn res)
+                :completed (mark-as-completed conn res))))
+          ::handled)))))
+
+(defn- event-loop-fn
+  [{:keys [executor] :as opts}]
+  (aa/thread-call executor #(event-loop-fn* opts)))
+
+(s/def ::batch-size ::us/integer)
+(s/def ::poll-interval ::us/integer)
+(s/def ::fn (s/or :var var? :fn fn?))
+(s/def ::tasks (s/map-of string? ::fn))
+
+(s/def ::start-worker-params
+  (s/keys :req-un [::tasks ::aa/executor ::batch-size]
+          :opt-un [::poll-interval]))
+
+(defn start-worker!
+  [{:keys [poll-interval executor]
+    :or {poll-interval 5000}
+    :as opts}]
+  (us/assert ::start-worker-params opts)
+  (log/infof "Starting worker '%s' on queue '%s'."
+             (:name opts "anonymous")
+             (:queue opts "default"))
+  (let [cch (a/chan 1)]
+    (a/go-loop []
+      (let [[val port] (a/alts! [cch (event-loop-fn opts)] :priority true)]
+        (cond
+          ;; Terminate the loop if close channel is closed or
+          ;; event-loop-fn returns nil.
+          (or (= port cch) (nil? val))
+          (log/infof "Stop condition found. Shutdown worker: '%s'"
+                     (:name opts "anonymous"))
+
+          (db/pool-closed? db/pool)
+          (do
+            (log/info "Worker eventloop is aborted because pool is closed.")
+            (a/close! cch))
+
+          (and (instance? java.sql.SQLException val)
+               (contains? #{"08003" "08006" "08001" "08004"} (.getSQLState val)))
+          (do
+            (log/error "Connection error, trying resume in some instants.")
+            (a/<! (a/timeout poll-interval))
+            (recur))
+
+          (and (instance? java.sql.SQLException val)
+               (= "40001" (.getSQLState ^java.sql.SQLException val)))
+          (do
+            (log/debug "Serialization failure (retrying in some instants).")
+            (a/<! (a/timeout 1000))
+            (recur))
+
+          (instance? Exception val)
+          (do
+            (log/errorf val "Unexpected error ocurried on polling the database (will resume operations in some instants). ")
+            (a/<! (a/timeout poll-interval))
+            (recur))
+
+          (= ::handled val)
+          (recur)
+
+          (= ::empty val)
+          (do
+            (a/<! (a/timeout poll-interval))
+            (recur)))))
+
+    (reify
+      java.lang.AutoCloseable
+      (close [_]
+        (a/close! cch)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Scheduled Tasks
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private
+  sql:upsert-scheduled-task
+  "insert into scheduled_task (id, cron_expr)
+   values (?, ?)
+       on conflict (id)
+       do update set cron_expr=?")
+
+(defn- synchronize-schedule-item
+  [conn {:keys [id cron] :as item}]
+  (let [cron (str cron)]
+    (log/debug (str/format "Initialize scheduled task '%s' (cron: '%s')." id cron))
+    (db/exec-one! conn [sql:upsert-scheduled-task id cron cron])))
+
+(defn- synchronize-schedule!
+  [schedule]
+  (db/with-atomic [conn db/pool]
+    (run! (partial synchronize-schedule-item conn) schedule)))
+
+(def ^:private sql:lock-scheduled-task
+  "select id from scheduled_task where id=? for update skip locked")
+
+(declare schedule-task!)
+
+(defn exception->string
+  [error]
+  (with-out-str
+    (.printStackTrace ^Throwable error (java.io.PrintWriter. *out*))))
+
+(defn- execute-scheduled-task
+  [{:keys [scheduler executor] :as opts} {:keys [id cron] :as task}]
+  (letfn [(run-task [conn]
+            (try
+              (when (db/exec-one! conn [sql:lock-scheduled-task id])
+                (log/info "Executing scheduled task" id)
+                ((:fn task) task))
+              (catch Exception e
+                e)))
+
+          (handle-task* [conn]
+            (let [result (run-task conn)]
+              (if (instance? Throwable result)
+                (do
+                  (log/warnf result "Unhandled exception on scheduled task '%s'." id)
+                  (db/insert! conn :scheduled-task-history
+                              {:id (uuid/next)
+                               :task-id id
+                               :is-error true
+                               :reason (exception->string result)}))
+                (db/insert! conn :scheduled-task-history
+                            {:id (uuid/next)
+                             :task-id id}))))
+          (handle-task []
+            (db/with-atomic [conn db/pool]
+              (handle-task* conn)))]
+
+    (try
+      (px/run! executor handle-task)
+      (finally
+        (schedule-task! opts task)))))
+
+(defn ms-until-valid
+  [cron]
+  (s/assert dt/cron? cron)
+  (let [^Instant now  (dt/now)
+        ^Instant next (dt/next-valid-instant-from cron now)]
+    (inst-ms (dt/duration-between now next))))
+
+(defn- schedule-task!
+  [{:keys [scheduler] :as opts} {:keys [cron] :as task}]
+  (let [ms (ms-until-valid cron)]
+    (px/schedule! scheduler ms (partial execute-scheduled-task opts task))))
+
+(s/def ::fn (s/or :var var? :fn fn?))
+(s/def ::id string?)
+(s/def ::cron dt/cron?)
+(s/def ::props (s/nilable map?))
+(s/def ::scheduled-task
+  (s/keys :req-un [::id ::cron ::fn]
+          :opt-un [::props]))
+
+(s/def ::schedule (s/coll-of ::scheduled-task))
+(s/def ::start-scheduler-worker-params
+  (s/keys :req-un [::schedule]))
+
+(defn start-scheduler-worker!
+  [{:keys [schedule] :as opts}]
+  (us/assert ::start-scheduler-worker-params opts)
+  (let [scheduler (Executors/newScheduledThreadPool (int 1))
+        opts      (assoc opts :scheduler scheduler)]
+    (synchronize-schedule! schedule)
+    (run! (partial schedule-task! opts) schedule)
+    (reify
+      java.lang.AutoCloseable
+      (close [_]
+        (.shutdownNow ^ExecutorService scheduler)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Thread Pool
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn thread-pool
+  ([] (thread-pool {}))
+  ([{:keys [min-threads max-threads idle-timeout name]
+     :or {min-threads 0 max-threads 128 idle-timeout 60000}}]
+   (let [executor (QueuedThreadPool. max-threads min-threads)]
+     (.setName executor (or name "default-tp"))
+     (.start executor)
+     executor)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn stop!
+  [o]
+  (cond
+    (instance? java.lang.AutoCloseable o)
+    (.close ^java.lang.AutoCloseable o)
+
+    (instance? org.eclipse.jetty.util.component.ContainerLifeCycle o)
+    (.stop ^org.eclipse.jetty.util.component.ContainerLifeCycle o)
+
+    :else
+    (ex/raise :type :not-implemented)))
+
+

backend/tests/uxbox/tests/test_services_profile.clj

@@ -104,7 +104,7 @@
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
-    ))
+    ))))
 
 
 #_(t/deftest profile-deletion

docker/devenv/files/start-tmux.sh

@@ -29,7 +29,7 @@ tmux send-keys -t uxbox './scripts/wait-and-start.sh' enter
 tmux new-window -t uxbox:3 -n 'backend'
 tmux select-window -t uxbox:3
 tmux send-keys -t uxbox 'cd uxbox/backend' enter C-l
-tmux send-keys -t uxbox './bin/start-dev' enter
+tmux send-keys -t uxbox './scripts/start-dev' enter
 
 tmux rename-window -t uxbox:0 'gulp'
 tmux select-window -t uxbox:0

frontend/src/uxbox/config.cljs

@@ -23,4 +23,9 @@
     (def login-with-ldap lwl)
     (def worker-uri wuri)
     (def public-uri puri)
+    (def media-uri (str puri "/media"))
     (def default-theme "default")))
+
+(defn resolve-media-path
+  [path]
+  (str media-uri "/" path))

frontend/src/uxbox/main/data/workspace.cljs

@@ -534,7 +534,8 @@
             shape (-> (cp/make-minimal-shape type)
                       (merge data)
                       (geom/resize width height)
-                      (geom/absolute-move (gpt/point x y)))]
+                      (geom/absolute-move (gpt/point x y))
+                      (geom/transform-shape))]
 
         (rx/of (add-shape shape))))))
 
@@ -1177,8 +1178,13 @@
   (ptk/reify ::paste-bin-impl
     ptk/WatchEvent
     (watch [_ state stream]
-      (let [file-id (get-in state [:workspace-page :file-id])]
+      (let [file-id (get-in state [:workspace-page :file-id])
-        (rx/of (dwp/upload-media-objects file-id true [image] image-uploaded))))))
+            params  {:file-id file-id
+                     :local? true
+                     :js-files [image]}]
+        (rx/of (dwp/upload-media-objects
+                (with-meta params
+                  {:on-success image-uploaded})))))))
 
 (def paste
   (ptk/reify ::paste
@@ -1436,7 +1442,6 @@
 (def fetch-shared-files dwp/fetch-shared-files)
 (def link-file-to-library dwp/link-file-to-library)
 (def unlink-file-from-library dwp/unlink-file-from-library)
-(def add-media-object-from-url dwp/add-media-object-from-url)
 (def upload-media-objects dwp/upload-media-objects)
 (def delete-media-object dwp/delete-media-object)
 (def rename-page dwp/rename-page)

frontend/src/uxbox/main/data/workspace/persistence.cljs

@@ -434,92 +434,83 @@
 
 ;; --- Upload local media objects
 
-(declare upload-media-objects-result)
+(s/def ::local? ::us/boolean)
+(s/def ::uri ::us/string)
 
-(defn add-media-object-from-url
+(s/def ::upload-media-objects-params
-  ([file-id is-local url] (add-media-object-from-url file-id is-local url identity))
+  (s/keys :req-un [::file-id ::local?]
-  ([file-id is-local url on-added]
+          :opt-un [::uri ::di/js-files]))
-   (us/verify ::us/url url)
-   (us/verify fn? on-added)
-   (us/verify ::us/boolean is-local)
-   (ptk/reify ::add-media-object-from-url
-     ptk/WatchEvent
-     (watch [_ state stream]
-       (let [on-success #(do (di/notify-finished-loading)
-                             (on-added %))
-
-             on-error #(do (di/notify-finished-loading)
-                           (di/process-error %))
-
-             is-library (not= file-id (:id (:workspace-file state)))
- 
-             prepare
-             (fn [url]
-               {:file-id file-id
-                :is-local is-local
-                :url url})]
-
-         (di/notify-start-loading)
-
-         (->> (rx/of url)
-              (rx/map prepare)
-              (rx/mapcat #(rp/mutation! :add-media-object-from-url %))
-              (rx/do on-success)
-              (rx/map (partial upload-media-objects-result file-id is-local is-library))
-              (rx/catch on-error)))))))
 
 (defn upload-media-objects
-  ([file-id is-local js-files] (upload-media-objects file-id is-local js-files identity))
+  [{:keys [file-id local? js-files uri] :as params}]
-  ([file-id is-local js-files on-uploaded]
+  (us/assert ::upload-media-objects-params params)
-   (us/verify ::us/uuid file-id)
-   (us/verify ::us/boolean is-local)
-   (us/verify ::di/js-files js-files)
-   (us/verify fn? on-uploaded)
    (ptk/reify ::upload-media-objects
      ptk/WatchEvent
      (watch [_ state stream]
-       (let [on-success #(do (di/notify-finished-loading)
+       (let [{:keys [on-success on-error]
-                             (on-uploaded %))
+              :or {on-success identity}} (meta params)
-
-             on-error #(do (di/notify-finished-loading)
-                           (di/process-error %))
 
              is-library (not= file-id (:id (:workspace-file state)))
-
+             prepare-js-file
-             prepare
              (fn [js-file]
                {:name (.-name js-file)
                 :file-id file-id
                 :content js-file
-                :is-local is-local})]
+                :is-local local?})
 
-         (di/notify-start-loading)
+             prepare-uri
+             (fn [uri]
+               {:file-id file-id
+                :is-local local?
+                :url uri})
 
-         (->> (rx/from js-files)
+             assoc-to-library
-              (rx/map di/validate-file)
+             (fn [media-object state]
-              (rx/map prepare)
+               (cond
-              (rx/mapcat #(rp/mutation! :upload-media-object %))
+                 (true? local?)
-              (rx/do on-success)
+                 state
-              (rx/map (partial upload-media-objects-result file-id is-local is-library))
-              (rx/catch on-error)))))))
 
-(defn upload-media-objects-result
+                 (true? is-library)
-  [file-id is-local is-library media-object]
+                 (update-in state
-  (us/verify ::us/uuid file-id)
+                            [:workspace-libraries file-id :media-objects]
-  (us/verify ::us/boolean is-local)
+                            #(conj % media-object))
-  (us/verify ::cm/media-object media-object)
+
-  (ptk/reify ::upload-media-objects-result
+                 :else
-    ptk/UpdateEvent
+                 (update-in state
-    (update [_ state]
+                            [:workspace-file :media-objects]
-      (if is-local ;; the media-object is local to the file, not for its library
+                            #(conj % media-object))))]
-        state
+
-        (if is-library ;; the file is not the currently editing one, but a linked shared file
+         (rx/concat
-          (update-in state
+          (rx/of (dm/show {:content (tr "media.loading")
-                     [:workspace-libraries file-id :media-objects]
+                           :type :info
-                     #(conj % media-object))
+                           :timeout nil}))
-          (update-in state
+          (->> (if (string? uri)
-                     [:workspace-file :media-objects]
+                 (->> (rx/of uri)
-                     #(conj % media-object)))))))
+                      (rx/map prepare-uri)
+                      (rx/mapcat #(rp/mutation! :add-media-object-from-url %)))
+                 (->> (rx/from js-files)
+                      (rx/map di/validate-file)
+                      (rx/map prepare-js-file)
+                      (rx/mapcat #(rp/mutation! :upload-media-object %))))
+               (rx/do on-success)
+               (rx/map (fn [mobj] (partial assoc-to-library mobj)))
+               (rx/catch (fn [error]
+                           (cond
+                             (= (:code error) :media-type-not-allowed)
+                             (rx/of (dm/error (tr "errors.media-type-not-allowed")))
+
+                             (= (:code error) :media-type-mismatch)
+                             (rx/of (dm/error (tr "errors.media-type-mismatch")))
+
+                             (fn? on-error)
+                             (do
+                               (on-error error)
+                               (rx/empty))
+
+                             :else
+                             (rx/throw error))))
+               (rx/finalize (fn []
+                              (st/emit! dm/hide)))))))))
 
 
 ;; --- Delete media object

frontend/src/uxbox/main/ui/shapes/image.cljs

@@ -10,6 +10,7 @@
 (ns uxbox.main.ui.shapes.image
   (:require
    [rumext.alpha :as mf]
+   [uxbox.config :as cfg]
    [uxbox.common.geom.shapes :as geom]
    [uxbox.main.ui.shapes.attrs :as attrs]
    [uxbox.util.object :as obj]))
@@ -20,8 +21,7 @@
   (let [shape (unchecked-get props "shape")
         {:keys [id x y width height rotation metadata]} shape
         transform (geom/transform-matrix shape)
-        uri (:uri metadata)
+        uri       (cfg/resolve-media-path (:path metadata))
-
         props (-> (attrs/extract-style-attrs shape)
                   (obj/merge!
                    #js {:x x

frontend/src/uxbox/main/ui/workspace/left_toolbar.cljs

@@ -36,15 +36,20 @@
         on-uploaded
         (fn [{:keys [id name] :as image}]
           (let [shape {:name name
-                       :metadata {:width (:width image)
+                       :metadata {:width  (:width image)
                                   :height (:height image)
-                                  :uri (:uri image)}}
+                                  :id     (:id image)
+                                  :path   (:path image)}}
                 aspect-ratio (/ (:width image) (:height image))]
             (st/emit! (dw/create-and-add-shape :image shape aspect-ratio))))
 
         on-files-selected
         (fn [js-files]
-          (st/emit! (dw/upload-media-objects (:id file) true js-files on-uploaded)))]
+          (st/emit! (dw/upload-media-objects
+                     (with-meta {:file-id (:id file)
+                                 :local? true
+                                 :js-files js-files}
+                       {:on-success on-uploaded}))))]
 
     [:aside.left-toolbar
      [:div.left-toolbar-inside

frontend/src/uxbox/main/ui/workspace/sidebar/assets.cljs

@@ -12,6 +12,7 @@
    [okulary.core :as l]
    [cuerdas.core :as str]
    [rumext.alpha :as mf]
+   [uxbox.config :as cfg]
    [uxbox.common.data :as d]
    [uxbox.common.media :as cm]
    [uxbox.common.pages :as cp]
@@ -82,7 +83,10 @@
 
         on-files-selected
         (fn [js-files]
-          (st/emit! (dw/upload-media-objects file-id false js-files)))
+          (let [params {:file-id file-id
+                        :local? false
+                        :js-files js-files}]
+            (st/emit! (dw/upload-media-objects params))))
 
         on-context-menu
         (fn [object-id]
@@ -98,10 +102,9 @@
                        :object-id object-id)))))
 
         on-drag-start
-        (fn [uri]
+        (fn [path event]
-          (fn [event]
+          (dnd/set-data! event "text/uri-list" (cfg/resolve-media-path path))
-            (dnd/set-data! event "text/uri-list" uri)
+          (dnd/set-allowed-effect! event "move"))]
-            (dnd/set-allowed-effect! event "move")))]
 
     [:div.asset-group
      [:div.group-title
@@ -115,22 +118,23 @@
                             :input-ref file-input
                             :on-selected on-files-selected}]])]
      [:div.group-grid
-       (for [object media-objects]
+      (for [object media-objects]
-         [:div.grid-cell {:key (:id object)
+        [:div.grid-cell {:key (:id object)
-                          :draggable true
+                         :draggable true
-                          :on-context-menu (on-context-menu (:id object))
+                         :on-context-menu (on-context-menu (:id object))
-                          :on-drag-start (on-drag-start (:uri object))}
+                         :on-drag-start (partial on-drag-start (:path object))}
-          [:img {:src (:thumb-uri object)
+         [:img {:src (cfg/resolve-media-path (:thumb-path object))
-                 :draggable false}] ;; Also need to add css pointer-events: none
+                :draggable false}] ;; Also need to add css pointer-events: none
-          [:div.cell-name (:name object)]])
+         [:div.cell-name (:name object)]])
-       (when local-library?
+
-         [:& context-menu
+      (when local-library?
-          {:selectable false
+        [:& context-menu
-           :show (:menu-open @state)
+         {:selectable false
-           :on-close #(swap! state assoc :menu-open false)
+          :show (:menu-open @state)
-           :top (:top @state)
+          :on-close #(swap! state assoc :menu-open false)
-           :left (:left @state)
+          :top (:top @state)
-           :options [[(tr "workspace.assets.delete") delete-graphic]]}])]]))
+          :left (:left @state)
+          :options [[(tr "workspace.assets.delete") delete-graphic]]}])]]))
 
 
 (mf/defc color-item
@@ -287,7 +291,7 @@
            [:a {:href (str "#" library-url) :target "_blank"} i/chain]]])]
      (when @open?
        (let [show-graphics (and (or (= box-filter :all) (= box-filter :graphics))
-                                (or (> (count media-objects) 0) (str/empty? search-term))) 
+                                (or (> (count media-objects) 0) (str/empty? search-term)))
              show-colors (and (or (= box-filter :all) (= box-filter :colors))
                               (or (> (count colors) 0) (str/empty? search-term)))]
          [:div.tool-window-content

frontend/src/uxbox/main/ui/workspace/viewport.cljs

@@ -349,12 +349,15 @@
                     (dnd/has-type? e "text/uri-list"))
             (dom/prevent-default e)))
 
+        ;; TODO: seems duplicated callback is the same as one located
+        ;; in left_toolbar
         on-uploaded
         (fn [{:keys [id name] :as image}]
           (let [shape {:name name
                        :metadata {:width (:width image)
                                   :height (:height image)
-                                  :uri (:uri image)}}
+                                  :id (:id image)
+                                  :path (:path image)}}
                 aspect-ratio (/ (:width image) (:height image))]
             (st/emit! (dw/create-and-add-shape :image shape aspect-ratio))))
 
@@ -379,11 +382,23 @@
                   urls (filter #(and (not (str/blank? %))
                                      (not (str/starts-with? % "#")))
                                lines)]
-              (run! #(st/emit! (dw/add-media-object-from-url (:id file) true % on-uploaded)) urls))
+              (->> urls
+                   (map (fn [uri]
+                          (with-meta {:file-id (:id file)
+                                      :local? true
+                                      :uri uri}
+                            {:on-success on-uploaded})))
+                   (map dw/upload-media-objects)
+                   (apply st/emit!)))
 
             :else
-            (let [js-files (dnd/get-files event)]
+            (let [js-files (dnd/get-files event)
-              (st/emit! (dw/upload-media-objects (:id file) true js-files on-uploaded)))))
+                  params   {:file-id (:id file)
+                            :local? true
+                            :js-files js-files}]
+              (st/emit! (dw/upload-media-objects
+                         (with-meta params
+                           {:on-success on-uploaded}))))))
 
         on-resize
         (fn [event]