diff --git a/backend/deps.edn b/backend/deps.edn
index 782997986..8ef8f19cf 100644
--- a/backend/deps.edn
+++ b/backend/deps.edn
@@ -57,13 +57,14 @@
:exclusions [commons-codec/commons-codec]}
puppetlabs/clj-ldap {:mvn/version"0.3.0"}
+ integrant/integrant {:mvn/version "0.8.0"}
;; exception printing
io.aviso/pretty {:mvn/version "0.1.37"}
mount/mount {:mvn/version "0.1.16"}
environ/environ {:mvn/version "1.2.0"}}
- :paths ["src" "resources" "../common" "common"]
+ :paths ["dev" "src" "resources" "../common" "common"]
:aliases
{:dev
{:extra-deps
@@ -89,7 +90,7 @@
{:main-opts ["-m" "clj-kondo.main"]}
:tests
- {:extra-deps {lambdaisland/kaocha {:mvn/version "0.0-581"}}
+ {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.732"}}
:main-opts ["-m" "kaocha.runner"]}
:outdated
diff --git a/backend/tests/user.clj b/backend/dev/user.clj
similarity index 66%
rename from backend/tests/user.clj
rename to backend/dev/user.clj
index 52e12e56b..f59c4bf9a 100644
--- a/backend/tests/user.clj
+++ b/backend/dev/user.clj
@@ -9,23 +9,26 @@
(ns user
(:require
+ [app.config :as cfg]
+ [app.main :as main]
+ [app.util.time :as dt]
+ [app.util.transit :as t]
+ [app.common.exceptions :as ex]
+ [clojure.data.json :as json]
+ [clojure.java.io :as io]
+ [clojure.test :as test]
+ [clojure.pprint :refer [pprint]]
+ [clojure.repl :refer :all]
[clojure.spec.alpha :as s]
+ [clojure.test :as test]
[clojure.tools.namespace.repl :as repl]
[clojure.walk :refer [macroexpand-all]]
- [clojure.pprint :refer [pprint]]
- [clojure.test :as test]
- [clojure.java.io :as io]
- [app.common.pages :as cp]
- [clojure.repl :refer :all]
[criterium.core :refer [quick-bench bench with-progress-reporting]]
- [clj-kondo.core :as kondo]
- [app.migrations]
- [app.db :as db]
- [app.metrics :as mtx]
- [app.util.storage :as st]
- [app.util.time :as tm]
- [app.util.blob :as blob]
- [mount.core :as mount]))
+ [integrant.core :as ig]))
+
+(repl/disable-reload! (find-ns 'integrant.core))
+
+(defonce system nil)
;; --- Benchmarking Tools
@@ -47,20 +50,6 @@
;; --- Development Stuff
-(defn- start
- []
- (-> #_(mount/except #{#'app.scheduled-jobs/scheduler})
- (mount/start)))
-
-(defn- stop
- []
- (mount/stop))
-
-(defn restart
- []
- (stop)
- (repl/refresh :after 'user/start))
-
(defn- run-tests
([] (run-tests #"^app.tests.*"))
([o]
@@ -75,16 +64,28 @@
(test/test-vars [(resolve o)]))
(test/test-ns o)))))
-(defn lint
- ([] (lint ""))
- ([path]
- (-> (kondo/run!
- {:lint [(str "src/" path)]
- :cache false
- :config {:linters
- {:unresolved-symbol
- {:exclude ['(app.services.mutations/defmutation)
- '(app.services.queries/defquery)
- '(app.db/with-atomic)
- '(promesa.core/let)]}}}})
- (kondo/print!))))
+(defn- start
+ []
+ (alter-var-root #'system (fn [sys]
+ (when sys (ig/halt! sys))
+ (-> (main/build-system-config @cfg/config)
+ (ig/prep)
+ (ig/init))))
+ :started)
+
+(defn- stop
+ []
+ (alter-var-root #'system (fn [sys]
+ (when sys (ig/halt! sys))
+ nil))
+ :stoped)
+
+(defn restart
+ []
+ (stop)
+ (repl/refresh :after 'user/start))
+
+(defn restart-all
+ []
+ (stop)
+ (repl/refresh-all :after 'user/start))
diff --git a/backend/resources/log4j2.xml b/backend/resources/log4j2.xml
index 26a71e7bc..8bf5c10ed 100644
--- a/backend/resources/log4j2.xml
+++ b/backend/resources/log4j2.xml
@@ -13,7 +13,7 @@
-
+
diff --git a/backend/src/app/cli/fixtures.clj b/backend/src/app/cli/fixtures.clj
index d60c61b44..c011f6c3f 100644
--- a/backend/src/app/cli/fixtures.clj
+++ b/backend/src/app/cli/fixtures.clj
@@ -14,12 +14,12 @@
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
- [app.migrations]
- [app.services.mutations.profile :as profile]
+ [app.main :as main]
+ [app.rpc.mutations.profile :as profile]
[app.util.blob :as blob]
[buddy.hashers :as hashers]
[clojure.tools.logging :as log]
- [mount.core :as mount]))
+ [integrant.core :as ig]))
(defn- mk-uuid
[prefix & args]
@@ -71,7 +71,7 @@
(#'profile/create-profile-relations conn)))
(defn impl-run
- [opts]
+ [pool opts]
(let [rng (java.util.Random. 1)]
(letfn [(create-profile [conn index]
(let [id (mk-uuid "profile" index)
@@ -206,33 +206,36 @@
(run! (partial create-draft-file conn profile)
(range (:num-draft-files-per-profile opts))))
]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(let [profiles (create-profiles conn)
teams (create-teams conn)]
(assign-teams-and-profiles conn teams (map :id profiles))
(run! (partial create-draft-files conn) profiles))))))
-(defn run*
- [preset]
- (let [preset (if (map? preset)
+(defn run-in-system
+ [system preset]
+ (let [pool (:app.db/pool system)
+ preset (if (map? preset)
preset
(case preset
(nil "small" :small) preset-small
;; "medium" preset-medium
;; "big" preset-big
preset-small))]
- (impl-run preset)))
+ (impl-run pool preset)))
(defn run
- [{:keys [preset]
- :or {preset :small}}]
- (try
- (-> (mount/only #{#'app.config/config
- #'app.db/pool
- #'app.migrations/migrations})
- (mount/start))
- (run* preset)
- (catch Exception e
- (log/errorf e "Unhandled exception."))
- (finally
- (mount/stop))))
+ [{:keys [preset] :or {preset :small}}]
+ (let [config (select-keys (main/build-system-config cfg/config)
+ [:app.db/pool
+ :app.migrations/migrations
+ :app.metrics/metrics])
+ _ (ig/load-namespaces config)
+ system (-> (ig/prep config)
+ (ig/init))]
+ (try
+ (run-in-system system preset)
+ (catch Exception e
+ (log/errorf e "Unhandled exception."))
+ (finally
+ (ig/halt! system)))))
diff --git a/backend/src/app/cli/media_loader.clj b/backend/src/app/cli/media_loader.clj
deleted file mode 100644
index 946fd8880..000000000
--- a/backend/src/app/cli/media_loader.clj
+++ /dev/null
@@ -1,232 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.cli.media-loader
- "Media libraries importer (command line helper)."
- #_(:require
- [app.common.spec :as us]
- [app.common.uuid :as uuid]
- [app.config]
- [app.db :as db]
- [app.media-storage]
- [app.media]
- [app.migrations]
- [app.services.mutations.files :as files]
- [app.services.mutations.media :as media]
- [app.services.mutations.projects :as projects]
- [clojure.java.io :as io]
- [clojure.spec.alpha :as s]
- [clojure.tools.logging :as log]
- [datoteka.core :as fs]
- [mount.core :as mount])
- #_(:import
- java.io.PushbackReader))
-
-;; --- Constants & Helpers
-
-;; (def ^:const +graphics-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6a")
-;; (def ^:const +colors-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6c")
-
-;; (s/def ::id ::us/uuid)
-;; (s/def ::name ::us/string)
-;; (s/def ::path ::us/string)
-;; (s/def ::regex #(instance? java.util.regex.Pattern %))
-
-;; (s/def ::import-graphics
-;; (s/keys :req-un [::path ::regex]))
-
-;; (s/def ::import-color
-;; (s/* (s/cat :name ::us/string :color ::us/color)))
-
-;; (s/def ::import-colors (s/coll-of ::import-color))
-
-;; (s/def ::import-library
-;; (s/keys :req-un [::name]
-;; :opt-un [::import-graphics ::import-colors]))
-
-;; (defn exit!
-;; ([] (exit! 0))
-;; ([code]
-;; (System/exit code)))
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Graphics Importer
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defn- create-media-object
-;; [conn file-id media-object-id localpath]
-;; (s/assert fs/path? localpath)
-;; (s/assert ::us/uuid file-id)
-;; (s/assert ::us/uuid media-object-id)
-;; (let [filename (fs/name localpath)
-;; extension (second (fs/split-ext filename))
-;; file (io/as-file localpath)
-;; mtype (case extension
-;; ".jpg" "image/jpeg"
-;; ".png" "image/png"
-;; ".webp" "image/webp"
-;; ".svg" "image/svg+xml")]
-;; (log/info "Creating image" filename media-object-id)
-;; (media/create-media-object conn {:content {:tempfile localpath
-;; :filename filename
-;; :content-type mtype
-;; :size (.length file)}
-;; :id media-object-id
-;; :file-id file-id
-;; :name filename
-;; :is-local false})))
-
-;; (defn- media-object-exists?
-;; [conn id]
-;; (s/assert ::us/uuid id)
-;; (let [row (db/get-by-id conn :media-object id)]
-;; (if row true false)))
-
-;; (defn- import-media-object-if-not-exists
-;; [conn file-id fpath]
-;; (s/assert ::us/uuid file-id)
-;; (s/assert fs/path? fpath)
-;; (let [media-object-id (uuid/namespaced +graphics-uuid-ns+ (str file-id (fs/name fpath)))]
-;; (when-not (media-object-exists? conn media-object-id)
-;; (create-media-object conn file-id media-object-id fpath))
-;; media-object-id))
-
-;; (defn- import-graphics
-;; [conn file-id {:keys [path regex]}]
-;; (run! (fn [fpath]
-;; (when (re-matches regex (str fpath))
-;; (import-media-object-if-not-exists conn file-id fpath)))
-;; (->> (fs/list-dir path)
-;; (filter fs/regular-file?))))
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Colors Importer
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defn- create-color
-;; [conn file-id name content]
-;; (s/assert ::us/uuid file-id)
-;; (s/assert ::us/color content)
-;; (let [color-id (uuid/namespaced +colors-uuid-ns+ (str file-id content))]
-;; (log/info "Creating color" color-id "-" name content)
-;; (colors/create-color conn {:id color-id
-;; :file-id file-id
-;; :name name
-;; :content content})
-;; color-id))
-
-;; (defn- import-colors
-;; [conn file-id colors]
-;; (db/delete! conn :color {:file-id file-id})
-;; (run! (fn [[name content]]
-;; (create-color conn file-id name content))
-;; (partition-all 2 colors)))
-
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Library files Importer
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defn- library-file-exists?
-;; [conn id]
-;; (s/assert ::us/uuid id)
-;; (let [row (db/get-by-id conn :file id)]
-;; (if row true false)))
-
-;; (defn- create-library-file-if-not-exists
-;; [conn project-id {:keys [name]}]
-;; (let [id (uuid/namespaced +colors-uuid-ns+ name)]
-;; (when-not (library-file-exists? conn id)
-;; (log/info "Creating library-file:" name)
-;; (files/create-file conn {:id id
-;; :profile-id uuid/zero
-;; :project-id project-id
-;; :name name
-;; :is-shared true})
-;; (files/create-page conn {:file-id id}))
-;; id))
-
-;; (defn- process-library
-;; [conn basedir project-id {:keys [graphics colors] :as library}]
-;; (us/verify ::import-library library)
-;; (let [library-file-id (create-library-file-if-not-exists conn project-id library)]
-;; (when graphics
-;; (->> (assoc graphics :path (fs/join basedir (:path graphics)))
-;; (import-graphics conn library-file-id)))
-;; (when colors
-;; (import-colors conn library-file-id colors))))
-
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Entry Point
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defn- project-exists?
-;; [conn id]
-;; (s/assert ::us/uuid id)
-;; (let [row (db/get-by-id conn :project id)]
-;; (if row true false)))
-
-;; (defn- create-project-if-not-exists
-;; [conn {:keys [name] :as project}]
-;; (let [id (uuid/namespaced +colors-uuid-ns+ name)]
-;; (when-not (project-exists? conn id)
-;; (log/info "Creating project" name)
-;; (projects/create-project conn {:id id
-;; :team-id uuid/zero
-;; :name name
-;; :default? false}))
-;; id))
-
-;; (defn- validate-path
-;; [path]
-;; (let [path (if (symbol? path) (str path) path)]
-;; (log/infof "Trying to load config from '%s'." path)
-;; (when-not path
-;; (log/error "No path is provided")
-;; (exit! -1))
-;; (when-not (fs/exists? path)
-;; (log/error "Path does not exists.")
-;; (exit! -1))
-;; (when (fs/directory? path)
-;; (log/error "The provided path is a directory.")
-;; (exit! -1))
-;; (fs/path path)))
-
-;; (defn- read-file
-;; [path]
-;; (let [reader (PushbackReader. (io/reader path))]
-;; [(fs/parent path)
-;; (read reader)]))
-
-;; (defn run*
-;; [path]
-;; (let [[basedir libraries] (read-file path)]
-;; (db/with-atomic [conn db/pool]
-;; (let [project-id (create-project-if-not-exists conn {:name "System libraries"})]
-;; (run! #(process-library conn basedir project-id %) libraries)))))
-
-;; (defn run
-;; [{:keys [path] :as params}]
-;; (log/infof "Starting media loader.")
-;; (let [path (validate-path path)]
-
-;; (try
-;; (-> (mount/only #{#'app.config/config
-;; #'app.db/pool
-;; #'app.migrations/migrations
-;; #'app.media/semaphore
-;; #'app.media-storage/media-storage})
-;; (mount/start))
-;; (run* path)
-;; (catch Exception e
-;; (log/errorf e "Unhandled exception."))
-;; (finally
-;; (mount/stop)))))
-
diff --git a/backend/src/app/config.clj b/backend/src/app/config.clj
index 893cfb465..7d57163fe 100644
--- a/backend/src/app/config.clj
+++ b/backend/src/app/config.clj
@@ -25,14 +25,12 @@
:database-username "penpot"
:database-password "penpot"
:secret-key "default"
+ :enabled-asserts true
:media-directory "resources/public/media"
- :assets-directory "resources/public/static"
-
:public-uri "http://localhost:3449/"
:redis-uri "redis://localhost/0"
:media-uri "http://localhost:3449/media/"
- :assets-uri "http://localhost:3449/static/"
:image-process-max-threads 2
@@ -76,11 +74,10 @@
(s/def ::database-password (s/nilable ::us/string))
(s/def ::database-uri ::us/string)
(s/def ::redis-uri ::us/string)
-(s/def ::assets-uri ::us/string)
-(s/def ::assets-directory ::us/string)
(s/def ::media-uri ::us/string)
(s/def ::media-directory ::us/string)
(s/def ::secret-key ::us/string)
+(s/def ::enable-asserts ::us/boolean)
(s/def ::host ::us/string)
(s/def ::error-report-webhook ::us/string)
@@ -132,13 +129,12 @@
::gitlab-client-id
::gitlab-client-secret
::gitlab-base-uri
+ ::enable-asserts
::redis-uri
::public-uri
::database-username
::database-password
::database-uri
- ::assets-directory
- ::assets-uri
::media-directory
::media-uri
::error-report-webhook
@@ -200,8 +196,11 @@
:assets-directory "/tmp/app/static"
:migrations-verbose false))
-(defstate config
- :start (read-config env))
+(def config
+ (delay (read-config env)))
+
+(def test-config
+ (delay (read-test-config env)))
(def default-deletion-delay
(dt/duration {:hours 48}))
@@ -209,14 +208,19 @@
(def version
(delay (v/parse "%version%")))
-(defn smtp
- [cfg]
- {:host (:smtp-host cfg "localhost")
- :port (:smtp-port cfg 25)
- :default-reply-to (:smtp-default-reply-to cfg)
- :default-from (:smtp-default-from cfg)
- :tls (:smtp-tls cfg)
- :enabled (:smtp-enabled cfg)
- :username (:smtp-username cfg)
- :password (:smtp-password cfg)})
+;; (defmethod ig/init-key ::secrets
+;; [type {:keys [key] :as opts}]
+;; (when (= key "default")
+;; (log/warn "Using default SECRET-KEY, system will generate insecure tokens."))
+;; {:key key
+;; :factory
+;; (fn [salt length]
+;; (let [engine (bk/engine {:key key
+;; :salt (name salt)
+;; :alg :hkdf
+;; :digest :blake2b-512})]
+;; (bk/get-bytes engine length)))})
+(prefer-method print-method
+ clojure.lang.IRecord
+ clojure.lang.IDeref)
diff --git a/backend/src/app/db.clj b/backend/src/app/db.clj
index 50b492800..4de8d33fd 100644
--- a/backend/src/app/db.clj
+++ b/backend/src/app/db.clj
@@ -9,16 +9,16 @@
(ns app.db
(:require
+ [app.common.spec :as us]
[app.common.exceptions :as ex]
[app.common.geom.point :as gpt]
[app.config :as cfg]
- [app.metrics :as mtx]
[app.util.time :as dt]
[app.util.transit :as t]
[clojure.data.json :as json]
[clojure.spec.alpha :as s]
[clojure.string :as str]
- [mount.core :as mount :refer [defstate]]
+ [integrant.core :as ig]
[next.jdbc :as jdbc]
[next.jdbc.date-time :as jdbc-dt]
[next.jdbc.optional :as jdbc-opt]
@@ -35,30 +35,65 @@
org.postgresql.util.PGInterval
org.postgresql.util.PGobject))
+(declare open)
+(declare create-pool)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Initialization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/def ::uri ::us/not-empty-string)
+(s/def ::name ::us/not-empty-string)
+(s/def ::min-pool-size ::us/integer)
+(s/def ::max-pool-size ::us/integer)
+(s/def ::migrations fn?)
+(s/def ::metrics map?)
+
+(defmethod ig/pre-init-spec ::pool [_]
+ (s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size ::migrations]))
+
+(defmethod ig/init-key ::pool
+ [_ {:keys [migrations] :as cfg}]
+ (let [pool (create-pool cfg)]
+ (when migrations
+ (with-open [conn (open pool)]
+ (migrations conn)))
+ pool))
+
+(defmethod ig/halt-key! ::pool
+ [_ pool]
+ (.close ^com.zaxxer.hikari.HikariDataSource pool))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; API & Impl
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
(def initsql
(str "SET statement_timeout = 10000;\n"
"SET idle_in_transaction_session_timeout = 30000;"))
+
(defn- create-datasource-config
- [cfg]
- (let [dburi (:database-uri cfg)
- username (:database-username cfg)
- password (:database-password cfg)
- config (HikariConfig.)
- mfactory (PrometheusMetricsTrackerFactory. mtx/registry)]
+ [{:keys [metrics] :as cfg}]
+ (let [dburi (:uri cfg)
+ username (:username cfg)
+ password (:password cfg)
+ config (HikariConfig.)
+ mtf (PrometheusMetricsTrackerFactory. (:registry metrics))]
(doto config
(.setJdbcUrl (str "jdbc:" dburi))
- (.setPoolName "main")
+ (.setPoolName (:name cfg "default"))
(.setAutoCommit true)
(.setReadOnly false)
(.setConnectionTimeout 8000) ;; 8seg
- (.setValidationTimeout 4000) ;; 4seg
- (.setIdleTimeout 300000) ;; 5min
- (.setMaxLifetime 900000) ;; 15min
- (.setMinimumIdle 0)
- (.setMaximumPoolSize 15)
+ (.setValidationTimeout 8000) ;; 8seg
+ (.setIdleTimeout 120000) ;; 2min
+ (.setMaxLifetime 1800000) ;; 30min
+ (.setMinimumIdle (:min-pool-size cfg 0))
+ (.setMaximumPoolSize (:max-pool-size cfg 30))
+ (.setMetricsTrackerFactory mtf)
(.setConnectionInitSql initsql)
- (.setMetricsTrackerFactory mfactory))
+ (.setInitializationFailTimeout -1))
(when username (.setUsername config username))
(when password (.setPassword config password))
config))
@@ -79,12 +114,6 @@
(jdbc-dt/read-as-instant)
(HikariDataSource. dsc)))
-(declare pool)
-
-(defstate pool
- :start (create-pool cfg/config)
- :stop (.close pool))
-
(defmacro with-atomic
[& args]
`(jdbc/with-transaction ~@args))
@@ -96,7 +125,7 @@
(jdbc-opt/as-unqualified-modified-maps rs (assoc opts :label-fn kebab-case)))
(defn open
- []
+ [pool]
(jdbc/get-connection pool))
(defn exec!
@@ -258,11 +287,3 @@
(defn pgarray->vector
[v]
(vec (.getArray ^PgArray v)))
-
-;; Instrumentation
-
-(mtx/instrument-with-counter!
- {:var [#'jdbc/execute-one!
- #'jdbc/execute!]
- :id "database__query_counter"
- :help "An absolute counter of database queries."})
diff --git a/backend/src/app/error_reporter.clj b/backend/src/app/error_reporter.clj
index a567c17ab..f0745f970 100644
--- a/backend/src/app/error_reporter.clj
+++ b/backend/src/app/error_reporter.clj
@@ -16,68 +16,71 @@
[app.db :as db]
[app.tasks :as tasks]
[app.util.async :as aa]
- [app.worker :as wrk]
- [app.util.http :as http]
+ [app.util.emails :as emails]
[clojure.core.async :as a]
[clojure.data.json :as json]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[cuerdas.core :as str]
- [mount.core :as mount :refer [defstate]]
+ [integrant.core :as ig]
[promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Public API
+;; Error Reporting
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defonce enqueue identity)
+(declare send-notification!)
+(defonce queue-fn identity)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Implementation
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(s/def ::http-client fn?)
+(s/def ::uri (s/nilable ::us/uri))
-(defn- send-to-mattermost!
- [log-event]
+(defmethod ig/pre-init-spec ::instance [_]
+ (s/keys :req-un [::aa/executor ::uri ::http-client]))
+
+(defmethod ig/init-key ::instance
+ [_ {:keys [executor uri] :as cfg}]
+ (let [out (a/chan (a/sliding-buffer 64))]
+ (log/info "Intializing error reporter.")
+ (if uri
+ (do
+ (alter-var-root #'queue-fn (constantly (fn [x] (a/>!! out (str x)))))
+ (a/go-loop []
+ (let [val (a/!! qch %)))
- (a/go-loop []
- (let [val (a/ (session/extract-auth-token req)
- (session/delete))
+ [{:keys [session] :as cfg} request]
+ (session/delete! cfg request)
{:status 200
- :cookies (session/cookies "" {:max-age -1})
+ :cookies (session/cookies session {:value "" :max-age -1})
:body ""})
diff --git a/backend/src/app/http/auth/gitlab.clj b/backend/src/app/http/auth/gitlab.clj
index fd3ebcc3e..57223158a 100644
--- a/backend/src/app/http/auth/gitlab.clj
+++ b/backend/src/app/http/auth/gitlab.clj
@@ -10,54 +10,53 @@
(ns app.http.auth.gitlab
(:require
[app.common.exceptions :as ex]
+ [app.common.spec :as us]
+ [app.common.data :as d]
[app.config :as cfg]
[app.http.session :as session]
- [app.services.mutations :as sm]
- [app.services.tokens :as tokens]
[app.util.http :as http]
[app.util.time :as dt]
[clojure.data.json :as json]
+ [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
+ [integrant.core :as ig]
[lambdaisland.uri :as uri]))
-(def default-base-gitlab-uri "https://gitlab.com")
-
(def scope "read_user")
(defn- build-redirect-url
- []
- (let [public (uri/uri (:public-uri cfg/config))]
+ [cfg]
+ (let [public (uri/uri (:public-uri cfg))]
(str (assoc public :path "/api/oauth/gitlab/callback"))))
(defn- build-oauth-uri
- []
- (let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))]
+ [cfg]
+ (let [base-uri (uri/uri (:base-uri cfg))]
(assoc base-uri :path "/oauth/authorize")))
(defn- build-token-url
- []
- (let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))]
+ [cfg]
+ (let [base-uri (uri/uri (:base-uri cfg))]
(str (assoc base-uri :path "/oauth/token"))))
(defn- build-user-info-url
- []
- (let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))]
+ [cfg]
+ (let [base-uri (uri/uri (:base-uri cfg))]
(str (assoc base-uri :path "/api/v4/user"))))
-
(defn- get-access-token
- [code]
- (let [params {:client_id (:gitlab-client-id cfg/config)
- :client_secret (:gitlab-client-secret cfg/config)
+ [cfg code]
+ (let [params {:client_id (:client-id cfg)
+ :client_secret (:client-secret cfg)
:code code
:grant_type "authorization_code"
- :redirect_uri (build-redirect-url)}
+ :redirect_uri (build-redirect-url cfg)}
req {:method :post
:headers {"content-type" "application/x-www-form-urlencoded"}
- :uri (build-token-url)
+ :uri (build-token-url cfg)
:body (uri/map->query-string params)}
res (http/send! req)]
@@ -98,12 +97,11 @@
nil))))
(defn auth
- [_req]
- (let [token (tokens/generate
- {:iss :gitlab-oauth
- :exp (dt/in-future "15m")})
+ [{:keys [tokens] :as cfg} _request]
+ (let [token (tokens :generate {:iss :gitlab-oauth
+ :exp (dt/in-future "15m")})
- params {:client_id (:gitlab-client-id cfg/config)
+ params {:client_id (:client-id cfg)
:redirect_uri (build-redirect-url)
:response_type "code"
:state token
@@ -115,33 +113,68 @@
:body {:redirect-uri (str uri)}}))
(defn callback
- [req]
- (let [token (get-in req [:params :state])
- _ (tokens/verify token {:iss :gitlab-oauth})
- info (some-> (get-in req [:params :code])
- (get-access-token)
- (get-user-info))]
+ [{:keys [tokens rpc session] :as cfg} request]
+ (let [token (get-in request [:params :state])
+ _ (tokens :verify {:token token :iss :gitlab-oauth})
+ info (some->> (get-in request [:params :code])
+ (get-access-token cfg)
+ (get-user-info))]
(when-not info
(ex/raise :type :authentication
:code :unable-to-authenticate-with-gitlab))
- (let [profile (sm/handle {::sm/type :login-or-register
- :email (:email info)
- :fullname (:fullname info)})
- uagent (get-in req [:headers "user-agent"])
+ (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
+ profile (method-fn {:email (:email info)
+ :fullname (:fullname info)})
+ uagent (get-in request [:headers "user-agent"])
- token (tokens/generate
- {:iss :auth
- :exp (dt/in-future "15m")
- :profile-id (:id profile)})
+ token (tokens :generate {:iss :auth
+ :exp (dt/in-future "15m")
+ :profile-id (:id profile)})
- uri (-> (uri/uri (:public-uri cfg/config))
- (assoc :path "/#/auth/verify-token")
- (assoc :query (uri/map->query-string {:token token})))
- sid (session/create (:id profile) uagent)]
+ uri (-> (uri/uri (:public-uri cfg))
+ (assoc :path "/#/auth/verify-token")
+ (assoc :query (uri/map->query-string {:token token})))
+ sid (session/create! session {:profile-id (:id profile)
+ :user-agent uagent})]
{:status 302
:headers {"location" (str uri)}
- :cookies (session/cookies sid)
+ :cookies (session/cookies session {:value sid})
:body ""})))
+
+
+(s/def ::client-id ::us/not-empty-string)
+(s/def ::client-secret ::us/not-empty-string)
+(s/def ::base-uri ::us/not-empty-string)
+(s/def ::public-uri ::us/not-empty-string)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec :app.http.auth/gitlab [_]
+ (s/keys :req-un [::public-uri
+ ::session
+ ::tokens]
+ :opt-un [::base-uri
+ ::client-id
+ ::client-secret]))
+
+
+(defmethod ig/prep-key :app.http.auth/gitlab
+ [_ cfg]
+ (d/merge {:base-uri "https://gitlab.com"}
+ (d/without-nils cfg)))
+
+(defn- default-handler
+ [req]
+ (ex/raise :type :not-found))
+
+(defmethod ig/init-key :app.http.auth/gitlab
+ [_ cfg]
+ (if (and (:client-id cfg)
+ (:client-secret cfg))
+ {:auth-handler #(auth cfg %)
+ :callback-handler #(callback cfg %)}
+ {:auth-handler default-handler
+ :callback-handler default-handler}))
diff --git a/backend/src/app/http/auth/google.clj b/backend/src/app/http/auth/google.clj
index 33fba3179..4447e42cd 100644
--- a/backend/src/app/http/auth/google.clj
+++ b/backend/src/app/http/auth/google.clj
@@ -10,14 +10,15 @@
(ns app.http.auth.google
(:require
[app.common.exceptions :as ex]
+ [app.common.spec :as us]
[app.config :as cfg]
[app.http.session :as session]
- [app.services.mutations :as sm]
- [app.services.tokens :as tokens]
[app.util.http :as http]
[app.util.time :as dt]
[clojure.data.json :as json]
+ [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
+ [integrant.core :as ig]
[lambdaisland.uri :as uri]))
(def base-goauth-uri "https://accounts.google.com/o/oauth2/v2/auth")
@@ -29,16 +30,16 @@
"openid"))
(defn- build-redirect-url
- []
- (let [public (uri/uri (:public-uri cfg/config))]
+ [cfg]
+ (let [public (uri/uri (:public-uri cfg))]
(str (assoc public :path "/api/oauth/google/callback"))))
(defn- get-access-token
- [code]
+ [cfg code]
(let [params {:code code
- :client_id (:google-client-id cfg/config)
- :client_secret (:google-client-secret cfg/config)
- :redirect_uri (build-redirect-url)
+ :client_id (:client-id cfg)
+ :client_secret (:client-secret cfg)
+ :redirect_uri (build-redirect-url cfg)
:grant_type "authorization_code"}
req {:method :post
:headers {"content-type" "application/x-www-form-urlencoded"}
@@ -59,7 +60,6 @@
(log/error "unexpected error on parsing response body from google access token request" e)
nil))))
-
(defn- get-user-info
[token]
(let [req {:uri "https://openidconnect.googleapis.com/v1/userinfo"
@@ -82,50 +82,74 @@
(log/error "unexpected error on parsing response body from google access token request" e)
nil))))
-(defn auth
- [_req]
- (let [token (tokens/generate {:iss :google-oauth :exp (dt/in-future "15m")})
+(defn- auth
+ [{:keys [tokens] :as cfg} _req]
+ (let [token (tokens :generate {:iss :google-oauth :exp (dt/in-future "15m")})
params {:scope scope
:access_type "offline"
:include_granted_scopes true
:state token
:response_type "code"
:redirect_uri (build-redirect-url)
- :client_id (:google-client-id cfg/config)}
+ :client_id (:client-id cfg)}
query (uri/map->query-string params)
uri (-> (uri/uri base-goauth-uri)
(assoc :query query))]
{:status 200
:body {:redirect-uri (str uri)}}))
-
-(defn callback
- [req]
- (let [token (get-in req [:params :state])
- _ (tokens/verify token {:iss :google-oauth})
- info (some-> (get-in req [:params :code])
- (get-access-token)
- (get-user-info))]
+(defn- callback
+ [{:keys [tokens rpc session] :as cfg} request]
+ (let [token (get-in request [:params :state])
+ _ (tokens :verify {:token token :iss :google-oauth})
+ info (some->> (get-in request [:params :code])
+ (get-access-token cfg)
+ (get-user-info))]
(when-not info
(ex/raise :type :authentication
:code :unable-to-authenticate-with-google))
- (let [profile (sm/handle {::sm/type :login-or-register
- :email (:email info)
- :fullname (:fullname info)})
- uagent (get-in req [:headers "user-agent"])
-
- token (tokens/generate
- {:iss :auth
- :exp (dt/in-future "15m")
- :profile-id (:id profile)})
- uri (-> (uri/uri (:public-uri cfg/config))
- (assoc :path "/#/auth/verify-token")
- (assoc :query (uri/map->query-string {:token token})))
- sid (session/create (:id profile) uagent)]
+ (let [method-fn (get-in rpc [:method :mutations :login-or-register])
+ profile (method-fn {:email (:email info)
+ :fullname (:fullname info)})
+ uagent (get-in request [:headers "user-agent"])
+ token (tokens :generate {:iss :auth
+ :exp (dt/in-future "15m")
+ :profile-id (:id profile)})
+ uri (-> (uri/uri (:public-uri cfg))
+ (assoc :path "/#/auth/verify-token")
+ (assoc :query (uri/map->query-string {:token token})))
+ sid (session/create! session {:profile-id (:id profile)
+ :user-agent uagent})]
{:status 302
:headers {"location" (str uri)}
- :cookies (session/cookies sid)
+ :cookies (session/cookies session {:value sid})
:body ""})))
+
+(s/def ::client-id ::us/not-empty-string)
+(s/def ::client-secret ::us/not-empty-string)
+(s/def ::public-uri ::us/not-empty-string)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec :app.http.auth/google [_]
+ (s/keys :req-un [::public-uri
+ ::session
+ ::tokens]
+ :opt-un [::client-id
+ ::client-secret]))
+
+(defn- default-handler
+ [req]
+ (ex/raise :type :not-found))
+
+(defmethod ig/init-key :app.http.auth/google
+ [_ cfg]
+ (if (and (:client-id cfg)
+ (:client-secret cfg))
+ {:auth-handler #(auth cfg %)
+ :callback-handler #(callback cfg %)}
+ {:auth-handler default-handler
+ :callback-handler default-handler}))
diff --git a/backend/src/app/http/auth/ldap.clj b/backend/src/app/http/auth/ldap.clj
index 1dc61b0d4..02a82fae9 100644
--- a/backend/src/app/http/auth/ldap.clj
+++ b/backend/src/app/http/auth/ldap.clj
@@ -12,50 +12,110 @@
[app.common.exceptions :as ex]
[app.config :as cfg]
[app.http.session :as session]
- [app.services.mutations :as sm]
[clj-ldap.client :as client]
[clojure.set :as set]
- [clojure.string]
+ [clojure.spec.alpha :as s]
+ [clojure.string ]
[clojure.tools.logging :as log]
- [mount.core :refer [defstate]]))
+ [integrant.core :as ig]))
-(defn replace-several [s & {:as replacements}]
+(declare authenticate)
+(declare create-connection)
+(declare replace-several)
+
+
+(s/def ::host ::cfg/ldap-auth-host)
+(s/def ::port ::cfg/ldap-auth-port)
+(s/def ::ssl ::cfg/ldap-auth-ssl)
+(s/def ::starttls ::cfg/ldap-auth-starttls)
+(s/def ::user-query ::cfg/ldap-auth-user-query)
+(s/def ::base-dn ::cfg/ldap-auth-base-dn)
+(s/def ::username-attribute ::cfg/ldap-auth-username-attribute)
+(s/def ::email-attribute ::cfg/ldap-auth-email-attribute)
+(s/def ::fullname-attribute ::cfg/ldap-auth-fullname-attribute)
+(s/def ::avatar-attribute ::cfg/ldap-auth-avatar-attribute)
+
+(s/def ::rpc map?)
+(s/def ::session map?)
+
+(defmethod ig/pre-init-spec :app.http.auth/ldap
+ [_]
+ (s/keys
+ :req-un [::rpc ::session]
+ :opt-un [::host
+ ::port
+ ::ssl
+ ::starttls
+ ::username-attribute
+ ::base-dn
+ ::username-attribute
+ ::email-attribute
+ ::fullname-attribute
+ ::avatar-attribute]))
+
+(defmethod ig/init-key :app.http.auth/ldap
+ [_ {:keys [session rpc] :as cfg}]
+ (let [conn (create-connection cfg)]
+ (with-meta
+ (fn [request]
+ (let [data (:body-params request)]
+ (when-some [info (authenticate (assoc cfg
+ :conn conn
+ :username (:email data)
+ :password (:password data)))]
+ (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
+ profile (method-fn {:email (:email info)
+ :fullname (:fullname info)})
+ uagent (get-in request [:headers "user-agent"])
+ sid (session/create! session {:profile-id (:id profile)
+ :user-agent uagent})]
+ {:status 200
+ :cookies (session/cookies session {:value sid})
+ :body profile}))))
+ {::conn conn})))
+
+(defmethod ig/halt-key! ::client
+ [_ handler]
+ (let [{:keys [::conn]} (meta handler)]
+ (when (realized? conn)
+ (.close @conn))))
+
+(defn- replace-several [s & {:as replacements}]
(reduce-kv clojure.string/replace s replacements))
-(declare *ldap-pool)
+(defn- create-connection
+ [cfg]
+ (let [params (merge {:host {:address (:host cfg)
+ :port (:port cfg)}}
+ (-> cfg
+ (select-keys [:ssl
+ :starttls
+ :ldap-bind-dn
+ :ldap-bind-password])
+ (set/rename-keys {:ssl :ssl?
+ :starttls :startTLS?
+ :ldap-bind-dn :bind-dn
+ :ldap-bind-password :password})))]
+ (delay
+ (try
+ (client/connect params)
+ (catch Exception e
+ (log/errorf e "Cannot connect to LDAP %s:%s"
+ (:host cfg) (:port cfg)))))))
-(defstate *ldap-pool
- :start (delay
- (try
- (client/connect (merge {:host {:address (:ldap-auth-host cfg/config)
- :port (:ldap-auth-port cfg/config)}}
- (-> cfg/config
- (select-keys [:ldap-auth-ssl
- :ldap-auth-starttls
- :ldap-bind-dn
- :ldap-bind-password])
- (set/rename-keys {:ldap-auth-ssl :ssl?
- :ldap-auth-starttls :startTLS?
- :ldap-bind-dn :bind-dn
- :ldap-bind-password :password}))))
- (catch Exception e
- (log/errorf e "Cannot connect to LDAP %s:%s"
- (:ldap-auth-host cfg/config) (:ldap-auth-port cfg/config)))))
- :stop (when (realized? *ldap-pool)
- (some-> *ldap-pool deref (.close))))
-(defn- auth-with-ldap [username password]
- (when-some [conn (some-> *ldap-pool deref)]
- (let [user-search-query (replace-several (:ldap-auth-user-query cfg/config)
- "$username" username)
- user-attributes (-> cfg/config
- (select-keys [:ldap-auth-username-attribute
- :ldap-auth-email-attribute
- :ldap-auth-fullname-attribute
- :ldap-auth-avatar-attribute])
- vals)]
+(defn- authenticate
+ [{:keys [conn username password] :as cfg}]
+ (when-some [conn (some-> conn deref)]
+ (let [user-search-query (replace-several (:user-query cfg) "$username" username)
+ user-attributes (-> cfg
+ (select-keys [:username-attribute
+ :email-attribute
+ :fullname-attribute
+ :avatar-attribute])
+ vals)]
(when-some [user-entry (-> conn
- (client/search (:ldap-auth-base-dn cfg/config)
+ (client/search (:base-dn cfg)
{:filter user-search-query
:sizelimit 1
:attributes user-attributes})
@@ -63,18 +123,7 @@
(when-not (client/bind? conn (:dn user-entry) password)
(ex/raise :type :authentication
:code :wrong-credentials))
- (set/rename-keys user-entry {(keyword (:ldap-auth-avatar-attribute cfg/config)) :photo
- (keyword (:ldap-auth-fullname-attribute cfg/config)) :fullname
- (keyword (:ldap-auth-email-attribute cfg/config)) :email})))))
+ (set/rename-keys user-entry {(keyword (:avatar-attribute cfg)) :photo
+ (keyword (:fullname-attribute cfg)) :fullname
+ (keyword (:email-attribute cfg)) :email})))))
-(defn auth [req]
- (let [data (:body-params req)
- uagent (get-in req [:headers "user-agent"])]
- (when-some [info (auth-with-ldap (:email data) (:password data))]
- (let [profile (sm/handle {::sm/type :login-or-register
- :email (:email info)
- :fullname (:fullname info)})
- sid (session/create (:id profile) uagent)]
- {:status 200
- :cookies (session/cookies sid)
- :body profile}))))
diff --git a/backend/src/app/http/handlers.clj b/backend/src/app/http/handlers.clj
index b99f118a2..ae07487e8 100644
--- a/backend/src/app/http/handlers.clj
+++ b/backend/src/app/http/handlers.clj
@@ -8,7 +8,7 @@
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.http.handlers
- (:require
+ #_(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.emails :as emails]
@@ -18,69 +18,61 @@
[app.services.queries :as sq]
[app.services.svgparse :as svgp]))
-(def unauthorized-services
- #{:create-demo-profile
- :logout
- :profile
- :verify-token
- :recover-profile
- :register-profile
- :request-profile-recovery
- :viewer-bundle
- :login})
+;; (def unauthorized-services
+;; #{:create-demo-profile
+;; :logout
+;; :profile
+;; :verify-token
+;; :recover-profile
+;; :register-profile
+;; :request-profile-recovery
+;; :viewer-bundle
+;; :login})
-(defn query-handler
- [{:keys [profile-id] :as request}]
- (let [type (keyword (get-in request [:path-params :type]))
- data (assoc (:params request) ::sq/type type)
- data (if profile-id
- (assoc data :profile-id profile-id)
- (dissoc data :profile-id))]
+;; (defn query-handler
+;; [cfg {:keys [profile-id] :as request}]
+;; (let [type (keyword (get-in request [:path-params :type]))
+;; data (assoc (:params request) ::sq/type type)
+;; data (if profile-id
+;; (assoc data :profile-id profile-id)
+;; (dissoc data :profile-id))]
- (if (or (uuid? profile-id)
- (contains? unauthorized-services type))
- {:status 200
- :body (sq/handle (with-meta data {:req request}))}
- {:status 403
- :body {:type :authentication
- :code :unauthorized}})))
+;; (if (or (uuid? profile-id)
+;; (contains? unauthorized-services type))
+;; {:status 200
+;; :body (sq/handle (with-meta data {:req request}))}
+;; {:status 403
+;; :body {:type :authentication
+;; :code :unauthorized}})))
-(defn mutation-handler
- [{:keys [profile-id] :as request}]
- (let [type (keyword (get-in request [:path-params :type]))
- data (d/merge (:params request)
- (:body-params request)
- (:uploads request)
- {::sm/type type})
- data (if profile-id
- (assoc data :profile-id profile-id)
- (dissoc data :profile-id))]
+;; (defn mutation-handler
+;; [cfg {:keys [profile-id] :as request}]
+;; (let [type (keyword (get-in request [:path-params :type]))
+;; data (d/merge (:params request)
+;; (:body-params request)
+;; (:uploads request)
+;; {::sm/type type})
+;; data (if profile-id
+;; (assoc data :profile-id profile-id)
+;; (dissoc data :profile-id))]
- (if (or (uuid? profile-id)
- (contains? unauthorized-services type))
- (let [result (sm/handle (with-meta data {:req request}))
- mdata (meta result)
- resp {:status (if (nil? (seq result)) 204 200)
- :body result}]
- (cond->> resp
- (:transform-response mdata) ((:transform-response mdata) request)))
- {:status 403
- :body {:type :authentication
- :code :unauthorized}})))
+;; (if (or (uuid? profile-id)
+;; (contains? unauthorized-services type))
+;; (let [result (sm/handle (with-meta data {:req request}))
+;; mdata (meta result)
+;; resp {:status (if (nil? (seq result)) 204 200)
+;; :body result}]
+;; (cond->> resp
+;; (:transform-response mdata) ((:transform-response mdata) request)))
+;; {:status 403
+;; :body {:type :authentication
+;; :code :unauthorized}})))
-(defn echo-handler
- [req]
- {:status 200
- :body {:params (:params req)
- :cookies (:cookies req)
- :headers (:headers req)}})
-
-
-(defn parse-svg
- [{:keys [headers body] :as request}]
- (when (not= "image/svg+xml" (get headers "content-type"))
- (ex/raise :type :validation
- :code :unsupported-mime-type
- :mime (get headers "content-type")))
- {:status 200
- :body (svgp/parse body)})
+;; (defn parse-svg
+;; [{:keys [headers body] :as request}]
+;; (when (not= "image/svg+xml" (get headers "content-type"))
+;; (ex/raise :type :validation
+;; :code :unsupported-mime-type
+;; :mime (get headers "content-type")))
+;; {:status 200
+;; :body (svgp/parse body)})
diff --git a/backend/src/app/http/middleware.clj b/backend/src/app/http/middleware.clj
index 47d85a521..c12dcd827 100644
--- a/backend/src/app/http/middleware.clj
+++ b/backend/src/app/http/middleware.clj
@@ -37,7 +37,7 @@
:json (parse-json body)
:transit (parse-transit body))
(catch Exception e
- (let [type (if (:debug cfg/config) :json-verbose :json)
+ (let [type (if (:debug @cfg/config) :json-verbose :json)
data {:type :parse
:hint "unable to parse request body"
:message (ex-message e)}]
@@ -70,7 +70,7 @@
(defn- impl-format-response-body
[response]
(let [body (:body response)
- type (if (:debug cfg/config) :json-verbose :json)]
+ type (if (:debug @cfg/config) :json-verbose :json)]
(cond
(coll? body)
(-> response
diff --git a/backend/src/app/http/session.clj b/backend/src/app/http/session.clj
index 75fe605b5..c83ddd4ea 100644
--- a/backend/src/app/http/session.clj
+++ b/backend/src/app/http/session.clj
@@ -7,60 +7,65 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-;; TODO: move to services.
-
(ns app.http.session
(:require
+ [clojure.spec.alpha :as s]
+ [integrant.core :as ig]
[app.db :as db]
[buddy.core.codecs :as bc]
[buddy.core.nonce :as bn]))
-(defn next-token
- [n]
- (-> (bn/random-nonce n)
- (bc/bytes->b64u)
- (bc/bytes->str)))
+(defn next-session-id
+ ([] (next-session-id 96))
+ ([n]
+ (-> (bn/random-nonce n)
+ (bc/bytes->b64u)
+ (bc/bytes->str))))
-(defn extract-auth-token
- [request]
- (get-in request [:cookies "auth-token" :value]))
+(defn create!
+ [{:keys [conn] :as cfg} {:keys [profile-id user-agent]}]
+ (let [id (next-session-id)]
+ (db/insert! conn :http-session {:id id
+ :profile-id profile-id
+ :user-agent user-agent})
+ id))
+
+(defn delete!
+ [{:keys [conn cookie-name] :as cfg} request]
+ (when-let [token (get-in request [:cookies cookie-name :value])]
+ (db/delete! conn :http-session {:id token}))
+ nil)
(defn retrieve
- [conn token]
+ [{:keys [conn] :as cfg} token]
(when token
(-> (db/exec-one! conn ["select profile_id from http_session where id = ?" token])
(:profile-id))))
(defn retrieve-from-request
- [conn request]
- (->> (extract-auth-token request)
- (retrieve conn)))
-
-(defn create
- [profile-id user-agent]
- (let [id (next-token 64)]
- (db/insert! db/pool :http-session {:id id
- :profile-id profile-id
- :user-agent user-agent})
- id))
-
-(defn delete
- [token]
- (db/delete! db/pool :http-session {:id token})
- nil)
+ [{:keys [cookie-name] :as cfg} request]
+ (->> (get-in request [:cookies cookie-name :value])
+ (retrieve cfg)))
(defn cookies
- ([id] (cookies id {}))
- ([id opts]
- {"auth-token" (merge opts {:value id :path "/" :http-only true})}))
+ [{:keys [cookie-name] :as cfg} vals]
+ {cookie-name (merge vals {:path "/" :http-only true})})
-(defn wrap-session
- [handler]
+(defn middleware
+ [cfg handler]
(fn [request]
- (if-let [profile-id (retrieve-from-request db/pool request)]
+ (if-let [profile-id (retrieve-from-request cfg request)]
(handler (assoc request :profile-id profile-id))
(handler request))))
-(def middleware
- {:nane ::middleware
- :compile (constantly wrap-session)})
+(defmethod ig/pre-init-spec ::session [_]
+ (s/keys :req-un [::db/pool]))
+
+(defmethod ig/prep-key ::session
+ [_ cfg]
+ (merge {:cookie-name "auth-token"} cfg))
+
+(defmethod ig/init-key ::session
+ [_ {:keys [pool] :as cfg}]
+ (let [cfg (assoc cfg :conn pool)]
+ (merge cfg {:middleware #(middleware cfg %)})))
diff --git a/backend/src/app/http/ws.clj b/backend/src/app/http/ws.clj
deleted file mode 100644
index 0f54a0d23..000000000
--- a/backend/src/app/http/ws.clj
+++ /dev/null
@@ -1,61 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.http.ws
- "Web Socket handlers"
- (:require
- [app.common.spec :as us]
- [app.db :as db]
- [app.http.session :refer [wrap-session]]
- [app.services.notifications :as nf]
- [clojure.spec.alpha :as s]
- [ring.middleware.cookies :refer [wrap-cookies]]
- [ring.middleware.keyword-params :refer [wrap-keyword-params]]
- [ring.middleware.params :refer [wrap-params]]))
-
-(s/def ::file-id ::us/uuid)
-(s/def ::session-id ::us/uuid)
-
-(s/def ::websocket-params
- (s/keys :req-un [::file-id ::session-id]))
-
-(def sql:retrieve-file
- "select f.id as id,
- p.team_id as team_id
- from file as f
- join project as p on (p.id = f.project_id)
- where f.id = ?")
-
-(defn retrieve-file
- [conn id]
- (db/exec-one! conn [sql:retrieve-file id]))
-
-(defn websocket
- [{:keys [profile-id] :as req}]
- (let [params (us/conform ::websocket-params (:params req))
- file (retrieve-file db/pool (:file-id params))
- params (assoc params
- :profile-id profile-id
- :team-id (:team-id file))]
- (cond
- (not profile-id)
- {:error {:code 403 :message "Authentication required"}}
-
- (not file)
- {:error {:code 404 :message "File does not exists"}}
-
- :else
- (nf/websocket params))))
-
-(def handler
- (-> websocket
- (wrap-session)
- (wrap-keyword-params)
- (wrap-cookies)
- (wrap-params)))
diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj
index d223de175..48ffc46ce 100644
--- a/backend/src/app/main.clj
+++ b/backend/src/app/main.clj
@@ -10,33 +10,199 @@
(ns app.main
(:require
[app.config :as cfg]
+ [app.common.data :as d]
+ [app.util.time :as dt]
[clojure.tools.logging :as log]
- [mount.core :as mount]))
-
-(defn- enable-asserts
- [_]
- (let [m (System/getProperty "app.enable-asserts")]
- (or (nil? m) (= "true" m))))
+ [integrant.core :as ig]))
;; Set value for all new threads bindings.
-(alter-var-root #'*assert* enable-asserts)
-
-;; Set value for current thread binding.
-(set! *assert* (enable-asserts nil))
+(alter-var-root #'*assert* (constantly (:enable-asserts @cfg/config)))
;; --- Entry point
-(defn run
- [_params]
- (require 'app.srepl.server
- 'app.services
- 'app.migrations
- 'app.worker
- 'app.media
- 'app.http)
- (mount/start)
- (log/infof "Welcome to penpot! Version: '%s'." (:full @cfg/version)))
+(defn build-system-config
+ [config]
+ {:app.db/pool
+ {:uri (:database-uri config)
+ :username (:database-username config)
+ :password (:database-password config)
+ :metrics (ig/ref :app.metrics/metrics)
+ :migrations (ig/ref :app.migrations/migrations)
+ :name "main"
+ :min-pool-size 0
+ :max-pool-size 10}
+
+ :app.metrics/metrics
+ {}
+
+ :app.migrations/migrations
+ {}
+
+ :app.redis/redis
+ {:uri (:redis-uri config)}
+
+ :app.tokens/tokens
+ {:secret-key (:secret-key config)}
+
+ :app.media-storage/storage
+ {:media-directory (:media-directory config)
+ :media-uri (:media-uri config)}
+
+ :app.http.session/session
+ {:pool (ig/ref :app.db/pool)
+ :cookie-name "auth-token"}
+
+ :app.http/server
+ {:port (:http-server-port config)
+ :router (ig/ref :app.http/router)
+ :ws {"/ws/notifications" (ig/ref :app.notifications/handler)}}
+
+ :app.http/router
+ {:rpc (ig/ref :app.rpc/rpc)
+ :session (ig/ref :app.http.session/session)
+ :tokens (ig/ref :app.tokens/tokens)
+ :public-uri (:public-uri config)
+ :metrics (ig/ref :app.metrics/metrics)
+ :google-auth (ig/ref :app.http.auth/google)
+ :gitlab-auth (ig/ref :app.http.auth/gitlab)
+ :ldap-auth (ig/ref :app.http.auth/ldap)}
+
+ :app.rpc/rpc
+ {:pool (ig/ref :app.db/pool)
+ :session (ig/ref :app.http.session/session)
+ :tokens (ig/ref :app.tokens/tokens)
+ :metrics (ig/ref :app.metrics/metrics)
+ :storage (ig/ref :app.media-storage/storage)
+ :redis (ig/ref :app.redis/redis)}
+
+
+ :app.notifications/handler
+ {:redis (ig/ref :app.redis/redis)
+ :pool (ig/ref :app.db/pool)
+ :session (ig/ref :app.http.session/session)}
+
+ :app.http.auth/google
+ {:rpc (ig/ref :app.rpc/rpc)
+ :session (ig/ref :app.http.session/session)
+ :tokens (ig/ref :app.tokens/tokens)
+ :public-uri (:public-uri config)
+ :client-id (:google-client-id config)
+ :client-secret (:google-client-secret config)}
+
+ :app.http.auth/gitlab
+ {:rpc (ig/ref :app.rpc/rpc)
+ :session (ig/ref :app.http.session/session)
+ :tokens (ig/ref :app.tokens/tokens)
+ :public-uri (:public-uri config)
+ :base-uri (:gitlab-base-uri config)
+ :client-id (:gitlab-client-id config)
+ :client-secret (:gitlab-client-secret config)}
+
+ :app.http.auth/ldap
+ {:host (:ldap-auth-host config)
+ :port (:ldap-auth-port config)
+ :ssl (:ldap-auth-ssl config)
+ :starttls (:ldap-auth-starttls config)
+ :user-query (:ldap-auth-user-query config)
+ :username-attribute (:ldap-auth-username-attribute config)
+ :email-attribute (:ldap-auth-email-attribute config)
+ :fullname-attribute (:ldap-auth-fullname-attribute config)
+ :avatar-attribute (:ldap-auth-avatar-attribute config)
+ :base-dn (:ldap-auth-base-dn config)
+ :session (ig/ref :app.http.session/session)
+ :rpc (ig/ref :app.rpc/rpc)}
+
+ :app.worker/executor
+ {:name "worker"}
+
+ :app.worker/worker
+ {:executor (ig/ref :app.worker/executor)
+ :pool (ig/ref :app.db/pool)
+ :tasks (ig/ref :app.tasks/all)}
+
+ :app.worker/scheduler
+ {:executor (ig/ref :app.worker/executor)
+ :pool (ig/ref :app.db/pool)
+ :schedule [;; TODO: pending to refactor
+ ;; {:id "file-media-gc"
+ ;; :cron #app/cron "0 0 0 */1 * ? *" ;; daily
+ ;; :fn (ig/ref :app.tasks.file-media-gc/handler)}
+
+ {:id "file-xlog-gc"
+ :cron #app/cron "0 0 0 */1 * ?" ;; daily
+ :fn (ig/ref :app.tasks.file-xlog-gc/handler)}
+
+ {:id "tasks-gc"
+ :cron #app/cron "0 0 0 */1 * ?" ;; daily
+ :fn (ig/ref :app.tasks.tasks-gc/handler)}]}
+
+ :app.tasks/all
+ {"sendmail" (ig/ref :app.tasks.sendmail/handler)
+ "delete-object" (ig/ref :app.tasks.delete-object/handler)
+ "delete-profile" (ig/ref :app.tasks.delete-profile/handler)}
+
+ :app.tasks.sendmail/handler
+ {:host (:smtp-host config)
+ :port (:smtp-port config)
+ :ssl (:smtp-ssl config)
+ :tls (:smtp-tls config)
+ :enabled (:smtp-enabled config)
+ :username (:smtp-username config)
+ :password (:smtp-password config)
+ :metrics (ig/ref :app.metrics/metrics)
+ :default-reply-to (:smtp-default-reply-to config)
+ :default-from (:smtp-default-from config)}
+
+ :app.tasks.tasks-gc/handler
+ {:pool (ig/ref :app.db/pool)
+ :max-age (dt/duration {:hours 24})
+ :metrics (ig/ref :app.metrics/metrics)}
+
+ :app.tasks.delete-object/handler
+ {:pool (ig/ref :app.db/pool)
+ :metrics (ig/ref :app.metrics/metrics)}
+
+ :app.tasks.delete-profile/handler
+ {:pool (ig/ref :app.db/pool)
+ :metrics (ig/ref :app.metrics/metrics)}
+
+ :app.tasks.file-media-gc/handler
+ {:pool (ig/ref :app.db/pool)
+ :metrics (ig/ref :app.metrics/metrics)}
+
+ :app.tasks.file-xlog-gc/handler
+ {:pool (ig/ref :app.db/pool)
+ :max-age (dt/duration {:hours 12})
+ :metrics (ig/ref :app.metrics/metrics)}
+
+ :app.srepl/server
+ {:port 6062}
+
+ })
+
+(defmethod ig/init-key :default [_ data] data)
+(defmethod ig/prep-key :default [_ data] (d/without-nils data))
+
+(defonce system {})
+
+(defn start
+ []
+ (let [system-config (build-system-config @cfg/config)]
+ (ig/load-namespaces system-config)
+ (alter-var-root #'system (fn [sys]
+ (when sys (ig/halt! sys))
+ (-> system-config
+ (ig/prep)
+ (ig/init))))
+ (log/infof "Welcome to penpot! Version: '%s'."
+ (:full @cfg/version))))
+
+(defn stop
+ []
+ (alter-var-root #'system (fn [sys]
+ (when sys (ig/halt! sys))
+ nil)))
(defn -main
[& _args]
- (run {}))
+ (start))
diff --git a/backend/src/app/media.clj b/backend/src/app/media.clj
index fc6808f7d..8ec819158 100644
--- a/backend/src/app/media.clj
+++ b/backend/src/app/media.clj
@@ -18,8 +18,7 @@
[clojure.core.async :as a]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
- [datoteka.core :as fs]
- [mount.core :refer [defstate]])
+ [datoteka.core :as fs])
(:import
java.io.ByteArrayInputStream
java.util.concurrent.Semaphore
@@ -27,10 +26,7 @@
org.im4java.core.IMOperation
org.im4java.core.Info))
-(declare semaphore)
-
-(defstate semaphore
- :start (Semaphore. (:image-process-max-threads cfg/config 1)))
+(def semaphore (Semaphore. (:image-process-max-threads cfg/config 1)))
;; --- Generic specs
diff --git a/backend/src/app/media_storage.clj b/backend/src/app/media_storage.clj
index df763c999..85f9f9c75 100644
--- a/backend/src/app/media_storage.clj
+++ b/backend/src/app/media_storage.clj
@@ -10,28 +10,23 @@
(ns app.media-storage
"A media storage impl for app."
(:require
+ [integrant.core :as ig]
+ [app.common.spec :as us]
+ [clojure.spec.alpha :as s]
[app.config :refer [config]]
[app.util.storage :as ust]
[mount.core :refer [defstate]]))
-;; --- State
+(s/def ::media-directory ::us/not-empty-string)
+(s/def ::media-uri ::us/not-empty-string)
-(declare assets-storage)
+(defmethod ig/pre-init-spec ::storage [_]
+ (s/keys :req-un [::media-directory
+ ::media-uri]))
-(defstate assets-storage
- :start (ust/create {:base-path (:assets-directory config)
- :base-uri (:assets-uri config)}))
-
-(declare media-storage)
-
-(defstate media-storage
- :start (ust/create {:base-path (:media-directory config)
- :base-uri (:media-uri config)
- :xf (comp ust/random-path
- ust/slugify-filename)}))
-
-;; --- Public Api
-
-(defn resolve-asset
- [path]
- (str (ust/public-uri assets-storage path)))
+(defmethod ig/init-key ::storage
+ [_ cfg]
+ (ust/create {:base-path (:media-directory cfg)
+ :base-uri (:media-uri cfg)
+ :xf (comp ust/random-path
+ ust/slugify-filename)}))
diff --git a/backend/src/app/metrics.clj b/backend/src/app/metrics.clj
index 4f9a30ad2..bdd6fded0 100644
--- a/backend/src/app/metrics.clj
+++ b/backend/src/app/metrics.clj
@@ -5,9 +5,18 @@
;; 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
+;; Copyright (c) 2020 Andrey Antukh
(ns app.metrics
+ (:require
+ [app.common.exceptions :as ex]
+ [app.util.time :as dt]
+ [app.worker]
+ [clojure.tools.logging :as log]
+ [clojure.spec.alpha :as s]
+ [cuerdas.core :as str]
+ [integrant.core :as ig]
+ [next.jdbc :as jdbc])
(:import
io.prometheus.client.CollectorRegistry
io.prometheus.client.Counter
@@ -17,28 +26,91 @@
io.prometheus.client.hotspot.DefaultExports
java.io.StringWriter))
-(defn- create-registry
+(declare instrument-vars!)
+(declare instrument)
+(declare create-registry)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Entry Point
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- instrument-jdbc!
+ [registry]
+ (instrument-vars!
+ [#'next.jdbc/execute-one!
+ #'next.jdbc/execute!]
+ {:registry registry
+ :type :counter
+ :name "database_query_counter"
+ :help "An absolute counter of database queries."}))
+
+(defn- instrument-workers!
+ [registry]
+ (instrument-vars!
+ [#'app.worker/run-task]
+ {:registry registry
+ :type :summary
+ :name "worker_task_checkout_millis"
+ :help "Latency measured between scheduld_at and execution time."
+ :wrap (fn [rootf mobj]
+ (let [mdata (meta rootf)
+ origf (::original mdata rootf)]
+ (with-meta
+ (fn [tasks item]
+ (let [now (inst-ms (dt/now))
+ sat (inst-ms (:scheduled-at item))]
+ (mobj :observe (- now sat))
+ (origf tasks item)))
+ {::original origf})))}))
+
+(defn- handler
+ [registry request]
+ (let [samples (.metricFamilySamples ^CollectorRegistry registry)
+ writer (StringWriter.)]
+ (TextFormat/write004 writer samples)
+ {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
+ :body (.toString writer)}))
+
+(defmethod ig/init-key ::metrics
+ [_ opts]
+ (log/infof "Initializing prometheus registry and instrumentation.")
+ (let [registry (create-registry)]
+ (instrument-workers! registry)
+ (instrument-jdbc! registry)
+ {:handler (partial handler registry)
+ :registry registry}))
+
+(s/def ::handler fn?)
+(s/def ::registry #(instance? CollectorRegistry %))
+(s/def ::metrics
+ (s/keys :req-un [::registry ::handler]))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn create-registry
[]
(let [registry (CollectorRegistry.)]
- (DefaultExports/register registry)
+ ;; (DefaultExports/register registry)
registry))
-(defonce registry (create-registry))
-(defonce cache (atom {}))
-
(defmacro with-measure
- [sym expr teardown]
- `(let [~sym (System/nanoTime)]
+ [& {:keys [expr cb]}]
+ `(let [start# (System/nanoTime)
+ tdown# ~cb]
(try
~expr
(finally
- (let [~sym (/ (- (System/nanoTime) ~sym) 1000000)]
- ~teardown)))))
+ (tdown# (/ (- (System/nanoTime) start#) 1000000))))))
(defn make-counter
- [{:keys [id help] :as props}]
- (let [instance (doto (Counter/build)
- (.name id)
+ [{:keys [name help registry reg] :as props}]
+ (let [registry (or registry reg)
+ instance (doto (Counter/build)
+ (.name name)
(.help help))
instance (.register instance registry)]
(reify
@@ -47,36 +119,16 @@
clojure.lang.IFn
(invoke [_ cmd]
- (.inc ^Counter instance))
-
- (invoke [_ cmd val]
- (case cmd
- :wrap (fn
- ([a]
- (.inc ^Counter instance)
- (val a))
- ([a b]
- (.inc ^Counter instance)
- (val a b))
- ([a b c]
- (.inc ^Counter instance)
- (val a b c)))
-
- (throw (IllegalArgumentException. "invalid arguments")))))))
-
-(defn counter
- [{:keys [id] :as props}]
- (or (get @cache id)
- (let [v (make-counter props)]
- (swap! cache assoc id v)
- v)))
+ (.inc ^Counter instance)))))
(defn make-gauge
- [{:keys [id help] :as props}]
- (let [instance (doto (Gauge/build)
- (.name id)
+ [{:keys [name help registry reg] :as props}]
+ (let [registry (or registry reg)
+ instance (doto (Gauge/build)
+ (.name name)
(.help help))
instance (.register instance registry)]
+
(reify
clojure.lang.IDeref
(deref [_] instance)
@@ -87,92 +139,92 @@
:inc (.inc ^Gauge instance)
:dec (.dec ^Gauge instance))))))
-(defn gauge
- [{:keys [id] :as props}]
- (or (get @cache id)
- (let [v (make-gauge props)]
- (swap! cache assoc id v)
- v)))
-
(defn make-summary
- [{:keys [id help] :as props}]
- (let [instance (doto (Summary/build)
- (.name id)
+ [{:keys [name help registry reg] :as props}]
+ (let [registry (or registry reg)
+ instance (doto (Summary/build)
+ (.name name)
(.help help)
(.quantile 0.5 0.05)
(.quantile 0.9 0.01)
(.quantile 0.99 0.001))
- instance (.register instance registry)]
+ instance (.register instance registry)]
(reify
clojure.lang.IDeref
(deref [_] instance)
clojure.lang.IFn
- (invoke [_ val]
- (.observe ^Summary instance val))
-
(invoke [_ cmd val]
- (case cmd
- :wrap (fn
- ([a]
- (with-measure $$
- (val a)
- (.observe ^Summary instance $$)))
- ([a b]
- (with-measure $$
- (val a b)
- (.observe ^Summary instance $$)))
- ([a b c]
- (with-measure $$
- (val a b c)
- (.observe ^Summary instance $$))))
+ (.observe ^Summary instance val)))))
- (throw (IllegalArgumentException. "invalid arguments")))))))
-
-(defn summary
- [{:keys [id] :as props}]
- (or (get @cache id)
- (let [v (make-summary props)]
- (swap! cache assoc id v)
- v)))
-
-(defn wrap-summary
- [f props]
- (let [sm (summary props)]
- (sm :wrap f)))
+(defn create
+ [{:keys [type name] :as props}]
+ (case type
+ :counter (make-counter props)
+ :gauge (make-gauge props)
+ :summary (make-summary props)))
(defn wrap-counter
- [f props]
- (let [cnt (counter props)]
- (cnt :wrap f)))
+ [rootf mobj]
+ (let [mdata (meta rootf)
+ origf (::original mdata rootf)]
+ (with-meta
+ (fn
+ ([a]
+ (mobj :inc)
+ (origf a))
+ ([a b]
+ (mobj :inc)
+ (origf a b))
+ ([a b & more]
+ (mobj :inc)
+ (apply origf a b more)))
+ (assoc mdata ::original origf))))
-(defn instrument-with-counter!
- [{:keys [var] :as props}]
- (let [cnt (counter props)
- vars (if (var? var) [var] var)]
- (doseq [var vars]
- (alter-var-root var (fn [root]
- (let [mdata (meta root)
- original (::counter-original mdata root)]
- (with-meta
- (cnt :wrap original)
- (assoc mdata ::counter-original original))))))))
+(defn wrap-summary
+ [rootf mobj]
+ (let [mdata (meta rootf)
+ origf (::original mdata rootf)]
+ (with-meta
+ (fn
+ ([a]
+ (with-measure
+ :expr (origf a)
+ :cb #(mobj :observe %)))
+ ([a b]
+ (with-measure
+ :expr (origf a b)
+ :cb #(mobj :observe %)))
+ ([a b & more]
+ (with-measure
+ :expr (apply origf a b more)
+ :cb #(mobj :observe %))))
+ (assoc mdata ::original origf))))
-(defn instrument-with-summary!
- [{:keys [var] :as props}]
- (let [sm (summary props)]
- (alter-var-root var (fn [root]
- (let [mdata (meta root)
- original (::summary-original mdata root)]
- (with-meta
- (sm :wrap original)
- (assoc mdata ::summary-original original)))))))
+(defn instrument-vars!
+ [vars {:keys [wrap] :as props}]
+ (let [obj (create props)]
+ (cond
+ (instance? Counter @obj)
+ (doseq [var vars]
+ (alter-var-root var (or wrap wrap-counter) obj))
-(defn dump
- [& _args]
- (let [samples (.metricFamilySamples ^CollectorRegistry registry)
- writer (StringWriter.)]
- (TextFormat/write004 writer samples)
- {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
- :body (.toString writer)}))
+ (instance? Summary @obj)
+ (doseq [var vars]
+ (alter-var-root var (or wrap wrap-summary) obj))
+ :else
+ (ex/raise :type :not-implemented))))
+
+(defn instrument
+ [f {:keys [wrap] :as props}]
+ (let [obj (create props)]
+ (cond
+ (instance? Counter @obj)
+ ((or wrap wrap-counter) f obj)
+
+ (instance? Summary @obj)
+ ((or wrap wrap-summary) f obj)
+
+ :else
+ (ex/raise :type :not-implemented))))
diff --git a/backend/src/app/migrations.clj b/backend/src/app/migrations.clj
index c1ec7bd66..dabf78275 100644
--- a/backend/src/app/migrations.clj
+++ b/backend/src/app/migrations.clj
@@ -9,12 +9,12 @@
(ns app.migrations
(:require
+ [integrant.core :as ig]
[app.db :as db]
[app.migrations.migration-0023 :as mg0023]
- [app.util.migrations :as mg]
- [mount.core :as mount :refer [defstate]]))
+ [app.util.migrations :as mg]))
-(def +migrations+
+(def main-migrations
{:name "uxbox-main"
:steps
[{:name "0001-add-extensions"
@@ -120,15 +120,14 @@
:fn (mg/resource "app/migrations/sql/0034-mod-profile-table-add-props-field.sql")}
]})
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry point
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defn migrate
- []
- (with-open [conn (db/open)]
+(defmethod ig/init-key ::migrations
+ [_ _]
+ (fn [conn]
(mg/setup! conn)
- (mg/migrate! conn +migrations+)))
+ (mg/migrate! conn main-migrations)))
-(defstate migrations
- :start (migrate))
diff --git a/backend/src/app/services/notifications.clj b/backend/src/app/notifications.clj
similarity index 55%
rename from backend/src/app/services/notifications.clj
rename to backend/src/app/notifications.clj
index 4c2d18e23..347a51ea7 100644
--- a/backend/src/app/services/notifications.clj
+++ b/backend/src/app/notifications.clj
@@ -7,17 +7,81 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.notifications
+(ns app.notifications
"A websocket based notifications mechanism."
(:require
+ [app.common.spec :as us]
[app.db :as db]
[app.metrics :as mtx]
- [app.redis :as redis]
+ [app.redis :as rd]
[app.util.async :as aa]
[app.util.transit :as t]
[clojure.core.async :as a]
+ [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
- [ring.adapter.jetty9 :as jetty]))
+ [integrant.core :as ig]
+ [ring.adapter.jetty9 :as jetty]
+ [ring.middleware.cookies :refer [wrap-cookies]]
+ [ring.middleware.keyword-params :refer [wrap-keyword-params]]
+ [ring.middleware.params :refer [wrap-params]]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Http Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare retrieve-file)
+(declare websocket)
+(declare handler)
+
+(s/def ::session map?)
+
+(defmethod ig/pre-init-spec ::handler [_]
+ (s/keys :req-un [::rd/redis ::db/pool ::session]))
+
+(defmethod ig/init-key ::handler
+ [_ {:keys [session] :as cfg}]
+ (let [wrap-session (:middleware session)]
+ (-> #(handler cfg %)
+ (wrap-session)
+ (wrap-keyword-params)
+ (wrap-cookies)
+ (wrap-params))))
+
+(s/def ::file-id ::us/uuid)
+(s/def ::session-id ::us/uuid)
+
+(s/def ::websocket-handler-params
+ (s/keys :req-un [::file-id ::session-id]))
+
+(defn- handler
+ [{:keys [pool] :as cfg} {:keys [profile-id params] :as req}]
+ (let [params (us/conform ::websocket-handler-params params)
+ file (retrieve-file pool (:file-id params))
+ cfg (merge cfg params
+ {:profile-id profile-id
+ :team-id (:team-id file)})]
+ (cond
+ (not profile-id)
+ {:error {:code 403 :message "Authentication required"}}
+
+ (not file)
+ {:error {:code 404 :message "File does not exists"}}
+
+ :else
+ (websocket cfg))))
+
+(def ^:private
+ sql:retrieve-file
+ "select f.id as id,
+ p.team_id as team_id
+ from file as f
+ join project as p on (p.id = f.project_id)
+ where f.id = ?")
+
+(defn- retrieve-file
+ [conn id]
+ (db/exec-one! conn [sql:retrieve-file id]))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WebSocket Http Handler
@@ -27,24 +91,24 @@
(defrecord WebSocket [conn in out sub])
-(defonce metrics-active-connections
- (mtx/gauge {:id "notificatons__active_connections"
- :help "Active connections to the notifications service."}))
+;; (defonce metrics-active-connections
+;; (mtx/gauge {:id "notificatons__active_connections"
+;; :help "Active connections to the notifications service."}))
-(defonce metrics-message-counter
- (mtx/counter {:id "notificatons__messages_counter"
- :help "A total number of messages handled by the notifications service."}))
+;; (defonce metrics-message-counter
+;; (mtx/counter {:id "notificatons__messages_counter"
+;; :help "A total number of messages handled by the notifications service."}))
(defn websocket
- [{:keys [file-id team-id] :as params}]
+ [{:keys [file-id team-id redis] :as cfg}]
(let [in (a/chan 32)
out (a/chan 32)]
{:on-connect
(fn [conn]
- (metrics-active-connections :inc)
- (let [sub (redis/subscribe {:xform (map t/decode-str)
- :topics [file-id team-id]})
- ws (WebSocket. conn in out sub nil params)]
+ ;; (metrics-active-connections :inc)
+ (let [sub (rd/subscribe redis {:xform (map t/decode-str)
+ :topics [file-id team-id]})
+ ws (WebSocket. conn in out sub nil cfg)]
;; message forwarding loop
(a/go-loop []
@@ -64,13 +128,13 @@
:on-close
(fn [_conn _status _reason]
- (metrics-active-connections :dec)
+ ;; (metrics-active-connections :dec)
(a/close! out)
(a/close! in))
:on-text
(fn [_ws message]
- (metrics-message-counter :inc)
+ ;; (metrics-message-counter :inc)
(let [message (t/decode-str message)]
(a/>!! in message)))
@@ -99,6 +163,7 @@
(loop []
(let [timeout (a/timeout 30000)
[val port] (a/alts! [in sub timeout])]
+
;; (prn "alts" val "from" (cond (= port in) "input"
;; (= port sub) "redis"
;; :else "timeout"))
@@ -126,18 +191,14 @@
:else
nil)))))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Incoming Messages Handling
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; --- Impl
(defn- publish
- [channel message]
+ [redis channel message]
(aa/go-try
(let [message (t/encode-str message)]
- (aa/
+
+(ns app.rpc
+ (:require
+ [app.common.exceptions :as ex]
+ [app.common.data :as d]
+ [app.common.spec :as us]
+ [app.db :as db]
+ [app.metrics :as mtx]
+ [app.util.services :as sv]
+ [clojure.spec.alpha :as s]
+ [clojure.tools.logging :as log]
+ [cuerdas.core :as str]
+ [integrant.core :as ig]))
+
+(defn- default-handler
+ [req]
+ (ex/raise :type :not-found))
+
+(defn- rpc-query-handler
+ [methods {:keys [profile-id] :as request}]
+ (let [type (keyword (get-in request [:path-params :type]))
+ data (assoc (:params request) ::type type)
+ data (if profile-id
+ (assoc data :profile-id profile-id)
+ (dissoc data :profile-id))
+ result ((get methods type default-handler) data)
+ mdata (meta result)]
+
+ (cond->> {:status 200 :body result}
+ (fn? (:transform-response mdata)) ((:transform-response mdata) request))))
+
+(defn- rpc-mutation-handler
+ [methods {:keys [profile-id] :as request}]
+ (let [type (keyword (get-in request [:path-params :type]))
+ data (d/merge (:params request)
+ (:body-params request)
+ (:uploads request))
+ data (if profile-id
+ (assoc data :profile-id profile-id)
+ (dissoc data :profile-id))
+ result ((get methods type default-handler) data)
+ mdata (meta result)]
+ (cond->> {:status 200 :body result}
+ (fn? (:transform-response mdata)) ((:transform-response mdata) request))))
+
+(defn- wrap-impl
+ [f mdata cfg]
+ (let [mreg (get-in cfg [:metrics :registry])
+ mobj (mtx/create
+ {:name (-> (str "rpc_" (::sv/name mdata) "_response_millis")
+ (str/replace "-" "_"))
+ :registry mreg
+ :type :summary
+ :help (str/format "Service '%s' response time in milliseconds." (::sv/name mdata))})
+
+ f (mtx/wrap-summary f mobj)
+
+ spec (or (::sv/spec mdata) (s/spec any?))]
+
+ (log/debugf "Registering '%s' command to rpc service." (::sv/name mdata))
+ (fn [params]
+ (when (and (:auth mdata true) (not (uuid? (:profile-id params))))
+ (ex/raise :type :not-authenticated))
+ (f cfg (us/conform spec params)))))
+
+(defn- process-method
+ [cfg vfn]
+ (let [mdata (meta vfn)]
+ [(keyword (::sv/name mdata))
+ (wrap-impl (deref vfn) mdata cfg)]))
+
+(defn- resolve-query-methods
+ [cfg]
+ (->> (sv/scan-ns 'app.rpc.queries.projects
+ 'app.rpc.queries.files
+ 'app.rpc.queries.teams
+ 'app.rpc.queries.comments
+ 'app.rpc.queries.profile
+ 'app.rpc.queries.recent-files
+ 'app.rpc.queries.viewer)
+ (map (partial process-method cfg))
+ (into {})))
+
+(defn- resolve-mutation-methods
+ [cfg]
+ (->> (sv/scan-ns 'app.rpc.mutations.demo
+ 'app.rpc.mutations.media
+ 'app.rpc.mutations.profile
+ 'app.rpc.mutations.files
+ 'app.rpc.mutations.comments
+ 'app.rpc.mutations.projects
+ 'app.rpc.mutations.viewer
+ 'app.rpc.mutations.verify-token)
+ (map (partial process-method cfg))
+ (into {})))
+
+(s/def ::storage some?)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec ::rpc [_]
+ (s/keys :req-un [::db/pool ::storage ::session ::tokens ::mtx/metrics]))
+
+(defmethod ig/init-key ::rpc
+ [_ cfg]
+ (let [mq (resolve-query-methods cfg)
+ mm (resolve-mutation-methods cfg)]
+ {:methods {:query mq :mutation mm}
+ :query-handler #(rpc-query-handler mq %)
+ :mutation-handler #(rpc-mutation-handler mm %)}))
diff --git a/backend/src/app/services/mutations/comments.clj b/backend/src/app/rpc/mutations/comments.clj
similarity index 88%
rename from backend/src/app/services/mutations/comments.clj
rename to backend/src/app/rpc/mutations/comments.clj
index b30f51081..cfd3876f6 100644
--- a/backend/src/app/services/mutations/comments.clj
+++ b/backend/src/app/rpc/mutations/comments.clj
@@ -7,16 +7,16 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.comments
+(ns app.rpc.mutations.comments
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
- [app.services.mutations :as sm]
- [app.services.queries.comments :as comments]
- [app.services.queries.files :as files]
+ [app.rpc.queries.comments :as comments]
+ [app.rpc.queries.files :as files]
[app.util.blob :as blob]
[app.util.time :as dt]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Mutation: Create Comment Thread
@@ -34,9 +34,9 @@
(s/def ::create-comment-thread
(s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id]))
-(sm/defmutation ::create-comment-thread
- [{:keys [profile-id file-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-comment-thread
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+ (db/with-atomic [conn pool]
(files/check-read-permissions! conn profile-id file-id)
(create-comment-thread conn params)))
@@ -113,9 +113,9 @@
(s/def ::update-comment-thread-status
(s/keys :req-un [::profile-id ::id]))
-(sm/defmutation ::update-comment-thread-status
- [{:keys [profile-id id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-comment-thread-status
+ [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+ (db/with-atomic [conn pool]
(let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not cthr
(ex/raise :type :not-found))
@@ -141,9 +141,9 @@
(s/def ::update-comment-thread
(s/keys :req-un [::profile-id ::id ::is-resolved]))
-(sm/defmutation ::update-comment-thread
- [{:keys [profile-id id is-resolved] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-comment-thread
+ [{:keys [pool] :as cfg} {:keys [profile-id id is-resolved] :as params}]
+ (db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not thread
(ex/raise :type :not-found)
@@ -161,9 +161,9 @@
(s/def ::add-comment
(s/keys :req-un [::profile-id ::thread-id ::content]))
-(sm/defmutation ::add-comment
- [{:keys [profile-id thread-id content] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::add-comment
+ [{:keys [pool] :as cfg} {:keys [profile-id thread-id content] :as params}]
+ (db/with-atomic [conn pool]
(let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true})
(comments/decode-row))
pname (retrieve-page-name conn thread)]
@@ -218,9 +218,9 @@
(s/def ::update-comment
(s/keys :req-un [::profile-id ::id ::content]))
-(sm/defmutation ::update-comment
- [{:keys [profile-id id content] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-comment
+ [{:keys [pool] :as cfg} {:keys [profile-id id content] :as params}]
+ (db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})
_ (when-not comment (ex/raise :type :not-found))
thread (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true})
@@ -251,9 +251,9 @@
(s/def ::delete-comment-thread
(s/keys :req-un [::profile-id ::id]))
-(sm/defmutation ::delete-comment-thread
- [{:keys [profile-id id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-comment-thread
+ [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+ (db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not (= (:owner-id thread) profile-id)
(ex/raise :type :validation
@@ -267,9 +267,9 @@
(s/def ::delete-comment
(s/keys :req-un [::profile-id ::id]))
-(sm/defmutation ::delete-comment
- [{:keys [profile-id id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-comment
+ [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+ (db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})]
(when-not (= (:owner-id comment) profile-id)
(ex/raise :type :validation
diff --git a/backend/src/app/services/mutations/demo.clj b/backend/src/app/rpc/mutations/demo.clj
similarity index 81%
rename from backend/src/app/services/mutations/demo.clj
rename to backend/src/app/rpc/mutations/demo.clj
index 95471c13f..884876d37 100644
--- a/backend/src/app/services/mutations/demo.clj
+++ b/backend/src/app/rpc/mutations/demo.clj
@@ -7,20 +7,23 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.demo
+(ns app.rpc.mutations.demo
"A demo specific mutations."
(:require
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
- [app.services.mutations :as sm]
- [app.services.mutations.profile :as profile]
+ [app.rpc.mutations.profile :as profile]
[app.tasks :as tasks]
+ [app.util.services :as sv]
[buddy.core.codecs :as bc]
- [buddy.core.nonce :as bn]))
+ [buddy.core.nonce :as bn]
+ [clojure.spec.alpha :as s]))
-(sm/defmutation ::create-demo-profile
- [_]
+(s/def ::create-demo-profile any?)
+
+(sv/defmethod ::create-demo-profile {:auth false}
+ [{:keys [pool] :as cfg} _]
(let [id (uuid/next)
sem (System/currentTimeMillis)
email (str "demo-" sem ".demo@nodomain.com")
@@ -33,7 +36,7 @@
:fullname fullname
:demo? true
:password password}]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(->> (#'profile/create-profile conn params)
(#'profile/create-profile-relations conn))
diff --git a/backend/src/app/services/mutations/files.clj b/backend/src/app/rpc/mutations/files.clj
similarity index 84%
rename from backend/src/app/services/mutations/files.clj
rename to backend/src/app/rpc/mutations/files.clj
index b428daa9f..0ccc65c05 100644
--- a/backend/src/app/services/mutations/files.clj
+++ b/backend/src/app/rpc/mutations/files.clj
@@ -7,7 +7,7 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.files
+(ns app.rpc.mutations.files
(:require
[app.common.exceptions :as ex]
[app.common.pages :as cp]
@@ -16,12 +16,12 @@
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
- [app.redis :as redis]
- [app.services.mutations :as sm]
- [app.services.queries.files :as files]
- [app.services.queries.projects :as proj]
+ [app.redis :as rd]
+ [app.rpc.queries.files :as files]
+ [app.rpc.queries.projects :as proj]
[app.tasks :as tasks]
[app.util.blob :as blob]
+ [app.util.services :as sv]
[app.util.time :as dt]
[app.util.transit :as t]
[clojure.spec.alpha :as s]))
@@ -43,9 +43,9 @@
(s/keys :req-un [::profile-id ::name ::project-id]
:opt-un [::id ::is-shared]))
-(sm/defmutation ::create-file
- [{:keys [profile-id project-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-file
+ [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+ (db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id project-id)
(create-file conn params)))
@@ -82,9 +82,9 @@
(s/def ::rename-file
(s/keys :req-un [::profile-id ::name ::id]))
-(sm/defmutation ::rename-file
- [{:keys [id profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::rename-file
+ [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)
(rename-file conn params)))
@@ -102,9 +102,9 @@
(s/def ::set-file-shared
(s/keys :req-un [::profile-id ::id ::is-shared]))
-(sm/defmutation ::set-file-shared
- [{:keys [id profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::set-file-shared
+ [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)
(set-file-shared conn params)))
@@ -122,9 +122,9 @@
(s/def ::delete-file
(s/keys :req-un [::id ::profile-id]))
-(sm/defmutation ::delete-file
- [{:keys [id profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-file
+ [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)
;; Schedule object deletion
@@ -149,13 +149,13 @@
(s/def ::link-file-to-library
(s/keys :req-un [::profile-id ::file-id ::library-id]))
-(sm/defmutation ::link-file-to-library
- [{:keys [profile-id file-id library-id] :as params}]
+(sv/defmethod ::link-file-to-library
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
(when (= file-id library-id)
(ex/raise :type :validation
:code :invalid-library
:hint "A file cannot be linked to itself"))
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
(link-file-to-library conn params)))
@@ -176,9 +176,9 @@
(s/def ::unlink-file-from-library
(s/keys :req-un [::profile-id ::file-id ::library-id]))
-(sm/defmutation ::unlink-file-from-library
- [{:keys [profile-id file-id library-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::unlink-file-from-library
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
(unlink-file-from-library conn params)))
@@ -196,9 +196,9 @@
(s/def ::update-sync
(s/keys :req-un [::profile-id ::file-id ::library-id]))
-(sm/defmutation ::update-sync
- [{:keys [profile-id file-id library-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-sync
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
(update-sync conn params)))
@@ -217,9 +217,9 @@
(s/def ::ignore-sync
(s/keys :req-un [::profile-id ::file-id ::date]))
-(sm/defmutation ::ignore-sync
- [{:keys [profile-id file-id date] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::ignore-sync
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id date] :as params}]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
(ignore-sync conn params)))
@@ -256,15 +256,15 @@
(declare retrieve-lagged-changes)
(declare insert-change)
-(sm/defmutation ::update-file
- [{:keys [id profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-file
+ [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+ (db/with-atomic [conn pool]
(let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-update true})]
(files/check-edition-permissions! conn profile-id id)
- (update-file conn file params))))
+ (update-file (assoc cfg :conn conn) file params))))
(defn- update-file
- [conn file params]
+ [{:keys [conn redis]} file params]
(when (> (:revn params)
(:revn file))
(ex/raise :type :validation
@@ -294,8 +294,8 @@
library-changes (filter library-change? changes)]
- @(redis/run! :publish {:channel (str (:id file))
- :message (t/encode-str msg)})
+ @(rd/run! redis :publish {:channel (str (:id file))
+ :message (t/encode-str msg)})
(when (and (:is-shared file) (seq library-changes))
(let [{:keys [team-id] :as project}
@@ -309,8 +309,8 @@
:modified-at (dt/now)
:changes library-changes}]
- @(redis/run! :publish {:channel (str team-id)
- :message (t/encode-str msg)})))
+ @(rd/run! redis :publish {:channel (str team-id)
+ :message (t/encode-str msg)})))
(db/update! conn :file
{:revn (:revn file)
diff --git a/backend/src/app/services/mutations/media.clj b/backend/src/app/rpc/mutations/media.clj
similarity index 80%
rename from backend/src/app/services/mutations/media.clj
rename to backend/src/app/rpc/mutations/media.clj
index f1812b7fe..f32645921 100644
--- a/backend/src/app/services/mutations/media.clj
+++ b/backend/src/app/rpc/mutations/media.clj
@@ -7,7 +7,7 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.media
+(ns app.rpc.mutations.media
(:require
[app.common.exceptions :as ex]
[app.common.media :as cm]
@@ -15,10 +15,9 @@
[app.common.uuid :as uuid]
[app.db :as db]
[app.media :as media]
- [app.media-storage :as mst]
- [app.services.mutations :as sm]
- [app.services.queries.teams :as teams]
+ [app.rpc.queries.teams :as teams]
[app.util.storage :as ust]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]
[datoteka.core :as fs]))
@@ -53,34 +52,36 @@
(s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content]
:opt-un [::id]))
-(sm/defmutation ::add-media-object-from-url
- [{:keys [profile-id file-id url name] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::add-media-object-from-url
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id url name] :as params}]
+ (db/with-atomic [conn pool]
(let [file (select-file-for-update conn file-id)]
(teams/check-edition-permissions! conn profile-id (:team-id file))
(let [content (media/download-media-object url)
+ cfg (assoc cfg :conn conn)
params' (merge params {:content content
:name (or name (:filename content))})]
- (create-media-object conn params')))))
+ (create-media-object cfg params')))))
-(sm/defmutation ::upload-media-object
- [{:keys [profile-id file-id] :as params}]
- (db/with-atomic [conn db/pool]
- (let [file (select-file-for-update conn file-id)]
+(sv/defmethod ::upload-media-object
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+ (db/with-atomic [conn pool]
+ (let [file (select-file-for-update conn file-id)
+ cfg (assoc cfg :conn conn)]
(teams/check-edition-permissions! conn profile-id (:team-id file))
- (create-media-object conn params))))
+ (create-media-object cfg params))))
(defn create-media-object
- [conn {:keys [id file-id is-local name content]}]
+ [{:keys [conn] :as cfg} {:keys [id file-id is-local name content]}]
(media/validate-media-type (:content-type content))
(let [info (media/run {:cmd :info :input {:path (:tempfile content)
:mtype (:content-type content)}})
- path (persist-media-object-on-fs content)
+ path (persist-media-object-on-fs cfg content)
opts (assoc thumbnail-options
:input {:mtype (:mtype info)
:path path})
thumb (if-not (= (:mtype info) "image/svg+xml")
- (persist-media-thumbnail-on-fs opts)
+ (persist-media-thumbnail-on-fs cfg opts)
(assoc info
:path path
:quality 0))
@@ -123,13 +124,13 @@
row))
(defn persist-media-object-on-fs
- [{:keys [filename tempfile]}]
+ [{:keys [storage]} {:keys [filename tempfile]}]
(let [filename (fs/name filename)]
- (ust/save! mst/media-storage filename tempfile)))
+ (ust/save! storage filename tempfile)))
(defn persist-media-thumbnail-on-fs
- [{:keys [input] :as params}]
- (let [path (ust/lookup mst/media-storage (:path input))
+ [{:keys [storage]} {:keys [input] :as params}]
+ (let [path (ust/lookup storage (:path input))
thumb (media/run
(-> params
(assoc :cmd :generic-thumbnail)
@@ -138,7 +139,7 @@
name (str "thumbnail-"
(first (fs/split-ext (fs/name (:path input))))
(cm/format->extension (:format thumb)))
- path (ust/save! mst/media-storage name (:data thumb))]
+ path (ust/save! storage name (:data thumb))]
(-> thumb
(dissoc :data :input)
diff --git a/backend/src/app/services/mutations/profile.clj b/backend/src/app/rpc/mutations/profile.clj
similarity index 82%
rename from backend/src/app/services/mutations/profile.clj
rename to backend/src/app/rpc/mutations/profile.clj
index 01f11d69c..b18cf8111 100644
--- a/backend/src/app/services/mutations/profile.clj
+++ b/backend/src/app/rpc/mutations/profile.clj
@@ -7,7 +7,7 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.profile
+(ns app.rpc.mutations.profile
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
@@ -17,12 +17,11 @@
[app.emails :as emails]
[app.http.session :as session]
[app.media :as media]
- [app.services.mutations :as sm]
- [app.services.mutations.projects :as projects]
- [app.services.mutations.teams :as teams]
- [app.services.mutations.verify-token :refer [process-token]]
- [app.services.queries.profile :as profile]
- [app.services.tokens :as tokens]
+ [app.rpc.mutations.projects :as projects]
+ [app.rpc.mutations.teams :as teams]
+ [app.rpc.mutations.verify-token :refer [process-token]]
+ [app.rpc.queries.profile :as profile]
+ [app.util.services :as sv]
[app.tasks :as tasks]
[app.util.time :as dt]
[buddy.hashers :as hashers]
@@ -53,8 +52,8 @@
(s/keys :req-un [::email ::password ::fullname]
:opt-un [::token]))
-(sm/defmutation ::register-profile
- [{:keys [token] :as params}]
+(sv/defmethod ::register-profile {:auth false}
+ [{:keys [pool tokens session] :as cfg} {:keys [token] :as params}]
(when-not (:registration-enabled cfg/config)
(ex/raise :type :restriction
:code :registration-disabled))
@@ -64,7 +63,7 @@
(ex/raise :type :validation
:code :email-domain-is-not-allowed))
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(check-profile-existence! conn params)
(let [profile (->> (create-profile conn params)
(create-profile-relations conn))]
@@ -74,7 +73,7 @@
;; from team-invitation process; in this case we revalidate
;; the token and process the token claims again with the new
;; profile data.
- (let [claims (tokens/verify token {:iss :team-invitation})
+ (let [claims (tokens :verify {:token token :iss :team-invitation})
claims (assoc claims :member-id (:id profile))
params (assoc params :profile-id (:id profile))]
(process-token conn params claims)
@@ -94,16 +93,17 @@
{:transform-response
(fn [request response]
(let [uagent (get-in request [:headers "user-agent"])
- id (session/create (:id profile) uagent)]
+ id (session/create! session {:profile-id (:id profile)
+ :user-agent uagent})]
(assoc response
- :cookies (session/cookies id))))}))
+ :cookies (session/cookies session {:value id}))))}))
;; If no token is provided, send a verification email
- (let [token (tokens/generate
- {:iss :verify-email
- :exp (dt/in-future "48h")
- :profile-id (:id profile)
- :email (:email profile)})]
+ (let [token (tokens :generate
+ {:iss :verify-email
+ :exp (dt/in-future "48h")
+ :profile-id (:id profile)
+ :email (:email profile)})]
(emails/send! conn emails/register
{:to (:email profile)
@@ -198,8 +198,8 @@
(s/keys :req-un [::email ::password]
:opt-un [::scope]))
-(sm/defmutation ::login
- [{:keys [email password scope] :as params}]
+(sv/defmethod ::login {:auth false}
+ [{:keys [pool] :as cfg} {:keys [email password scope] :as params}]
(letfn [(check-password [profile password]
(when (= (:password profile) "!")
(ex/raise :type :validation
@@ -218,7 +218,7 @@
:code :wrong-credentials))
profile)]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(let [prof (-> (profile/retrieve-profile-data-by-email conn email)
(validate-profile)
(profile/strip-private-attrs))
@@ -228,8 +228,8 @@
;; --- Mutation: Register if not exists
-(sm/defmutation ::login-or-register
- [{:keys [email fullname] :as params}]
+(sv/defmethod ::login-or-register
+ [{:keys [pool] :as cfg} {:keys [email fullname] :as params}]
(letfn [(populate-additional-data [conn profile]
(let [data (profile/retrieve-additional-data conn (:id profile))]
(merge profile data)))
@@ -248,7 +248,7 @@
(->> (create-profile conn params)
(create-profile-relations conn)))]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(let [profile (profile/retrieve-profile-data-by-email conn email)
profile (if profile
(populate-additional-data conn profile)
@@ -269,9 +269,9 @@
(s/def ::update-profile
(s/keys :req-un [::id ::fullname ::lang ::theme]))
-(sm/defmutation ::update-profile
- [params]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-profile
+ [{:keys [pool] :as cfg} params]
+ (db/with-atomic [conn pool]
(update-profile conn params)
nil))
@@ -288,9 +288,9 @@
(s/def ::update-profile-password
(s/keys :req-un [::profile-id ::password ::old-password]))
-(sm/defmutation ::update-profile-password
- [{:keys [password profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-profile-password
+ [{:keys [pool] :as cfg} {:keys [password profile-id] :as params}]
+ (db/with-atomic [conn pool]
(validate-password! conn params)
(db/update! conn :profile
{:password (derive-password password)}
@@ -306,14 +306,14 @@
(s/def ::update-profile-photo
(s/keys :req-un [::profile-id ::file]))
-(sm/defmutation ::update-profile-photo
- [{:keys [profile-id file] :as params}]
+(sv/defmethod ::update-profile-photo
+ [{:keys [pool] :as cfg} {:keys [profile-id file] :as params}]
(media/validate-media-type (:content-type file))
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(let [profile (db/get-by-id conn :profile profile-id)
_ (media/run {:cmd :info :input {:path (:tempfile file)
:mtype (:content-type file)}})
- photo (teams/upload-photo conn params)]
+ photo (teams/upload-photo cfg params)]
;; Schedule deletion of old photo
(when (and (string? (:photo profile))
@@ -335,16 +335,16 @@
(s/def ::request-email-change
(s/keys :req-un [::email]))
-(sm/defmutation ::request-email-change
- [{:keys [profile-id email] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::request-email-change
+ [{:keys [pool tokens] :as cfg} {:keys [profile-id email] :as params}]
+ (db/with-atomic [conn pool]
(let [email (str/lower email)
profile (db/get-by-id conn :profile profile-id)
- token (tokens/generate
- {:iss :change-email
- :exp (dt/in-future "15m")
- :profile-id profile-id
- :email email})]
+ token (tokens :generate
+ {:iss :change-email
+ :exp (dt/in-future "15m")
+ :profile-id profile-id
+ :email email})]
(when (not= email (:email profile))
(check-profile-existence! conn params))
@@ -365,13 +365,13 @@
(s/def ::request-profile-recovery
(s/keys :req-un [::email]))
-(sm/defmutation ::request-profile-recovery
- [{:keys [email] :as params}]
+(sv/defmethod ::request-profile-recovery {:auth false}
+ [{:keys [pool tokens] :as cfg} {:keys [email] :as params}]
(letfn [(create-recovery-token [{:keys [id] :as profile}]
- (let [token (tokens/generate
- {:iss :password-recovery
- :exp (dt/in-future "15m")
- :profile-id id})]
+ (let [token (tokens :generate
+ {:iss :password-recovery
+ :exp (dt/in-future "15m")
+ :profile-id id})]
(assoc profile :token token)))
(send-email-notification [conn profile]
@@ -380,7 +380,7 @@
:token (:token profile)
:name (:fullname profile)}))]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(some->> email
(profile/retrieve-profile-data-by-email conn)
(create-recovery-token)
@@ -394,17 +394,17 @@
(s/def ::recover-profile
(s/keys :req-un [::token ::password]))
-(sm/defmutation ::recover-profile
- [{:keys [token password]}]
+(sv/defmethod ::recover-profile {:auth false}
+ [{:keys [pool tokens] :as cfg} {:keys [token password]}]
(letfn [(validate-token [token]
- (let [tdata (tokens/verify token {:iss :password-recovery})]
+ (let [tdata (tokens :verify {:token token :iss :password-recovery})]
(:profile-id tdata)))
(update-password [conn profile-id]
(let [pwd (derive-password password)]
(db/update! conn :profile {:password pwd} {:id profile-id})))]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(->> (validate-token token)
(update-password conn))
nil)))
@@ -415,9 +415,9 @@
(s/def ::update-profile-props
(s/keys :req-un [::profile-id ::props]))
-(sm/defmutation ::update-profile-props
- [{:keys [profile-id props]}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-profile-props
+ [{:keys [pool] :as cfg} {:keys [profile-id props]}]
+ (db/with-atomic [conn pool]
(let [profile (profile/retrieve-profile-data conn profile-id)
props (reduce-kv (fn [props k v]
(if (nil? v)
@@ -439,9 +439,9 @@
(s/def ::delete-profile
(s/keys :req-un [::profile-id]))
-(sm/defmutation ::delete-profile
- [{:keys [profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-profile
+ [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
+ (db/with-atomic [conn pool]
(check-teams-ownership! conn profile-id)
;; Schedule a complete deletion of profile
@@ -456,10 +456,9 @@
(with-meta {}
{:transform-response
(fn [request response]
- (some-> (session/extract-auth-token request)
- (session/delete))
+ (session/delete! session request)
(assoc response
- :cookies (session/cookies "" {:max-age -1})))})))
+ :cookies (session/cookies session {:value "" :max-age -1})))})))
(def ^:private sql:teams-ownership-check
"with teams as (
diff --git a/backend/src/app/services/mutations/projects.clj b/backend/src/app/rpc/mutations/projects.clj
similarity index 85%
rename from backend/src/app/services/mutations/projects.clj
rename to backend/src/app/rpc/mutations/projects.clj
index 211da4300..766cbdcb5 100644
--- a/backend/src/app/services/mutations/projects.clj
+++ b/backend/src/app/rpc/mutations/projects.clj
@@ -7,15 +7,15 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.projects
+(ns app.rpc.mutations.projects
(:require
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
- [app.services.mutations :as sm]
- [app.services.queries.projects :as proj]
+ [app.rpc.queries.projects :as proj]
[app.tasks :as tasks]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Helpers & Specs
@@ -36,9 +36,9 @@
(s/keys :req-un [::profile-id ::team-id ::name]
:opt-un [::id]))
-(sm/defmutation ::create-project
- [params]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-project
+ [{:keys [pool] :as cfg} params]
+ (db/with-atomic [conn pool]
(let [proj (create-project conn params)
params (assoc params :project-id (:id proj))]
(create-project-profile conn params)
@@ -88,9 +88,9 @@
(s/def ::update-project-pin
(s/keys :req-un [::profile-id ::id ::team-id ::is-pinned]))
-(sm/defmutation ::update-project-pin
- [{:keys [id profile-id team-id is-pinned] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-project-pin
+ [{:keys [pool] :as cfg} {:keys [id profile-id team-id is-pinned] :as params}]
+ (db/with-atomic [conn pool]
(db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
nil))
@@ -102,9 +102,9 @@
(s/def ::rename-project
(s/keys :req-un [::profile-id ::name ::id]))
-(sm/defmutation ::rename-project
- [{:keys [id profile-id name] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::rename-project
+ [{:keys [pool] :as cfg} {:keys [id profile-id name] :as params}]
+ (db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id id)
(db/update! conn :project
{:name name}
@@ -117,9 +117,9 @@
(s/def ::delete-project
(s/keys :req-un [::id ::profile-id]))
-(sm/defmutation ::delete-project
- [{:keys [id profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-project
+ [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+ (db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id id)
;; Schedule object deletion
diff --git a/backend/src/app/services/mutations/teams.clj b/backend/src/app/rpc/mutations/teams.clj
similarity index 83%
rename from backend/src/app/services/mutations/teams.clj
rename to backend/src/app/rpc/mutations/teams.clj
index a7ecdf09c..8ab159e11 100644
--- a/backend/src/app/services/mutations/teams.clj
+++ b/backend/src/app/rpc/mutations/teams.clj
@@ -7,7 +7,7 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.teams
+(ns app.rpc.mutations.teams
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
@@ -18,11 +18,10 @@
[app.emails :as emails]
[app.media :as media]
[app.media-storage :as mst]
- [app.services.mutations :as sm]
- [app.services.mutations.projects :as projects]
- [app.services.queries.profile :as profile]
- [app.services.queries.teams :as teams]
- [app.services.tokens :as tokens]
+ [app.rpc.mutations.projects :as projects]
+ [app.rpc.queries.profile :as profile]
+ [app.rpc.queries.teams :as teams]
+ [app.util.services :as sv]
[app.tasks :as tasks]
[app.util.storage :as ust]
[app.util.time :as dt]
@@ -48,9 +47,9 @@
(s/keys :req-un [::profile-id ::name]
:opt-un [::id]))
-(sm/defmutation ::create-team
- [params]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-team
+ [{:keys [pool] :as cfg} params]
+ (db/with-atomic [conn pool]
(let [team (create-team conn params)
params (assoc params :team-id (:id team))]
(create-team-profile conn params)
@@ -90,9 +89,9 @@
(s/def ::update-team
(s/keys :req-un [::profile-id ::name ::id]))
-(sm/defmutation ::update-team
- [{:keys [id name profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-team
+ [{:keys [pool] :as cfg} {:keys [id name profile-id] :as params}]
+ (db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id id)
(db/update! conn :team
{:name name}
@@ -105,9 +104,9 @@
(s/def ::leave-team
(s/keys :req-un [::profile-id ::id]))
-(sm/defmutation ::leave-team
- [{:keys [id profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::leave-team
+ [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+ (db/with-atomic [conn pool]
(let [perms (teams/check-read-permissions! conn profile-id id)
members (teams/retrieve-team-members conn id)]
@@ -133,9 +132,9 @@
(s/def ::delete-team
(s/keys :req-un [::profile-id ::id]))
-(sm/defmutation ::delete-team
- [{:keys [id profile-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-team
+ [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+ (db/with-atomic [conn pool]
(let [perms (teams/check-edition-permissions! conn profile-id id)]
(when-not (:is-owner perms)
(ex/raise :type :validation
@@ -156,9 +155,9 @@
(s/def ::update-team-member-role
(s/keys :req-un [::profile-id ::team-id ::member-id ::role]))
-(sm/defmutation ::update-team-member-role
- [{:keys [team-id profile-id member-id role] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-team-member-role
+ [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id role] :as params}]
+ (db/with-atomic [conn pool]
(let [perms (teams/check-read-permissions! conn profile-id team-id)
;; We retrieve all team members instead of query the
@@ -218,9 +217,9 @@
(s/def ::delete-team-member
(s/keys :req-un [::profile-id ::team-id ::member-id]))
-(sm/defmutation ::delete-team-member
- [{:keys [team-id profile-id member-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-team-member
+ [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
+ (db/with-atomic [conn pool]
(let [perms (teams/check-read-permissions! conn profile-id team-id)]
(when-not (or (:is-owner perms)
(:is-admin perms))
@@ -245,15 +244,16 @@
(s/def ::update-team-photo
(s/keys :req-un [::profile-id ::team-id ::file]))
-(sm/defmutation ::update-team-photo
- [{:keys [profile-id file team-id] :as params}]
+(sv/defmethod ::update-team-photo
+ [{:keys [pool] :as cfg} {:keys [profile-id file team-id] :as params}]
(media/validate-media-type (:content-type file))
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(let [team (teams/retrieve-team conn profile-id team-id)
_ (media/run {:cmd :info :input {:path (:tempfile file)
:mtype (:content-type file)}})
- photo (upload-photo conn params)]
+ cfg (assoc cfg :conn conn)
+ photo (upload-photo cfg params)]
;; Schedule deletion of old photo
(when (and (string? (:photo team))
@@ -268,7 +268,7 @@
(assoc team :photo (str photo)))))
(defn upload-photo
- [_conn {:keys [file]}]
+ [{:keys [storage]} {:keys [file]}]
(let [prefix (-> (bn/random-bytes 8)
(bc/bytes->b64u)
(bc/bytes->str))
@@ -281,7 +281,7 @@
:input {:path (fs/path (:tempfile file))
:mtype (:content-type file)}})
name (str prefix (cm/format->extension (:format thumb)))]
- (ust/save! mst/media-storage name (:data thumb))))
+ (ust/save! storage name (:data thumb))))
;; --- Mutation: Invite Member
@@ -290,21 +290,21 @@
(s/def ::invite-team-member
(s/keys :req-un [::profile-id ::team-id ::email ::role]))
-(sm/defmutation ::invite-team-member
- [{:keys [profile-id team-id email role] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::invite-team-member
+ [{:keys [pool tokens] :as cfg} {:keys [profile-id team-id email role] :as params}]
+ (db/with-atomic [conn pool]
(let [perms (teams/check-edition-permissions! conn profile-id team-id)
profile (db/get-by-id conn :profile profile-id)
member (profile/retrieve-profile-data-by-email conn email)
team (db/get-by-id conn :team team-id)
- token (tokens/generate
- {:iss :team-invitation
- :exp (dt/in-future "24h")
- :profile-id (:id profile)
- :role role
- :team-id team-id
- :member-email (:email member email)
- :member-id (:id member)})]
+ token (tokens :generate
+ {:iss :team-invitation
+ :exp (dt/in-future "24h")
+ :profile-id (:id profile)
+ :role role
+ :team-id team-id
+ :member-email (:email member email)
+ :member-id (:id member)})]
(when-not (:is-admin perms)
(ex/raise :type :validation
diff --git a/backend/src/app/services/mutations/verify_token.clj b/backend/src/app/rpc/mutations/verify_token.clj
similarity index 80%
rename from backend/src/app/services/mutations/verify_token.clj
rename to backend/src/app/rpc/mutations/verify_token.clj
index 87dda705a..18d9190d0 100644
--- a/backend/src/app/services/mutations/verify_token.clj
+++ b/backend/src/app/rpc/mutations/verify_token.clj
@@ -7,16 +7,17 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.verify-token
+;; TODO: session
+
+(ns app.rpc.mutations.verify-token
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
[app.http.session :as session]
- [app.services.mutations :as sm]
- [app.services.mutations.teams :as teams]
- [app.services.queries.profile :as profile]
- [app.services.tokens :as tokens]
+ [app.rpc.mutations.teams :as teams]
+ [app.rpc.queries.profile :as profile]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]))
(defmulti process-token (fn [_ _ claims] (:iss claims)))
@@ -25,14 +26,15 @@
(s/keys :req-un [::token]
:opt-un [::profile-id]))
-(sm/defmutation ::verify-token
- [{:keys [token] :as params}]
- (db/with-atomic [conn db/pool]
- (let [claims (tokens/verify token)]
- (process-token conn params claims))))
+(sv/defmethod ::verify-token {:auth false}
+ [{:keys [pool tokens] :as cfg} {:keys [token] :as params}]
+ (db/with-atomic [conn pool]
+ (let [claims (tokens :verify {:token token})
+ cfg (assoc cfg :conn conn)]
+ (process-token cfg params claims))))
(defmethod process-token :change-email
- [conn _params {:keys [profile-id email] :as claims}]
+ [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
(when (profile/retrieve-profile-data-by-email conn email)
(ex/raise :type :validation
:code :email-already-exists))
@@ -42,7 +44,7 @@
claims)
(defmethod process-token :verify-email
- [conn _params {:keys [profile-id] :as claims}]
+ [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
(let [profile (db/get-by-id conn :profile profile-id {:for-update true})]
(when (:is-active profile)
(ex/raise :type :validation
@@ -58,7 +60,7 @@
claims))
(defmethod process-token :auth
- [conn _params {:keys [profile-id] :as claims}]
+ [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
(let [profile (profile/retrieve-profile conn profile-id)]
(assoc claims :profile profile)))
@@ -83,7 +85,7 @@
:opt-un [:internal.tokens.team-invitation/member-id]))
(defmethod process-token :team-invitation
- [conn {:keys [profile-id token]} {:keys [member-id team-id role] :as claims}]
+ [{:keys [conn session] :as cfg} {:keys [profile-id token]} {:keys [member-id team-id role] :as claims}]
(us/assert ::team-invitation-claims claims)
(if (uuid? member-id)
(let [params (merge {:team-id team-id
@@ -107,9 +109,10 @@
{:transform-response
(fn [request response]
(let [uagent (get-in request [:headers "user-agent"])
- id (session/create member-id uagent)]
+ id (session/create! session {:profile-id member-id
+ :user-agent uagent})]
(assoc response
- :cookies (session/cookies id))))})))
+ :cookies (session/cookies session {:value id}))))})))
;; In this case, we waint until frontend app redirect user to
;; registeration page, the user is correctly registered and the
diff --git a/backend/src/app/services/mutations/viewer.clj b/backend/src/app/rpc/mutations/viewer.clj
similarity index 78%
rename from backend/src/app/services/mutations/viewer.clj
rename to backend/src/app/rpc/mutations/viewer.clj
index 82ebb17b1..85d3aa245 100644
--- a/backend/src/app/services/mutations/viewer.clj
+++ b/backend/src/app/rpc/mutations/viewer.clj
@@ -7,12 +7,12 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.mutations.viewer
+(ns app.rpc.mutations.viewer
(:require
[app.common.spec :as us]
[app.db :as db]
- [app.services.mutations :as sm]
- [app.services.queries.files :as files]
+ [app.rpc.queries.files :as files]
+ [app.util.services :as sv]
[buddy.core.codecs :as bc]
[buddy.core.nonce :as bn]
[clojure.spec.alpha :as s]))
@@ -24,9 +24,9 @@
(s/def ::create-file-share-token
(s/keys :req-un [::profile-id ::file-id ::page-id]))
-(sm/defmutation ::create-file-share-token
- [{:keys [profile-id file-id page-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-file-share-token
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id] :as params}]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
(let [token (-> (bn/random-bytes 16)
(bc/bytes->b64u)
@@ -42,9 +42,9 @@
(s/def ::delete-file-share-token
(s/keys :req-un [::profile-id ::file-id ::token]))
-(sm/defmutation ::delete-file-share-token
- [{:keys [profile-id file-id token]}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-file-share-token
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id token]}]
+ (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
(db/delete! conn :file-share-token
{:file-id file-id
diff --git a/backend/src/app/services/queries/comments.clj b/backend/src/app/rpc/queries/comments.clj
similarity index 87%
rename from backend/src/app/services/queries/comments.clj
rename to backend/src/app/rpc/queries/comments.clj
index 740adc393..56a3a8f19 100644
--- a/backend/src/app/services/queries/comments.clj
+++ b/backend/src/app/rpc/queries/comments.clj
@@ -7,13 +7,13 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.queries.comments
+(ns app.rpc.queries.comments
(:require
[app.common.spec :as us]
[app.db :as db]
- [app.services.queries :as sq]
- [app.services.queries.files :as files]
- [app.services.queries.teams :as teams]
+ [app.rpc.queries.files :as files]
+ [app.rpc.queries.teams :as teams]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]))
(defn decode-row
@@ -34,9 +34,9 @@
:opt-un [::file-id ::team-id])
#(or (:file-id %) (:team-id %))))
-(sq/defquery ::comment-threads
- [{:keys [profile-id file-id] :as params}]
- (with-open [conn (db/open)]
+(sv/defmethod ::comment-threads
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+ (with-open [conn (db/open pool)]
(files/check-read-permissions! conn profile-id file-id)
(retrieve-comment-threads conn params)))
@@ -77,9 +77,9 @@
(s/def ::unread-comment-threads
(s/keys :req-un [::profile-id ::team-id]))
-(sq/defquery ::unread-comment-threads
- [{:keys [profile-id team-id] :as params}]
- (with-open [conn (db/open)]
+(sv/defmethod ::unread-comment-threads
+ [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+ (with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(retrieve-unread-comment-threads conn params)))
@@ -122,9 +122,9 @@
(s/def ::comment-thread
(s/keys :req-un [::profile-id ::file-id ::id]))
-(sq/defquery ::comment-thread
- [{:keys [profile-id file-id id] :as params}]
- (with-open [conn (db/open)]
+(sv/defmethod ::comment-thread
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id id] :as params}]
+ (with-open [conn (db/open pool)]
(files/check-read-permissions! conn profile-id file-id)
(let [sql (str "with threads as (" sql:comment-threads ")"
"select * from threads where id = ?")]
@@ -141,9 +141,9 @@
(s/def ::comments
(s/keys :req-un [::profile-id ::thread-id]))
-(sq/defquery ::comments
- [{:keys [profile-id thread-id] :as params}]
- (with-open [conn (db/open)]
+(sv/defmethod ::comments
+ [{:keys [pool] :as cfg} {:keys [profile-id thread-id] :as params}]
+ (with-open [conn (db/open pool)]
(let [thread (db/get-by-id conn :comment-thread thread-id)]
(files/check-read-permissions! conn profile-id (:file-id thread))
(retrieve-comments conn thread-id))))
diff --git a/backend/src/app/services/queries/files.clj b/backend/src/app/rpc/queries/files.clj
similarity index 87%
rename from backend/src/app/services/queries/files.clj
rename to backend/src/app/rpc/queries/files.clj
index 82393375e..fca4e92eb 100644
--- a/backend/src/app/services/queries/files.clj
+++ b/backend/src/app/rpc/queries/files.clj
@@ -7,14 +7,14 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.queries.files
+(ns app.rpc.queries.files
(:require
[app.common.exceptions :as ex]
[app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.db :as db]
- [app.services.queries :as sq]
- [app.services.queries.projects :as projects]
+ [app.rpc.queries.projects :as projects]
+ [app.util.services :as sv]
[app.util.blob :as blob]
[clojure.spec.alpha :as s]))
@@ -127,9 +127,9 @@
(s/def ::search-files
(s/keys :req-un [::profile-id ::team-id ::search-term]))
-(sq/defquery ::search-files
- [{:keys [profile-id team-id search-term] :as params}]
- (let [rows (db/exec! db/pool [sql:search-files
+(sv/defmethod ::search-files
+ [{:keys [pool] :as cfg} {:keys [profile-id team-id search-term] :as params}]
+ (let [rows (db/exec! pool [sql:search-files
profile-id team-id
profile-id team-id
search-term])]
@@ -149,9 +149,9 @@
(s/def ::files
(s/keys :req-un [::profile-id ::project-id]))
-(sq/defquery ::files
- [{:keys [profile-id project-id] :as params}]
- (with-open [conn (db/open)]
+(sv/defmethod ::files
+ [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+ (with-open [conn (db/open pool)]
(projects/check-read-permissions! conn profile-id project-id)
(into [] decode-row-xf (db/exec! conn [sql:files project-id]))))
@@ -167,18 +167,18 @@
(s/def ::file
(s/keys :req-un [::profile-id ::id]))
-(sq/defquery ::file
- [{:keys [profile-id id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::file
+ [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+ (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id id)
(retrieve-file conn id)))
(s/def ::page
(s/keys :req-un [::profile-id ::id ::file-id]))
-(sq/defquery ::page
- [{:keys [profile-id file-id id]}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::page
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id id]}]
+ (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id)
(let [file (retrieve-file conn file-id)]
(get-in file [:data :pages-index id]))))
@@ -199,9 +199,9 @@
(s/def ::shared-files
(s/keys :req-un [::profile-id ::team-id]))
-(sq/defquery ::shared-files
- [{:keys [profile-id team-id] :as params}]
- (into [] decode-row-xf (db/exec! db/pool [sql:shared-files team-id])))
+(sv/defmethod ::shared-files
+ [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+ (into [] decode-row-xf (db/exec! pool [sql:shared-files team-id])))
;; --- Query: File Libraries used by a File
@@ -237,9 +237,9 @@
(s/def ::file-libraries
(s/keys :req-un [::profile-id ::file-id]))
-(sq/defquery ::file-libraries
- [{:keys [profile-id file-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::file-libraries
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+ (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id)
(retrieve-file-libraries conn false file-id)))
@@ -263,9 +263,9 @@
(s/def ::file-library
(s/keys :req-un [::profile-id ::file-id]))
-(sq/defquery ::file-library
- [{:keys [profile-id file-id] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::file-library
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+ (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id) ;; TODO: this should check read permissions
(retrieve-file-library conn file-id)))
diff --git a/backend/src/app/services/queries/profile.clj b/backend/src/app/rpc/queries/profile.clj
similarity index 93%
rename from backend/src/app/services/queries/profile.clj
rename to backend/src/app/rpc/queries/profile.clj
index 9f73e7c88..b02ca6ce9 100644
--- a/backend/src/app/services/queries/profile.clj
+++ b/backend/src/app/rpc/queries/profile.clj
@@ -7,13 +7,13 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.queries.profile
+(ns app.rpc.queries.profile
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
- [app.services.queries :as sq]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
@@ -38,11 +38,10 @@
(s/def ::profile
(s/keys :opt-un [::profile-id]))
-(sq/defquery ::profile
- [{:keys [profile-id] :as params}]
+(sv/defmethod ::profile {:auth false}
+ [{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
(if profile-id
- (with-open [conn (db/open)]
- (retrieve-profile conn profile-id))
+ (retrieve-profile pool profile-id)
{:id uuid/zero
:fullname "Anonymous User"}))
diff --git a/backend/src/app/services/queries/projects.clj b/backend/src/app/rpc/queries/projects.clj
similarity index 90%
rename from backend/src/app/services/queries/projects.clj
rename to backend/src/app/rpc/queries/projects.clj
index 1b3b36997..5d48a5b3e 100644
--- a/backend/src/app/services/queries/projects.clj
+++ b/backend/src/app/rpc/queries/projects.clj
@@ -7,13 +7,13 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.queries.projects
+(ns app.rpc.queries.projects
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
- [app.services.queries :as sq]
- [app.services.queries.teams :as teams]
+ [app.rpc.queries.teams :as teams]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Check Project Permissions
@@ -68,9 +68,9 @@
(s/def ::projects
(s/keys :req-un [::profile-id ::team-id]))
-(sq/defquery ::projects
- [{:keys [profile-id team-id]}]
- (with-open [conn (db/open)]
+(sv/defmethod ::projects
+ [{:keys [pool]} {:keys [profile-id team-id]}]
+ (with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(retrieve-projects conn profile-id team-id)))
@@ -100,9 +100,9 @@
(s/def ::project
(s/keys :req-un [::profile-id ::id]))
-(sq/defquery ::project
- [{:keys [profile-id id]}]
- (with-open [conn (db/open)]
+(sv/defmethod ::project
+ [{:keys [pool]} {:keys [profile-id id]}]
+ (with-open [conn (db/open pool)]
(let [project (db/get-by-id conn :project id)]
(check-read-permissions! conn profile-id id)
project)))
diff --git a/backend/src/app/services/queries/recent_files.clj b/backend/src/app/rpc/queries/recent_files.clj
similarity index 81%
rename from backend/src/app/services/queries/recent_files.clj
rename to backend/src/app/rpc/queries/recent_files.clj
index e52fd9ee9..24a5653ea 100644
--- a/backend/src/app/services/queries/recent_files.clj
+++ b/backend/src/app/rpc/queries/recent_files.clj
@@ -7,13 +7,13 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.queries.recent-files
+(ns app.rpc.queries.recent-files
(:require
[app.common.spec :as us]
[app.db :as db]
- [app.services.queries :as sq]
- [app.services.queries.files :refer [decode-row-xf]]
- [app.services.queries.teams :as teams]
+ [app.rpc.queries.files :refer [decode-row-xf]]
+ [app.rpc.queries.teams :as teams]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]))
(def sql:recent-files
@@ -35,9 +35,9 @@
(s/def ::recent-files
(s/keys :req-un [::profile-id ::team-id]))
-(sq/defquery ::recent-files
- [{:keys [profile-id team-id]}]
- (with-open [conn (db/open)]
+(sv/defmethod ::recent-files
+ [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+ (with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(let [files (db/exec! conn [sql:recent-files team-id])]
(into [] decode-row-xf files))))
diff --git a/backend/src/app/services/queries/teams.clj b/backend/src/app/rpc/queries/teams.clj
similarity index 89%
rename from backend/src/app/services/queries/teams.clj
rename to backend/src/app/rpc/queries/teams.clj
index e3fc6b85b..1e5021af8 100644
--- a/backend/src/app/services/queries/teams.clj
+++ b/backend/src/app/rpc/queries/teams.clj
@@ -7,13 +7,13 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.queries.teams
+(ns app.rpc.queries.teams
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
- [app.services.queries :as sq]
- [app.services.queries.profile :as profile]
+ [app.rpc.queries.profile :as profile]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Team Edition Permissions
@@ -54,9 +54,9 @@
(s/def ::teams
(s/keys :req-un [::profile-id]))
-(sq/defquery ::teams
- [{:keys [profile-id]}]
- (with-open [conn (db/open)]
+(sv/defmethod ::teams
+ [{:keys [pool] :as cfg} {:keys [profile-id]}]
+ (with-open [conn (db/open pool)]
(retrieve-teams conn profile-id)))
(def sql:teams
@@ -84,9 +84,9 @@
(s/def ::team
(s/keys :req-un [::profile-id ::id]))
-(sq/defquery ::team
- [{:keys [profile-id id]}]
- (with-open [conn (db/open)]
+(sv/defmethod ::team
+ [{:keys [pool] :as cfg} {:keys [profile-id id]}]
+ (with-open [conn (db/open pool)]
(retrieve-team conn profile-id id)))
(defn retrieve-team
@@ -108,9 +108,9 @@
(s/def ::team-members
(s/keys :req-un [::profile-id ::team-id]))
-(sq/defquery ::team-members
- [{:keys [profile-id team-id]}]
- (with-open [conn (db/open)]
+(sv/defmethod ::team-members
+ [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+ (with-open [conn (db/open pool)]
(check-edition-permissions! conn profile-id team-id)
(retrieve-team-members conn team-id)))
@@ -141,9 +141,9 @@
:opt-un [::team-id ::file-id])
#(or (:team-id %) (:file-id %))))
-(sq/defquery ::team-users
- [{:keys [profile-id team-id file-id]}]
- (with-open [conn (db/open)]
+(sv/defmethod ::team-users
+ [{:keys [pool] :as cfg} {:keys [profile-id team-id file-id]}]
+ (with-open [conn (db/open pool)]
(if team-id
(do
(check-edition-permissions! conn profile-id team-id)
@@ -197,9 +197,9 @@
(s/def ::team-stats
(s/keys :req-un [::profile-id ::team-id]))
-(sq/defquery ::team-stats
- [{:keys [profile-id team-id]}]
- (with-open [conn (db/open)]
+(sv/defmethod ::team-stats
+ [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+ (with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id)
(retrieve-team-stats conn team-id)))
diff --git a/backend/src/app/services/queries/viewer.clj b/backend/src/app/rpc/queries/viewer.clj
similarity index 89%
rename from backend/src/app/services/queries/viewer.clj
rename to backend/src/app/rpc/queries/viewer.clj
index 000f38362..89032bb21 100644
--- a/backend/src/app/services/queries/viewer.clj
+++ b/backend/src/app/rpc/queries/viewer.clj
@@ -7,14 +7,14 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.queries.viewer
+(ns app.rpc.queries.viewer
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
- [app.services.queries :as sq]
- [app.services.queries.files :as files]
- [app.services.queries.teams :as teams]
+ [app.rpc.queries.files :as files]
+ [app.rpc.queries.teams :as teams]
+ [app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Query: Viewer Bundle (by Page ID)
@@ -42,9 +42,9 @@
(s/keys :req-un [::file-id ::page-id]
:opt-un [::profile-id ::token]))
-(sq/defquery ::viewer-bundle
- [{:keys [profile-id file-id page-id token] :as params}]
- (db/with-atomic [conn db/pool]
+(sv/defmethod ::viewer-bundle {:auth false}
+ [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id token] :as params}]
+ (db/with-atomic [conn pool]
(let [file (files/retrieve-file conn file-id)
project (retrieve-project conn (:project-id file))
page (get-in file [:data :pages-index page-id])
diff --git a/backend/src/app/services.clj b/backend/src/app/services.clj
deleted file mode 100644
index 2268ed791..000000000
--- a/backend/src/app/services.clj
+++ /dev/null
@@ -1,43 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.services
- "A initialization of services."
- (:require
- [app.services.middleware :as middleware]
- [app.util.dispatcher :as uds]
- [mount.core :as mount :refer [defstate]]))
-
-;; --- Initialization
-
-(defn- load-query-services
- []
- (require 'app.services.queries.projects)
- (require 'app.services.queries.files)
- (require 'app.services.queries.comments)
- (require 'app.services.queries.profile)
- (require 'app.services.queries.recent-files)
- (require 'app.services.queries.viewer))
-
-(defn- load-mutation-services
- []
- (require 'app.services.mutations.demo)
- (require 'app.services.mutations.media)
- (require 'app.services.mutations.projects)
- (require 'app.services.mutations.files)
- (require 'app.services.mutations.comments)
- (require 'app.services.mutations.profile)
- (require 'app.services.mutations.viewer)
- (require 'app.services.mutations.verify-token))
-
-(defstate query-services
- :start (load-query-services))
-
-(defstate mutation-services
- :start (load-mutation-services))
diff --git a/backend/src/app/services/init.clj b/backend/src/app/services/init.clj
deleted file mode 100644
index 6223b121b..000000000
--- a/backend/src/app/services/init.clj
+++ /dev/null
@@ -1,10 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.services.init)
diff --git a/backend/src/app/services/middleware.clj b/backend/src/app/services/middleware.clj
deleted file mode 100644
index 916d791a6..000000000
--- a/backend/src/app/services/middleware.clj
+++ /dev/null
@@ -1,71 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.services.middleware
- "Common middleware for services."
- (:require
- [app.common.exceptions :as ex]
- [app.common.spec :as us]
- [app.metrics :as mtx]
- [clojure.spec.alpha :as s]
- [cuerdas.core :as str]))
-
-(defn wrap-spec
- [handler]
- (let [mdata (meta handler)
- spec (s/get-spec (:spec mdata))]
- (if (nil? spec)
- handler
- (with-meta
- (fn [params]
- (let [result (us/conform spec params)]
- (handler result)))
- (assoc mdata ::wrap-spec true)))))
-
-(defn wrap-error
- [handler]
- (let [mdata (meta handler)]
- (with-meta
- (fn [params]
- (try
- (handler params)
- (catch Throwable error
- (ex/raise :type :service-error
- :name (:spec mdata)
- :cause error))))
- (assoc mdata ::wrap-error true))))
-
-(defn- get-prefix
- [nsname]
- (let [[_ _ c] (str/split nsname ".")]
- c))
-
-(defn wrap-metrics
- [handler]
- (let [mdata (meta handler)
- nsname (namespace (:spec mdata))
- smname (name (:spec mdata))
- prefix (get-prefix nsname)
-
- sname (str prefix "/" smname)
-
- props {:id (str/join "__" [prefix
- (str/snake smname)
- "response_time"])
- :help (str "Service timing measures for: " sname ".")}]
- (with-meta
- (mtx/wrap-summary handler props)
- (assoc mdata ::wrap-metrics true))))
-
-(defn wrap
- [handler]
- (-> handler
- (wrap-spec)
- (wrap-error)
- (wrap-metrics)))
diff --git a/backend/src/app/services/mutations.clj b/backend/src/app/services/mutations.clj
deleted file mode 100644
index c15bbbbb2..000000000
--- a/backend/src/app/services/mutations.clj
+++ /dev/null
@@ -1,21 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.services.mutations
- (:require
- [app.services.middleware :as middleware]
- [app.util.dispatcher :as uds]))
-
-(uds/defservice handle
- :dispatch-by ::type
- :wrap middleware/wrap)
-
-(defmacro defmutation
- [key & rest]
- `(uds/defmethod handle ~key ~@rest))
diff --git a/backend/src/app/services/queries.clj b/backend/src/app/services/queries.clj
deleted file mode 100644
index a8cd40912..000000000
--- a/backend/src/app/services/queries.clj
+++ /dev/null
@@ -1,21 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.services.queries
- (:require
- [app.services.middleware :as middleware]
- [app.util.dispatcher :as uds]))
-
-(uds/defservice handle
- :dispatch-by ::type
- :wrap middleware/wrap)
-
-(defmacro defquery
- [key & rest]
- `(uds/defmethod handle ~key ~@rest))
diff --git a/backend/src/app/services/tokens.clj b/backend/src/app/services/tokens.clj
deleted file mode 100644
index fe0967156..000000000
--- a/backend/src/app/services/tokens.clj
+++ /dev/null
@@ -1,62 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.services.tokens
- (:require
- [app.common.exceptions :as ex]
- [app.config :as cfg]
- [app.util.time :as dt]
- [app.util.transit :as t]
- [buddy.core.kdf :as bk]
- [buddy.sign.jwe :as jwe]
- [clojure.tools.logging :as log]))
-
-(defn- derive-tokens-secret
- [key]
- (when (= key "default")
- (log/warn "Using default APP_SECRET_KEY, the system will generate insecure tokens."))
- (let [engine (bk/engine {:key key
- :salt "tokens"
- :alg :hkdf
- :digest :blake2b-512})]
- (bk/get-bytes engine 32)))
-
-(def secret
- (delay (derive-tokens-secret (:secret-key cfg/config))))
-
-(defn generate
- [claims]
- (let [payload (t/encode claims)]
- (jwe/encrypt payload @secret {:alg :a256kw :enc :a256gcm})))
-
-(defn verify
- ([token] (verify token nil))
- ([token params]
- (let [payload (jwe/decrypt token @secret {:alg :a256kw :enc :a256gcm})
- claims (t/decode payload)]
- (when (and (dt/instant? (:exp claims))
- (dt/is-before? (:exp claims) (dt/now)))
- (ex/raise :type :validation
- :code :invalid-token
- :reason :token-expired
- :params params
- :claims claims))
- (when (and (contains? params :iss)
- (not= (:iss claims)
- (:iss params)))
- (ex/raise :type :validation
- :code :invalid-token
- :reason :invalid-issuer
- :claims claims
- :params params))
- claims)))
-
-
-
-
diff --git a/backend/src/app/srepl.clj b/backend/src/app/srepl.clj
new file mode 100644
index 000000000..8bb710ea5
--- /dev/null
+++ b/backend/src/app/srepl.clj
@@ -0,0 +1,57 @@
+;; 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 app.srepl
+ "Server Repl."
+ (:require
+ [integrant.core :as ig]
+ [app.srepl.main]
+ [app.common.spec :as us]
+ [clojure.core.server :as ccs]
+ [clojure.spec.alpha :as s]
+ [clojure.main :as cm]))
+
+(defn- repl-init
+ []
+ (ccs/repl-init)
+ (in-ns 'app.srepl.main))
+
+(defn repl
+ []
+ (cm/repl
+ :init repl-init
+ :read ccs/repl-read))
+
+;; --- State initialization
+
+(s/def ::name ::us/not-empty-string)
+(s/def ::port int?)
+(s/def ::host ::us/not-empty-string)
+
+(defmethod ig/pre-init-spec ::server
+ [_]
+ (s/keys :opt-un [::port ::host ::name]))
+
+(defmethod ig/prep-key ::server
+ [_ cfg]
+ (merge {:port 6062 :host "127.0.0.1" :name "main"} cfg))
+
+(defmethod ig/init-key ::server
+ [_ {:keys [port host name] :as cfg}]
+ (ccs/start-server {:address host
+ :port port
+ :name name
+ :accept 'app.srepl/repl})
+ cfg)
+
+(defmethod ig/halt-key! ::server
+ [_ cfg]
+ (ccs/stop-server (:name cfg)))
+
+
diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj
index fe4f97277..aeded7b49 100644
--- a/backend/src/app/srepl/main.clj
+++ b/backend/src/app/srepl/main.clj
@@ -4,6 +4,7 @@
(:require
[clojure.pprint :refer [pprint]]
[app.db :as db]
+ [app.main :refer [system]]
[app.common.pages.migrations :as pmg]
[app.util.blob :as blob]
[app.common.pages :as cp]))
@@ -11,7 +12,7 @@
(defn update-file
([id f] (update-file id f false))
([id f save?]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn (:app.db/pool system)]
(let [file (db/get-by-id conn :file id {:for-update true})
file (-> file
(update :data app.util.blob/decode)
@@ -27,7 +28,7 @@
(defn update-file-raw
[id data]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn (:app.db/pool system)]
(db/update! conn :file
{:data data}
{:id id})))
diff --git a/backend/src/app/srepl/server.clj b/backend/src/app/srepl/server.clj
deleted file mode 100644
index 51d23050f..000000000
--- a/backend/src/app/srepl/server.clj
+++ /dev/null
@@ -1,38 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; 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 app.srepl.server
- "Server Repl."
- (:require
- [app.srepl.main]
- [clojure.core.server :as ccs]
- [clojure.main :as cm]
- [mount.core :as mount :refer [defstate]]))
-
-(defn- repl-init
- []
- (ccs/repl-init)
- (in-ns 'app.srepl.main))
-
-(defn repl
- []
- (cm/repl
- :init repl-init
- :read ccs/repl-read))
-
-(defstate server
- :start (ccs/start-server
- {:address "127.0.0.1"
- :port 6062
- :name "main"
- :accept 'app.srepl.server/repl})
- :stop (ccs/stop-server "main"))
-
-
-
diff --git a/backend/src/app/services/svgparse.clj b/backend/src/app/svgparse.clj
similarity index 97%
rename from backend/src/app/services/svgparse.clj
rename to backend/src/app/svgparse.clj
index 733b070d0..5dc54c518 100644
--- a/backend/src/app/services/svgparse.clj
+++ b/backend/src/app/svgparse.clj
@@ -7,7 +7,7 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.services.svgparse
+(ns app.svgparse
(:require
[app.common.exceptions :as ex]
[clojure.xml :as xml]
diff --git a/backend/src/app/tasks.clj b/backend/src/app/tasks.clj
index c074358e2..2a3eca68d 100644
--- a/backend/src/app/tasks.clj
+++ b/backend/src/app/tasks.clj
@@ -12,7 +12,7 @@
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
- [app.metrics :as mtx]
+ ;; [app.metrics :as mtx]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
@@ -33,20 +33,19 @@
returning id")
(defn submit!
- ([opts] (submit! db/pool opts))
- ([conn {:keys [name delay props queue priority max-retries]
- :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/infof "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)))
+ [conn {:keys [name delay props queue priority max-retries]
+ :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/infof "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!
- :id "tasks__submit_counter"
- :help "Absolute task submit counter."})
+;; (mtx/instrument-with-counter!
+;; {:var #'submit!
+;; :id "tasks__submit_counter"
+;; :help "Absolute task submit counter."})
diff --git a/backend/src/app/tasks/delete_object.clj b/backend/src/app/tasks/delete_object.clj
index d50b4e154..de1f0734d 100644
--- a/backend/src/app/tasks/delete_object.clj
+++ b/backend/src/app/tasks/delete_object.clj
@@ -11,16 +11,36 @@
"Generic task for permanent deletion of objects."
(:require
[app.common.spec :as us]
+ [integrant.core :as ig]
[app.db :as db]
[app.metrics :as mtx]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
-(s/def ::type keyword?)
-(s/def ::id ::us/uuid)
+(declare handler)
+(declare handle-deletion)
-(s/def ::props
- (s/keys :req-un [::id ::type]))
+(defmethod ig/pre-init-spec ::handler [_]
+ (s/keys :req-un [::db/pool ::mtx/metrics]))
+
+(defmethod ig/init-key ::handler
+ [_ {:keys [metrics] :as cfg}]
+ (let [handler #(handler cfg %)]
+ (->> {:registry (:registry metrics)
+ :type :summary
+ :name "task_delete_object_timing"
+ :help "delete object task timing"}
+ (mtx/instrument handler))))
+
+(s/def ::type ::us/keyword)
+(s/def ::id ::us/uuid)
+(s/def ::props (s/keys :req-un [::id ::type]))
+
+(defn- handler
+ [{:keys [pool]} {:keys [props] :as task}]
+ (us/verify ::props props)
+ (db/with-atomic [conn pool]
+ (handle-deletion conn props)))
(defmulti handle-deletion (fn [_ props] (:type props)))
@@ -28,17 +48,6 @@
[_conn {:keys [type]}]
(log/warn "no handler found for" type))
-(defn handler
- [{:keys [props] :as task}]
- (us/verify ::props props)
- (db/with-atomic [conn db/pool]
- (handle-deletion conn props)))
-
-(mtx/instrument-with-summary!
- {:var #'handler
- :id "tasks__delete_object"
- :help "Timing of remove-object task."})
-
(defmethod handle-deletion :file
[conn {:keys [id] :as props}]
(let [sql "delete from file where id=? and deleted_at is not null"]
diff --git a/backend/src/app/tasks/delete_profile.clj b/backend/src/app/tasks/delete_profile.clj
index c1fe70728..da8ef6c53 100644
--- a/backend/src/app/tasks/delete_profile.clj
+++ b/backend/src/app/tasks/delete_profile.clj
@@ -14,7 +14,22 @@
[app.db :as db]
[app.metrics :as mtx]
[clojure.spec.alpha :as s]
- [clojure.tools.logging :as log]))
+ [clojure.tools.logging :as log]
+ [integrant.core :as ig]))
+
+(declare handler)
+
+(defmethod ig/pre-init-spec ::handler [_]
+ (s/keys :req-un [::db/pool ::mtx/metrics]))
+
+(defmethod ig/init-key ::handler
+ [_ {:keys [metrics] :as cfg}]
+ (let [handler #(handler cfg %)]
+ (->> {:registry (:registry metrics)
+ :type :summary
+ :name "task_delete_profile_timing"
+ :help "delete profile task timing"}
+ (mtx/instrument handler))))
(declare delete-profile-data)
(declare delete-teams)
@@ -26,10 +41,10 @@
(s/keys :req-un [::profile-id]))
(defn handler
- [{:keys [props] :as task}]
+ [{:keys [pool]} {:keys [props] :as task}]
(us/verify ::props props)
- (db/with-atomic [conn db/pool]
- (let [id (:profile-id props)
+ (db/with-atomic [conn pool]
+ (let [id (:profile-id props)
profile (db/get-by-id conn :profile id {:for-update true})]
(if (or (:is-demo profile)
(not (nil? (:deleted-at profile))))
@@ -37,11 +52,6 @@
(log/warn "Profile " (:id profile)
"does not match constraints for deletion")))))
-(mtx/instrument-with-summary!
- {:var #'handler
- :id "tasks__delete_profile"
- :help "Timing of delete-profile task."})
-
(defn- delete-profile-data
[conn profile-id]
(log/info "Proceding to delete all data related to profile" profile-id)
diff --git a/backend/src/app/tasks/file_media_gc.clj b/backend/src/app/tasks/file_media_gc.clj
index 23f478e36..e522036a7 100644
--- a/backend/src/app/tasks/file_media_gc.clj
+++ b/backend/src/app/tasks/file_media_gc.clj
@@ -13,20 +13,49 @@
after some period of inactivity (the default threshold is 72h)."
(:require
[app.common.pages.migrations :as pmg]
+ [app.common.spec :as us]
[app.config :as cfg]
[app.db :as db]
[app.metrics :as mtx]
[app.tasks :as tasks]
[app.util.blob :as blob]
[app.util.time :as dt]
+ [integrant.core :as ig]
+ [clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
-(defn decode-row
+(declare handler)
+(declare retrieve-candidates)
+(declare process-file)
+
+(defmethod ig/pre-init-spec ::handler [_]
+ (s/keys :req-un [::db/pool]))
+
+(defmethod ig/init-key ::handler
+ [_ cfg]
+ (partial handler cfg))
+
+(defn- handler
+ [{:keys [pool]} _]
+ (db/with-atomic [conn pool]
+ (loop []
+ (let [files (retrieve-candidates conn)]
+ (when (seq files)
+ (run! (partial process-file conn) files)
+ (recur))))))
+
+;; (mtx/instrument-with-summary!
+;; {:var #'handler
+;; :id "tasks__file_media_gc"
+;; :help "Timing of task: file_media_gc"})
+
+(defn- decode-row
[{:keys [data] :as row}]
(cond-> row
(bytes? data) (assoc :data (blob/decode data))))
-(def sql:retrieve-candidates-chunk
+(def ^:private
+ sql:retrieve-candidates-chunk
"select f.id,
f.data,
extract(epoch from (now() - f.modified_at))::bigint as age
@@ -37,9 +66,7 @@
limit 10
for update skip locked")
-(defn retrieve-candidates
- "Retrieves a list of files that are candidates to be garbage
- collected."
+(defn- retrieve-candidates
[conn]
(let [threshold (:file-trimming-threshold cfg/config)
interval (db/interval threshold)]
@@ -47,7 +74,8 @@
(map (fn [{:keys [age] :as row}]
(assoc row :age (dt/duration {:seconds age})))))))
-(def collect-media-xf
+(def ^:private
+ collect-media-xf
(comp
(map :objects)
(mapcat vals)
@@ -92,19 +120,3 @@
{:id id}))
nil))
-
-(defn handler
- [_task]
- (db/with-atomic [conn db/pool]
- (loop []
- (let [files (retrieve-candidates conn)]
- (when (seq files)
- (run! (partial process-file conn) files)
- (recur))))))
-
-
-(mtx/instrument-with-summary!
- {:var #'handler
- :id "tasks__file_media_gc"
- :help "Timing of task: file_media_gc"})
-
diff --git a/backend/src/app/tasks/file_xlog_gc.clj b/backend/src/app/tasks/file_xlog_gc.clj
index 1c689abeb..15a3fc6df 100644
--- a/backend/src/app/tasks/file_xlog_gc.clj
+++ b/backend/src/app/tasks/file_xlog_gc.clj
@@ -12,27 +12,38 @@
change (transaction) log."
(:require
[app.common.spec :as us]
+ [integrant.core :as ig]
[app.db :as db]
[app.metrics :as mtx]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
-(def max-age (dt/duration {:hours 12}))
+(declare handler)
-(def sql:delete-files-xlog
+(s/def ::max-age ::dt/duration)
+(defmethod ig/pre-init-spec ::handler [_]
+ (s/keys :req-un [::db/pool ::mtx/metrics ::max-age]))
+
+(defmethod ig/init-key ::handler
+ [_ {:keys [metrics] :as cfg}]
+ (let [handler #(handler cfg %)]
+ (->> {:registry (:registry metrics)
+ :type :summary
+ :name "task_file_xlog_gc_timing"
+ :help "file changes garbage collection task timing"}
+ (mtx/instrument handler))))
+
+(def ^:private
+ sql:delete-files-xlog
"delete from task_completed
where scheduled_at < now() - ?::interval")
-(defn handler
- [{:keys [props] :as task}]
- (db/with-atomic [conn db/pool]
+(defn- handler
+ [{:keys [pool max-age]} _]
+ (db/with-atomic [conn pool]
(let [interval (db/interval max-age)
- result (db/exec-one! conn [sql:delete-files-xlog interval])]
- (log/infof "removed %s rows from file_changes table." (:next.jdbc/update-count result))
+ result (db/exec-one! conn [sql:delete-files-xlog interval])
+ result (:next.jdbc/update-count result)]
+ (log/infof "removed %s rows from file_changes table" result)
nil)))
-
-(mtx/instrument-with-summary!
- {:var #'handler
- :id "tasks__file_xlog_gc"
- :help "Timing of task: file_xlog_gc"})
diff --git a/backend/src/app/tasks/remove_media.clj b/backend/src/app/tasks/remove_media.clj
index 2d1a52858..58bc9aab0 100644
--- a/backend/src/app/tasks/remove_media.clj
+++ b/backend/src/app/tasks/remove_media.clj
@@ -8,13 +8,14 @@
;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tasks.remove-media
- "Demo accounts garbage collector."
+ "TODO: pending to be refactored together with the storage
+ subsystem."
(:require
[app.common.spec :as us]
[app.db :as db]
- [app.media-storage :as mst]
- [app.metrics :as mtx]
- [app.util.storage :as ust]
+ ;; [app.media-storage :as mst]
+ ;; [app.metrics :as mtx]
+ ;; [app.util.storage :as ust]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
@@ -26,21 +27,21 @@
;; system. Mainly used for profile photo change; when we really know
;; that the previous photo becomes unused.
-(s/def ::path ::us/not-empty-string)
-(s/def ::props
- (s/keys :req-un [::path]))
+;; (s/def ::path ::us/not-empty-string)
+;; (s/def ::props
+;; (s/keys :req-un [::path]))
-(defn handler
- [{:keys [props] :as task}]
- (us/verify ::props props)
- (when (ust/exists? mst/media-storage (:path props))
- (ust/delete! mst/media-storage (:path props))
- (log/debug "Media " (:path props) " removed.")))
+;; (defn handler
+;; [{:keys [props] :as task}]
+;; (us/verify ::props props)
+;; (when (ust/exists? mst/media-storage (:path props))
+;; (ust/delete! mst/media-storage (:path props))
+;; (log/debug "Media " (:path props) " removed.")))
-(mtx/instrument-with-summary!
- {:var #'handler
- :id "tasks__remove_media"
- :help "Timing of remove-media task."})
+;; (mtx/instrument-with-summary!
+;; {:var #'handler
+;; :id "tasks__remove_media"
+;; :help "Timing of remove-media task."})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Task: Trim Media Storage
@@ -59,37 +60,35 @@
;; 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
- order by i.created_at
- limit ?
- for update skip locked
- )
- delete from pending_to_delete
- where id in (select id from items_part)
- returning *")
-
-(defn trim-media-storage
- [_task]
- (letfn [(decode-row [{:keys [data] :as row}]
- (cond-> row
- (db/pgobject? data) (assoc :data (db/decode-json-pgobject data))))
- (retrieve-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))))))
-
+;; (def ^:private
+;; sql:retrieve-peding-to-delete
+;; "with items_part as (
+;; select i.id
+;; from pending_to_delete as i
+;; order by i.created_at
+;; limit ?
+;; for update skip locked
+;; )
+;; delete from pending_to_delete
+;; where id in (select id from items_part)
+;; returning *")
+;; (defn trim-media-storage
+;; [_task]
+;; (letfn [(decode-row [{:keys [data] :as row}]
+;; (cond-> row
+;; (db/pgobject? data) (assoc :data (db/decode-json-pgobject data))))
+;; (retrieve-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))))))
diff --git a/backend/src/app/tasks/sendmail.clj b/backend/src/app/tasks/sendmail.clj
index c078f2c1e..26a94b266 100644
--- a/backend/src/app/tasks/sendmail.clj
+++ b/backend/src/app/tasks/sendmail.clj
@@ -9,15 +9,50 @@
(ns app.tasks.sendmail
(:require
+ [app.common.spec :as us]
[app.config :as cfg]
[app.metrics :as mtx]
[app.util.emails :as emails]
- [clojure.tools.logging :as log]))
+ [clojure.tools.logging :as log]
+ [clojure.spec.alpha :as s]
+ [integrant.core :as ig]))
+
+(declare handler)
+
+(s/def ::username ::cfg/smtp-username)
+(s/def ::password ::cfg/smtp-password)
+(s/def ::tls ::cfg/smtp-tls)
+(s/def ::ssl ::cfg/smtp-ssl)
+(s/def ::host ::cfg/smtp-host)
+(s/def ::port ::cfg/smtp-port)
+(s/def ::default-reply-to ::cfg/smtp-default-reply-to)
+(s/def ::default-from ::cfg/smtp-default-from)
+(s/def ::enabled ::cfg/smtp-enabled)
+
+(defmethod ig/pre-init-spec ::handler [_]
+ (s/keys :req-un [::enabled ::mtx/metrics]
+ :opt-un [::username
+ ::password
+ ::tls
+ ::ssl
+ ::host
+ ::port
+ ::default-from
+ ::default-reply-to]))
+
+(defmethod ig/init-key ::handler
+ [_ {:keys [metrics] :as cfg}]
+ (let [handler #(handler cfg %)]
+ (->> {:registry (:registry metrics)
+ :type :summary
+ :name "task_sendmail_timing"
+ :help "sendmail task timing"}
+ (mtx/instrument handler))))
(defn- send-console!
- [config email]
+ [cfg email]
(let [baos (java.io.ByteArrayOutputStream.)
- mesg (emails/smtp-message config email)]
+ mesg (emails/smtp-message cfg email)]
(.writeTo mesg baos)
(let [out (with-out-str
(println "email console dump:")
@@ -27,14 +62,7 @@
(log/info out))))
(defn handler
- {:app.tasks/name "sendmail"}
- [{:keys [props] :as task}]
- (let [config (cfg/smtp cfg/config)]
- (if (:enabled config)
- (emails/send! config props)
- (send-console! config props))))
-
-(mtx/instrument-with-summary!
- {:var #'handler
- :id "tasks__sendmail"
- :help "Timing of sendmail task."})
+ [cfg {:keys [props] :as task}]
+ (if (:enabled cfg)
+ (emails/send! cfg props)
+ (send-console! cfg props)))
diff --git a/backend/src/app/tasks/clean_tasks_table.clj b/backend/src/app/tasks/tasks_gc.clj
similarity index 50%
rename from backend/src/app/tasks/clean_tasks_table.clj
rename to backend/src/app/tasks/tasks_gc.clj
index 17e9bfb1e..5abd93e34 100644
--- a/backend/src/app/tasks/clean_tasks_table.clj
+++ b/backend/src/app/tasks/tasks_gc.clj
@@ -7,7 +7,7 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.tasks.clean-tasks-table
+(ns app.tasks.tasks-gc
"A maintenance task that performs a cleanup of already executed tasks
from the database table."
(:require
@@ -16,25 +16,36 @@
[app.metrics :as mtx]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
- [clojure.tools.logging :as log]))
+ [clojure.tools.logging :as log]
+ [integrant.core :as ig]))
-(def max-age (dt/duration {:hours 24}))
+(declare handler)
-(def sql:delete-completed-tasks
+(s/def ::max-age ::dt/duration)
+
+(defmethod ig/pre-init-spec ::handler [_]
+ (s/keys :req-un [::db/pool ::mtx/metrics ::max-age]))
+
+(defmethod ig/init-key ::handler
+ [_ {:keys [metrics] :as cfg}]
+ (let [handler #(handler cfg %)]
+ (->> {:registry (:registry metrics)
+ :type :summary
+ :name "task_tasks_gc_timing"
+ :help "tasks garbage collection task timing"}
+ (mtx/instrument handler))))
+
+(def ^:private
+ sql:delete-completed-tasks
"delete from task_completed
where scheduled_at < now() - ?::interval")
-(defn handler
- [task]
- (db/with-atomic [conn db/pool]
+(defn- handler
+ [{:keys [pool max-age]} _]
+ (db/with-atomic [conn pool]
(let [interval (db/interval max-age)
- result (db/exec-one! conn [sql:delete-completed-tasks interval])]
- (log/infof "removed %s rows from tasks_completed table." (:next.jdbc/update-count result))
+ result (db/exec-one! conn [sql:delete-completed-tasks interval])
+ result (:next.jdbc/update-count result)]
+ (log/infof "removed %s rows from tasks_completed table" result)
nil)))
-(mtx/instrument-with-summary!
- {:var #'handler
- :id "tasks__clean_tasks_table"
- :help "Timing of task: clean_task_table"})
-
-
diff --git a/backend/src/app/tokens.clj b/backend/src/app/tokens.clj
new file mode 100644
index 000000000..1ca3ccee7
--- /dev/null
+++ b/backend/src/app/tokens.clj
@@ -0,0 +1,72 @@
+;; 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 app.tokens
+ "Tokens generation service."
+ (:require
+ [app.common.exceptions :as ex]
+ [app.common.spec :as us]
+ [integrant.core :as ig]
+ [app.config :as cfg]
+ [app.util.time :as dt]
+ [app.util.transit :as t]
+ [buddy.core.kdf :as bk]
+ [buddy.sign.jwe :as jwe]
+ [clojure.spec.alpha :as s]
+ [clojure.tools.logging :as log]))
+
+(defn- derive-tokens-secret
+ [key]
+ (when (= key "default")
+ (log/warn "Using default APP_SECRET_KEY, the system will generate insecure tokens."))
+ (let [engine (bk/engine {:key key
+ :salt "tokens"
+ :alg :hkdf
+ :digest :blake2b-512})]
+ (bk/get-bytes engine 32)))
+
+(defn- generate
+ [cfg claims]
+ (let [payload (t/encode claims)]
+ (jwe/encrypt payload (::secret cfg) {:alg :a256kw :enc :a256gcm})))
+
+(defn- verify
+ [cfg {:keys [token] :as params}]
+ (let [payload (jwe/decrypt token (::secret cfg) {:alg :a256kw :enc :a256gcm})
+ claims (t/decode payload)]
+ (when (and (dt/instant? (:exp claims))
+ (dt/is-before? (:exp claims) (dt/now)))
+ (ex/raise :type :validation
+ :code :invalid-token
+ :reason :token-expired
+ :params params
+ :claims claims))
+ (when (and (contains? params :iss)
+ (not= (:iss claims)
+ (:iss params)))
+ (ex/raise :type :validation
+ :code :invalid-token
+ :reason :invalid-issuer
+ :claims claims
+ :params params))
+ claims))
+
+(s/def ::secret-key ::us/not-empty-string)
+
+(defmethod ig/pre-init-spec ::tokens [_]
+ (s/keys :req-un [::secret-key]))
+
+(defmethod ig/init-key ::tokens
+ [_ cfg]
+ (let [secret (derive-tokens-secret (:secret-key cfg))
+ cfg (assoc cfg ::secret secret)]
+ (fn [action params]
+ (case action
+ :verify (verify cfg params)
+ :generate (generate cfg params)))))
diff --git a/backend/src/app/util/async.clj b/backend/src/app/util/async.clj
index afb221b59..8c2ac6c72 100644
--- a/backend/src/app/util/async.clj
+++ b/backend/src/app/util/async.clj
@@ -6,10 +6,48 @@
(ns app.util.async
(:require
+ [clojure.spec.alpha :as s]
[clojure.core.async :as a]
- [clojure.spec.alpha :as s])
+ [cuerdas.core :as str])
(:import
- java.util.concurrent.Executor))
+ java.util.concurrent.Executor
+ java.util.concurrent.ThreadFactory
+ java.util.concurrent.ForkJoinPool
+ java.util.concurrent.ForkJoinPool$ForkJoinWorkerThreadFactory
+ java.util.concurrent.ExecutorService
+ java.util.concurrent.atomic.AtomicLong))
+
+(s/def ::executor #(instance? Executor %))
+
+(defonce processors
+ (delay (.availableProcessors (Runtime/getRuntime))))
+
+;; (defn forkjoin-thread-factory
+;; [f]
+;; (reify ForkJoinPool$ForkJoinWorkerThreadFactory
+;; (newThread [this pool]
+;; (let [wth (.newThread ForkJoinPool/defaultForkJoinWorkerThreadFactory pool)]
+;; (f wth)))))
+
+;; (defn forkjoin-named-thread-factory
+;; [name]
+;; (reify ForkJoinPool$ForkJoinWorkerThreadFactory
+;; (newThread [this pool]
+;; (let [wth (.newThread ForkJoinPool/defaultForkJoinWorkerThreadFactory pool)]
+;; (.setName wth (str name ":" (.getPoolIndex wth)))
+;; wth))))
+
+;; (defn forkjoin-pool
+;; [{:keys [factory async? parallelism]
+;; :or {async? true}
+;; :as opts}]
+;; (let [parallelism (or parallelism @processors)
+;; factory (cond
+;; (fn? factory) (forkjoin-thread-factory factory)
+;; (instance? ForkJoinPool$ForkJoinWorkerThreadFactory factory) factory
+;; (nil? factory) ForkJoinPool/defaultForkJoinWorkerThreadFactory
+;; :else (throw (ex-info "Unexpected thread factory" {:factory factory})))]
+;; (ForkJoinPool. (or parallelism @processors) factory nil async?)))
(defmacro go-try
[& body]
@@ -18,13 +56,6 @@
~@body
(catch Exception e# e#))))
-(defmacro
+
+(ns app.util.services
+ "A helpers and macros for define rpc like registry based services."
+ (:refer-clojure :exclude [defmethod])
+ (:require [app.common.data :as d]))
+
+(defmacro defmethod
+ [sname & body]
+ (let [[mdata args body] (if (map? (first body))
+ [(first body) (first (rest body)) (drop 2 body)]
+ [nil (first body) (rest body)])
+ mdata (assoc mdata
+ ::spec sname
+ ::name (name sname))
+
+ sym (symbol (str "service-method-" (name sname)))]
+ `(do
+ (def ~sym (fn ~args ~@body))
+ (reset-meta! (var ~sym) ~mdata))))
+
+(def nsym-xf
+ (comp
+ (d/domap require)
+ (map find-ns)
+ (mapcat ns-publics)
+ (map second)
+ (filter #(::spec (meta %)))))
+
+(defn scan-ns
+ [& nsyms]
+ (sequence nsym-xf nsyms))
diff --git a/backend/src/app/worker.clj b/backend/src/app/worker.clj
index f90abf192..3d950d6e1 100644
--- a/backend/src/app/worker.clj
+++ b/backend/src/app/worker.clj
@@ -5,105 +5,174 @@
;; 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
+;; Copyright (c) 2020 Andrey Antukh
(ns app.worker
+ "Async tasks abstraction (impl)."
(:require
- [app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
+ [app.config :as cfg]
[app.db :as db]
- [app.tasks.clean-tasks-table]
- [app.tasks.delete-object]
- [app.tasks.delete-profile]
- [app.tasks.file-media-gc]
- [app.tasks.file-xlog-gc]
- [app.tasks.remove-media]
- [app.tasks.sendmail]
[app.util.async :as aa]
[app.util.time :as dt]
[clojure.core.async :as a]
+ [clojure.pprint :refer [pprint]]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
- [mount.core :as mount :refer [defstate]]
+ [cuerdas.core :as str]
+ [integrant.core :as ig]
[promesa.exec :as px])
(:import
org.eclipse.jetty.util.thread.QueuedThreadPool
java.util.concurrent.ExecutorService
java.util.concurrent.Executors
- java.time.Instant))
+ java.util.concurrent.Executor
+ java.time.Duration
+ java.time.Instant
+ java.util.Date))
-(declare start-scheduler-worker!)
-(declare start-worker!)
-(declare thread-pool)
-(declare stop!)
+(s/def ::executor #(instance? Executor %))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Entry Point (state initialization)
+;; Executor
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(def ^:private tasks
- {"delete-profile" #'app.tasks.delete-profile/handler
- "delete-object" #'app.tasks.delete-object/handler
- "remove-media" #'app.tasks.remove-media/handler
- "sendmail" #'app.tasks.sendmail/handler})
+(s/def ::name ::us/string)
+(s/def ::min-threads ::us/integer)
+(s/def ::max-threads ::us/integer)
+(s/def ::idle-timeout ::us/integer)
-(def ^:private schedule
- [{:id "remove-deleted-media"
- :cron #app/cron "0 0 0 */1 * ? *" ;; daily
- :fn #'app.tasks.remove-media/trim-media-storage}
+(defmethod ig/pre-init-spec ::executor [_]
+ (s/keys :opt-un [::min-threads ::max-threads ::idle-timeout ::name]))
- {:id "file-media-gc"
- :cron #app/cron "0 0 0 */1 * ? *" ;; daily
- :fn #'app.tasks.file-media-gc/handler}
+(defmethod ig/prep-key ::executor
+ [_ cfg]
+ (merge {:min-threads 0
+ :max-threads 256
+ :idle-timeout 60000
+ :name "worker"}
+ cfg))
- {:id "file-xlog-gc"
- :cron #app/cron "0 0 0 */1 * ?" ;; daily
- :fn #'app.tasks.file-xlog-gc/handler}
+(defmethod ig/init-key ::executor
+ [_ {:keys [min-threads max-threads idle-timeout name]}]
+ (doto (QueuedThreadPool. (int max-threads)
+ (int min-threads)
+ (int idle-timeout))
+ (.setStopTimeout 500)
+ (.setName name)
+ (.start)))
- {:id "clean-tasks-table"
- :cron #app/cron "0 0 0 */1 * ?" ;; daily
- :fn #'app.tasks.clean-tasks-table/handler}
- ])
-
-(defstate executor
- :start (thread-pool {:min-threads 0
- :max-threads 256})
- :stop (stop! executor))
-
-(defstate worker
- :start (start-worker!
- {:tasks tasks
- :name "worker1"
- :batch-size 1
- :executor executor})
- :stop (stop! worker))
-
-(defstate scheduler-worker
- :start (start-scheduler-worker! {:schedule schedule
- :executor executor})
- :stop (stop! scheduler-worker))
+(defmethod ig/halt-key! ::executor
+ [_ instance]
+ (.stop ^QueuedThreadPool instance))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Tasks Worker Impl
+;; Worker
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(declare event-loop-fn)
+
+(s/def ::queue ::us/string)
+(s/def ::parallelism ::us/integer)
+(s/def ::batch-size ::us/integer)
+(s/def ::tasks (s/map-of string? ::us/fn))
+(s/def ::poll-interval ::dt/duration)
+
+(defmethod ig/pre-init-spec ::worker [_]
+ (s/keys :req-un [::executor
+ ::db/pool
+ ::batch-size
+ ::name
+ ::poll-interval
+ ::queue
+ ::tasks]))
+
+(defmethod ig/prep-key ::worker
+ [_ cfg]
+ (merge {:batch-size 2
+ :name "worker"
+ :poll-interval (dt/duration {:seconds 5})
+ :queue "default"}
+ cfg))
+
+(defmethod ig/init-key ::worker
+ [_ {:keys [pool poll-interval name queue] :as cfg}]
+ (log/infof "Starting worker '%s' on queue '%s'." name queue)
+ (let [cch (a/chan 1)
+ poll-ms (inst-ms poll-interval)]
+ (a/go-loop []
+ (let [[val port] (a/alts! [cch (event-loop-fn cfg)] :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)
+
+ (db/pool-closed? 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 ^java.sql.SQLException val)))
+ (do
+ (log/error "Connection error, trying resume in some instants.")
+ (a/ {:status :retry :task item :error error}
+ (dt/duration? (:delay edata))
+ (assoc :delay (:delay edata))
+
+ (= ::noop (:strategy edata))
+ (assoc :inc-by 0))
+
(do
- (log/warn "no task handler found for" (pr-str name))
- nil))))
+ (log/errorf error
+ (str "Unhandled exception.\n"
+ "=> task: " (:name item) "\n"
+ "=> retry: " (:retry-num item) "\n"
+ "=> props: \n"
+ (with-out-str
+ (pprint (:props item)))))
+ (if (>= (:retry-num item) (:max-retries item))
+ {:status :failed :task item :error error}
+ {:status :retry :task item :error error})))))
(defn- run-task
- [{:keys [tasks]} item]
+ [{: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})))))
+ (handle-exception e item))
(finally
(log/debugf "Finished task '%s/%s/%s'." (:name item) (:id item) (:retry-num item)))))
-(def ^:private
- sql:select-next-tasks
+(def sql:select-next-tasks
"select * from task as t
where t.scheduled_at <= now()
and t.queue = ?
@@ -181,103 +255,69 @@
for update skip locked")
(defn- event-loop-fn*
- [{:keys [executor batch-size] :as opts}]
- (db/with-atomic [conn db/pool]
- (let [queue (:queue opts "default")
+ [{:keys [tasks pool executor batch-size] :as cfg}]
+ (db/with-atomic [conn pool]
+ (let [queue (:queue cfg)
items (->> (db/exec! conn [sql:select-next-tasks queue batch-size])
(map decode-task-row)
(seq))
- opts (assoc opts :conn conn)]
+ cfg (assoc cfg :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))))
+ (let [proc-xf (comp (map #(partial run-task cfg %))
+ (map #(px/submit! executor %)))]
+ (->> (into [] proc-xf items)
+ (map deref)
+ (run! (fn [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)))
+ [{:keys [executor] :as cfg}]
+ (aa/thread-call executor #(event-loop-fn* cfg)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Scheduler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare schedule-task)
+(declare synchronize-schedule)
-(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 ::id ::us/string)
+(s/def ::cron dt/cron?)
+(s/def ::props (s/nilable map?))
-(s/def ::start-worker-params
- (s/keys :req-un [::tasks ::aa/executor ::batch-size]
- :opt-un [::poll-interval]))
+(s/def ::scheduled-task
+ (s/keys :req-un [::id ::cron ::fn]
+ :opt-un [::props]))
-(defn start-worker!
- [{:keys [poll-interval]
- :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"))
+(s/def ::schedule (s/coll-of ::scheduled-task))
- (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/string
[error]
@@ -305,7 +345,7 @@
(.printStackTrace ^Throwable error (java.io.PrintWriter. *out*))))
(defn- execute-scheduled-task
- [{:keys [executor] :as opts} {:keys [id] :as task}]
+ [{:keys [executor pool] :as cfg} {:keys [id] :as task}]
(letfn [(run-task [conn]
(try
(when (db/exec-one! conn [sql:lock-scheduled-task id])
@@ -318,7 +358,7 @@
(let [result (run-task conn)]
(if (instance? Throwable result)
(do
- (log/warnf result "Unhandled exception on scheduled task '%s'." id)
+ (log/warnf result "unhandled exception on scheduled task '%s'" id)
(db/insert! conn :scheduled-task-history
{:id (uuid/next)
:task-id id
@@ -328,75 +368,22 @@
{:id (uuid/next)
:task-id id}))))
(handle-task []
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn pool]
(handle-task* conn)))]
(try
(px/run! executor handle-task)
(finally
- (schedule-task! opts task)))))
+ (schedule-task cfg task)))))
-(defn ms-until-valid
+(defn- ms-until-valid
[cron]
(s/assert dt/cron? cron)
- (let [^Instant now (dt/now)
- ^Instant next (dt/next-valid-instant-from cron now)]
+ (let [now (dt/now)
+ 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}]
+(defn- schedule-task
+ [{:keys [scheduler] :as cfg} {: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 name]
- :or {min-threads 0 max-threads 256}}]
- (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)))
+ (px/schedule! scheduler ms (partial execute-scheduled-task cfg task))))
diff --git a/backend/tests/app/tests/helpers.clj b/backend/tests/app/tests/helpers.clj
index 4ff4232df..957aefbe1 100644
--- a/backend/tests/app/tests/helpers.clj
+++ b/backend/tests/app/tests/helpers.clj
@@ -9,58 +9,54 @@
(ns app.tests.helpers
(:require
+ [expound.alpha :as expound]
+ [app.common.pages :as cp]
+ [app.common.uuid :as uuid]
+ [app.config :as cfg]
+ [app.db :as db]
+ [app.main :as main]
+ [app.media-storage]
+ [app.media]
+ [app.migrations]
+ [app.rpc.mutations.files :as files]
+ [app.rpc.mutations.profile :as profile]
+ [app.rpc.mutations.projects :as projects]
+ [app.rpc.mutations.teams :as teams]
+ [app.util.blob :as blob]
+ [app.util.storage :as ust]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
- [promesa.core :as p]
- [datoteka.core :as fs]
[cuerdas.core :as str]
- [mount.core :as mount]
+ [datoteka.core :as fs]
[environ.core :refer [env]]
- [app.common.pages :as cp]
- [app.services]
- [app.services.mutations.profile :as profile]
- [app.services.mutations.projects :as projects]
- [app.services.mutations.teams :as teams]
- [app.services.mutations.files :as files]
- [app.migrations]
- [app.media]
- [app.media-storage]
- [app.db :as db]
- [app.util.blob :as blob]
- [app.common.uuid :as uuid]
- [app.util.storage :as ust]
- [app.config :as cfg])
+ [integrant.core :as ig]
+ [promesa.core :as p])
(:import org.postgresql.ds.PGSimpleDataSource))
-(defn testing-datasource
- []
- (doto (PGSimpleDataSource.)
- (.setServerName "postgres")
- (.setDatabaseName "penpot_test")
- (.setUser "penpot")
- (.setPassword "penpot")))
+(def ^:dynamic *system* nil)
+(def ^:dynamic *pool* nil)
(defn state-init
[next]
- (let [config (cfg/read-test-config env)]
+ (let [config (-> (main/build-system-config @cfg/test-config)
+ (dissoc :app.srepl/server
+ :app.http/server
+ :app.http/router
+ :app.notifications/handler
+ :app.http.auth/google
+ :app.http.auth/gitlab
+ :app.worker/scheduler
+ :app.worker/executor
+ :app.worker/worker))
+ _ (ig/load-namespaces config)
+ system (-> (ig/prep config)
+ (ig/init))]
(try
- (let [pool (testing-datasource)]
- (-> (mount/only #{#'app.config/config
- #'app.db/pool
- #'app.redis/client
- #'app.redis/conn
- #'app.media/semaphore
- #'app.services/query-services
- #'app.services/mutation-services
- #'app.migrations/migrations
- #'app.media-storage/assets-storage
- #'app.media-storage/media-storage})
- (mount/swap {#'app.config/config config
- #'app.db/pool pool})
- (mount/start)))
- (next)
+ (binding [*system* system
+ *pool* (:app.db/pool system)]
+ (next))
(finally
- (mount/stop)))))
+ (ig/halt! system)))))
(defn database-reset
[next]
@@ -68,7 +64,7 @@
" FROM information_schema.tables "
" WHERE table_schema = 'public' "
" AND table_name != 'migrations';")]
- (db/with-atomic [conn db/pool]
+ (db/with-atomic [conn *pool*]
(let [result (->> (db/exec! conn [sql])
(map :table-name))]
(db/exec! conn [(str "TRUNCATE "
@@ -77,14 +73,12 @@
(try
(next)
(finally
- (ust/clear! app.media-storage/media-storage)
- (ust/clear! app.media-storage/assets-storage))))
+ (ust/clear! (:app.media-storage/storage *system*)))))
(defn mk-uuid
[prefix & args]
(uuid/namespaced uuid/zero (apply str prefix args)))
-;; --- Profile creation
(defn create-profile
[conn i]
@@ -157,12 +151,27 @@
{:error (handle-error e#)
:result nil})))
+
+(defn mutation!
+ [{:keys [::type] :as data}]
+ (let [method-fn (get-in *system* [:app.rpc/rpc :methods :mutation type])]
+ (try-on!
+ (method-fn (dissoc data ::type)))))
+
+(defn query!
+ [{:keys [::type] :as data}]
+ (let [method-fn (get-in *system* [:app.rpc/rpc :methods :query type])]
+ (try-on!
+ (method-fn (dissoc data ::type)))))
+
+;; --- Utils
+
(defn print-error!
[error]
(let [data (ex-data error)]
(cond
(= :spec-validation (:code data))
- (println (:explain data))
+ (expound/printer (:data data))
(= :service-error (:type data))
(print-error! (.getCause ^Throwable error))
diff --git a/backend/tests/app/tests/test_common_geom.clj b/backend/tests/app/tests/test_common_geom.clj
index a333c3275..4c7acd75c 100644
--- a/backend/tests/app/tests/test_common_geom.clj
+++ b/backend/tests/app/tests/test_common_geom.clj
@@ -7,7 +7,7 @@
;;
;; Copyright (c) 2020 UXBOX Labs SL
-(ns app.tests.test_common_geom
+(ns app.tests.test-common-geom
(:require
[clojure.test :as t]
[app.common.geom.point :as gpt]
diff --git a/backend/tests/app/tests/test_common_geom_shapes.clj b/backend/tests/app/tests/test_common_geom_shapes.clj
index 96fb1e669..3048a8903 100644
--- a/backend/tests/app/tests/test_common_geom_shapes.clj
+++ b/backend/tests/app/tests/test_common_geom_shapes.clj
@@ -15,11 +15,12 @@
[app.common.pages :refer [make-minimal-shape]]
[clojure.test :as t]))
-(def default-path [{:command :move-to :params {:x 0 :y 0}}
- {:command :line-to :params {:x 20 :y 20}}
- {:command :line-to :params {:x 30 :y 30}}
- {:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
- {:command :close-path}])
+(def default-path
+ [{:command :move-to :params {:x 0 :y 0}}
+ {:command :line-to :params {:x 20 :y 20}}
+ {:command :line-to :params {:x 30 :y 30}}
+ {:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
+ {:command :close-path}])
(defn add-path-data [shape]
(let [content (:content shape default-path)
@@ -55,7 +56,6 @@
(= shape-before shape-after))
:rect :path))
-
(t/testing "Transform shape with translation modifiers"
(t/are [type]
@@ -139,7 +139,7 @@
(get-in shape-after [:selrect :height])))
(t/is (> (get-in shape-after [:selrect :height]) 0)))
:rect :path))
-
+
(t/testing "Transform shape with rotation modifiers"
(t/are [type]
(let [modifiers {:rotation 30}
diff --git a/backend/tests/app/tests/test_emails.clj b/backend/tests/app/tests/test_emails.clj
index c06315deb..1ab3eca1e 100644
--- a/backend/tests/app/tests/test_emails.clj
+++ b/backend/tests/app/tests/test_emails.clj
@@ -27,21 +27,3 @@
(t/is (contains? result :to))
#_(t/is (contains? result :reply-to))
(t/is (vector? (:body result)))))
-
-;; (t/deftest email-sending-and-sendmail-job
-;; (let [res @(emails/send! emails/register {:to "example@app.io" :name "foo"})]
-;; (t/is (nil? res)))
-;; (with-mock mock
-;; {:target 'app.jobs.sendmail/impl-sendmail
-;; :return (p/resolved nil)}
-
-;; (let [res @(app.jobs.sendmail/send-emails {})]
-;; (t/is (= 1 res))
-;; (t/is (:called? @mock))
-;; (t/is (= 1 (:call-count @mock))))
-
-;; (let [res @(app.jobs.sendmail/send-emails {})]
-;; (t/is (= 0 res))
-;; (t/is (:called? @mock))
-;; (t/is (= 1 (:call-count @mock))))))
-
diff --git a/backend/tests/app/tests/test_services_files.clj b/backend/tests/app/tests/test_services_files.clj
index 4d4977283..9e35f82f8 100644
--- a/backend/tests/app/tests/test_services_files.clj
+++ b/backend/tests/app/tests/test_services_files.clj
@@ -14,8 +14,6 @@
[app.common.uuid :as uuid]
[app.db :as db]
[app.http :as http]
- [app.services.mutations :as sm]
- [app.services.queries :as sq]
[app.tests.helpers :as th]
[app.util.storage :as ust]))
@@ -23,20 +21,20 @@
(t/use-fixtures :each th/database-reset)
(t/deftest files-crud
- (let [prof (th/create-profile db/pool 1)
+ (let [prof (th/create-profile th/*pool* 1)
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
file-id (uuid/next)
page-id (uuid/next)]
(t/testing "create file"
- (let [data {::sm/type :create-file
+ (let [data {::th/type :create-file
:profile-id (:id prof)
:project-id proj-id
:id file-id
- :is-shared false
- :name "test file"}
- out (th/try-on! (sm/handle data))]
+ :name "foobar"
+ :is-shared false}
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -46,11 +44,11 @@
(t/is (= proj-id (:project-id result))))))
(t/testing "rename file"
- (let [data {::sm/type :rename-file
+ (let [data {::th/type :rename-file
:id file-id
:name "new name"
:profile-id (:id prof)}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(let [result (:result out)]
@@ -58,10 +56,10 @@
(t/is (= (:name data) (:name result))))))
(t/testing "query files"
- (let [data {::sq/type :files
+ (let [data {::th/type :files
:project-id proj-id
:profile-id (:id prof)}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -73,10 +71,10 @@
(t/is (= 1 (count (get-in result [0 :data :pages])))))))
(t/testing "query single file without users"
- (let [data {::sq/type :file
+ (let [data {::th/type :file
:profile-id (:id prof)
:id file-id}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -88,38 +86,32 @@
(t/is (nil? (:users result))))))
(t/testing "delete file"
- (let [data {::sm/type :delete-file
+ (let [data {::th/type :delete-file
:id file-id
:profile-id (:id prof)}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(t/testing "query single file after delete"
- (let [data {::sq/type :file
+ (let [data {::th/type :file
:profile-id (:id prof)
:id file-id}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
- (let [error (:error out)
- error-data (ex-data error)]
- (t/is (th/ex-info? error))
- (t/is (= (:type error-data) :service-error))
- (t/is (= (:name error-data) :app.services.queries.files/file)))
-
- (let [error (ex-cause (:error out))
+ (let [error (:error out)
error-data (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found)))))
(t/testing "query list files after delete"
- (let [data {::sq/type :files
+ (let [data {::th/type :files
:project-id proj-id
:profile-id (:id prof)}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
diff --git a/backend/tests/app/tests/test_services_media.clj b/backend/tests/app/tests/test_services_media.clj
index 8b56c48e2..279472802 100644
--- a/backend/tests/app/tests/test_services_media.clj
+++ b/backend/tests/app/tests/test_services_media.clj
@@ -13,8 +13,6 @@
[datoteka.core :as fs]
[app.common.uuid :as uuid]
[app.db :as db]
- [app.services.mutations :as sm]
- [app.services.queries :as sq]
[app.tests.helpers :as th]
[app.util.storage :as ust]))
@@ -22,22 +20,22 @@
(t/use-fixtures :each th/database-reset)
(t/deftest media-crud
- (let [prof (th/create-profile db/pool 1)
+ (let [prof (th/create-profile th/*pool* 1)
team-id (:default-team-id prof)
- proj (th/create-project db/pool (:id prof) team-id 1)
- file (th/create-file db/pool (:id prof) (:id proj) false 1)
+ proj (th/create-project th/*pool* (:id prof) team-id 1)
+ file (th/create-file th/*pool* (:id prof) (:id proj) false 1)
object-id-1 (uuid/next)
object-id-2 (uuid/next)]
(t/testing "create media object from url to file"
(let [url "https://raw.githubusercontent.com/uxbox/uxbox/develop/sample_media/images/unsplash/anna-pelzer.jpg"
- data {::sm/type :add-media-object-from-url
+ data {::th/type :add-media-object-from-url
:id object-id-1
:profile-id (:id prof)
:file-id (:id file)
:is-local true
:url url}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -57,14 +55,14 @@
:tempfile (th/tempfile "app/tests/_files/sample.jpg")
:content-type "image/jpeg"
:size 312043}
- data {::sm/type :upload-media-object
+ data {::th/type :upload-media-object
:id object-id-2
:profile-id (:id prof)
:file-id (:id file)
:is-local true
:name "testfile"
:content content}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -78,71 +76,4 @@
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :thumb-path])))))
- #_(t/testing "list media objects by file"
- (let [data {::sq/type :media-objects
- :profile-id (:id prof)
- :file-id (:id file)
- :is-local true}
- out (th/try-on! (sq/handle data))]
- (th/print-result! out)
-
- ;; Result is ordered by creation date descendent
- (t/is (= object-id-2 (get-in out [:result 0 :id])))
- (t/is (= "testfile" (get-in out [:result 0 :name])))
- (t/is (= "image/jpeg" (get-in out [:result 0 :mtype])))
- (t/is (= 800 (get-in out [:result 0 :width])))
- (t/is (= 800 (get-in out [:result 0 :height])))
-
- (t/is (string? (get-in out [:result 0 :path])))
- (t/is (string? (get-in out [:result 0 :thumb-path])))))
-
- #_(t/testing "single media object"
- (let [data {::sq/type :media-object
- :profile-id (:id prof)
- :id object-id-2}
- out (th/try-on! (sq/handle data))]
- ;; (th/print-result! out)
-
- (t/is (= object-id-2 (get-in out [:result :id])))
- (t/is (= "testfile" (get-in out [:result :name])))
- (t/is (= "image/jpeg" (get-in out [:result :mtype])))
- (t/is (= 800 (get-in out [:result :width])))
- (t/is (= 800 (get-in out [:result :height])))
-
- (t/is (string? (get-in out [:result :path])))))
-
- #_(t/testing "delete media objects"
- (let [data {::sm/type :delete-media-object
- :profile-id (:id prof)
- :id object-id-1}
- out (th/try-on! (sm/handle data))]
-
- ;; (th/print-result! out)
- (t/is (nil? (:error out)))
- (t/is (nil? (:result out)))))
-
- #_(t/testing "query media object after delete"
- (let [data {::sq/type :media-object
- :profile-id (:id prof)
- :id object-id-1}
- out (th/try-on! (sq/handle data))]
-
- ;; (th/print-result! out)
- (let [error (:error out)]
- (t/is (th/ex-info? error))
- (t/is (th/ex-of-type? error :service-error)))
-
- (let [error (ex-cause (:error out))]
- (t/is (th/ex-info? error))
- (t/is (th/ex-of-type? error :not-found)))))
-
- #_(t/testing "query media objects after delete"
- (let [data {::sq/type :media-objects
- :profile-id (:id prof)
- :file-id (:id file)
- :is-local true}
- out (th/try-on! (sq/handle data))]
- ;; (th/print-result! out)
- (let [result (:result out)]
- (t/is (= 1 (count result))))))
))
diff --git a/backend/tests/app/tests/test_services_profile.clj b/backend/tests/app/tests/test_services_profile.clj
index 57e309b67..4d2e6765a 100644
--- a/backend/tests/app/tests/test_services_profile.clj
+++ b/backend/tests/app/tests/test_services_profile.clj
@@ -15,50 +15,44 @@
[cuerdas.core :as str]
[datoteka.core :as fs]
[app.db :as db]
- [app.services.mutations :as sm]
- [app.services.queries :as sq]
- [app.services.mutations.profile :as profile]
+ ;; [app.services.mutations.profile :as profile]
[app.tests.helpers :as th]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest profile-login
- (let [profile (th/create-profile db/pool 1)]
+ (let [profile (th/create-profile th/*pool* 1)]
(t/testing "failed"
- (let [event {::sm/type :login
+ (let [data {::th/type :login
:email "profile1.test@nodomain.com"
:password "foobar"
:scope "foobar"}
- out (th/try-on! (sm/handle event))]
+ out (th/mutation! data)]
- ;; (th/print-result! out)
+ #_(th/print-result! out)
(let [error (:error out)]
- (t/is (th/ex-info? error))
- (t/is (th/ex-of-type? error :service-error)))
-
- (let [error (ex-cause (:error out))]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :wrong-credentials)))))
(t/testing "success"
- (let [event {::sm/type :login
+ (let [data {::th/type :login
:email "profile1.test@nodomain.com"
:password "123123"
:scope "foobar"}
- out (th/try-on! (sm/handle event))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= (:id profile) (get-in out [:result :id])))))))
(t/deftest profile-query-and-manipulation
- (let [profile (th/create-profile db/pool 1)]
+ (let [profile (th/create-profile th/*pool* 1)]
(t/testing "query profile"
- (let [data {::sq/type :profile
+ (let [data {::th/type :profile
:profile-id (:id profile)}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -70,20 +64,21 @@
(t/testing "update profile"
(let [data (assoc profile
- ::sm/type :update-profile
+ :profile-id (:id profile)
+ ::th/type :update-profile
:fullname "Full Name"
:lang "en"
:theme "dark")
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(t/testing "query profile after update"
- (let [data {::sq/type :profile
+ (let [data {::th/type :profile
:profile-id (:id profile)}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -94,25 +89,25 @@
(t/is (= "dark" (:theme result))))))
(t/testing "update photo"
- (let [data {::sm/type :update-profile-photo
+ (let [data {::th/type :update-profile-photo
:profile-id (:id profile)
:file {:filename "sample.jpg"
:size 123123
:tempfile "tests/app/tests/_files/sample.jpg"
:content-type "image/jpeg"}}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
- (t/is (nil? (:error out)))
- ))))
+ (t/is (nil? (:error out)))))
+ ))
#_(t/deftest profile-deletion
- (let [prof (th/create-profile db/pool 1)
+ (let [prof (th/create-profile th/*pool* 1)
team (:default-team prof)
proj (:default-project prof)
- file (th/create-file db/pool (:id prof) (:id proj) 1)
- page (th/create-page db/pool (:id prof) (:id file) 1)]
+ file (th/create-file th/*pool* (:id prof) (:id proj) 1)
+ page (th/create-page th/*pool* (:id prof) (:id file) 1)]
;; (t/testing "try to delete profile not marked for deletion"
;; (let [params {:props {:profile-id (:id prof)}}
@@ -198,14 +193,14 @@
))
-(t/deftest registration-domain-whitelist
- (let [whitelist "gmail.com, hey.com, ya.ru"]
- (t/testing "allowed email domain"
- (t/is (true? (profile/email-domain-in-whitelist? whitelist "username@ya.ru")))
- (t/is (true? (profile/email-domain-in-whitelist? "" "username@somedomain.com"))))
+;; (t/deftest registration-domain-whitelist
+;; (let [whitelist "gmail.com, hey.com, ya.ru"]
+;; (t/testing "allowed email domain"
+;; (t/is (true? (profile/email-domain-in-whitelist? whitelist "username@ya.ru")))
+;; (t/is (true? (profile/email-domain-in-whitelist? "" "username@somedomain.com"))))
- (t/testing "not allowed email domain"
- (t/is (false? (profile/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
+;; (t/testing "not allowed email domain"
+;; (t/is (false? (profile/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
;; TODO: profile deletion with teams
;; TODO: profile deletion with owner teams
diff --git a/backend/tests/app/tests/test_services_projects.clj b/backend/tests/app/tests/test_services_projects.clj
index 91b68326c..a3202eb81 100644
--- a/backend/tests/app/tests/test_services_projects.clj
+++ b/backend/tests/app/tests/test_services_projects.clj
@@ -13,8 +13,6 @@
[promesa.core :as p]
[app.db :as db]
[app.http :as http]
- [app.services.mutations :as sm]
- [app.services.queries :as sq]
[app.tests.helpers :as th]
[app.common.uuid :as uuid]))
@@ -22,17 +20,17 @@
(t/use-fixtures :each th/database-reset)
(t/deftest projects-crud
- (let [prof (th/create-profile db/pool 1)
- team (th/create-team db/pool (:id prof) 1)
+ (let [prof (th/create-profile th/*pool* 1)
+ team (th/create-team th/*pool* (:id prof) 1)
project-id (uuid/next)]
(t/testing "create a project"
- (let [data {::sm/type :create-project
+ (let [data {::th/type :create-project
:id project-id
:profile-id (:id prof)
:team-id (:id team)
:name "test project"}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -40,10 +38,10 @@
(t/is (= (:name data) (:name result))))))
(t/testing "query a list of projects"
- (let [data {::sq/type :projects
+ (let [data {::th/type :projects
:team-id (:id team)
:profile-id (:id prof)}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -53,11 +51,11 @@
(t/is "test project" (get-in result [0 :name])))))
(t/testing "rename project"
- (let [data {::sm/type :rename-project
+ (let [data {::th/type :rename-project
:id project-id
:name "renamed project"
:profile-id (:id prof)}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
@@ -66,20 +64,20 @@
(t/is (= (:profile-id data) (:id prof))))))
(t/testing "delete project"
- (let [data {::sm/type :delete-project
+ (let [data {::th/type :delete-project
:id project-id
:profile-id (:id prof)}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(t/testing "query a list of projects after delete"
- (let [data {::sq/type :projects
+ (let [data {::th/type :projects
:team-id (:id team)
:profile-id (:id prof)}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
diff --git a/backend/tests/app/tests/test_services_viewer.clj b/backend/tests/app/tests/test_services_viewer.clj
index 4b582eda1..d7ba55e5f 100644
--- a/backend/tests/app/tests/test_services_viewer.clj
+++ b/backend/tests/app/tests/test_services_viewer.clj
@@ -13,9 +13,6 @@
[datoteka.core :as fs]
[app.common.uuid :as uuid]
[app.db :as db]
- [app.http :as http]
- [app.services.mutations :as sm]
- [app.services.queries :as sq]
[app.tests.helpers :as th]
[app.util.storage :as ust]))
@@ -23,21 +20,21 @@
(t/use-fixtures :each th/database-reset)
(t/deftest retrieve-bundle
- (let [prof (th/create-profile db/pool 1)
- prof2 (th/create-profile db/pool 2)
+ (let [prof (th/create-profile th/*pool* 1)
+ prof2 (th/create-profile th/*pool* 2)
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
- file (th/create-file db/pool (:id prof) proj-id false 1)
+ file (th/create-file th/*pool* (:id prof) proj-id false 1)
token (atom nil)]
(t/testing "authenticated with page-id"
- (let [data {::sq/type :viewer-bundle
+ (let [data {::th/type :viewer-bundle
:profile-id (:id prof)
:file-id (:id file)
:page-id (get-in file [:data :pages 0])}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -49,11 +46,11 @@
(t/is (contains? result :project)))))
(t/testing "generate share token"
- (let [data {::sm/type :create-file-share-token
+ (let [data {::th/type :create-file-share-token
:profile-id (:id prof)
:file-id (:id file)
:page-id (get-in file [:data :pages 0])}
- out (th/try-on! (sm/handle data))]
+ out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@@ -62,51 +59,45 @@
(reset! token (:token result)))))
(t/testing "not authenticated with page-id"
- (let [data {::sq/type :viewer-bundle
+ (let [data {::th/type :viewer-bundle
:profile-id (:id prof2)
:file-id (:id file)
:page-id (get-in file [:data :pages 0])}
- out (th/try-on! (sq/handle data))]
+ out (th/query! data)]
;; (th/print-result! out)
(let [error (:error out)
error-data (ex-data error)]
(t/is (th/ex-info? error))
- (t/is (= (:type error-data) :service-error))
- (t/is (= (:name error-data) :app.services.queries.viewer/viewer-bundle)))
-
- (let [error (ex-cause (:error out))
- error-data (ex-data error)]
- (t/is (th/ex-info? error))
(t/is (= (:type error-data) :validation))
(t/is (= (:code error-data) :not-authorized)))))
- (t/testing "authenticated with token & profile"
- (let [data {::sq/type :viewer-bundle
- :profile-id (:id prof2)
- :token @token
- :file-id (:id file)
- :page-id (get-in file [:data :pages 0])}
- out (th/try-on! (sq/handle data))]
+ ;; (t/testing "authenticated with token & profile"
+ ;; (let [data {::sq/type :viewer-bundle
+ ;; :profile-id (:id prof2)
+ ;; :token @token
+ ;; :file-id (:id file)
+ ;; :page-id (get-in file [:data :pages 0])}
+ ;; out (th/try-on! (sq/handle data))]
- ;; (th/print-result! out)
+ ;; ;; (th/print-result! out)
- (let [result (:result out)]
- (t/is (contains? result :page))
- (t/is (contains? result :file))
- (t/is (contains? result :project)))))
+ ;; (let [result (:result out)]
+ ;; (t/is (contains? result :page))
+ ;; (t/is (contains? result :file))
+ ;; (t/is (contains? result :project)))))
- (t/testing "authenticated with token"
- (let [data {::sq/type :viewer-bundle
- :token @token
- :file-id (:id file)
- :page-id (get-in file [:data :pages 0])}
- out (th/try-on! (sq/handle data))]
+ ;; (t/testing "authenticated with token"
+ ;; (let [data {::sq/type :viewer-bundle
+ ;; :token @token
+ ;; :file-id (:id file)
+ ;; :page-id (get-in file [:data :pages 0])}
+ ;; out (th/try-on! (sq/handle data))]
- ;; (th/print-result! out)
+ ;; ;; (th/print-result! out)
- (let [result (:result out)]
- (t/is (contains? result :page))
- (t/is (contains? result :file))
- (t/is (contains? result :project)))))
+ ;; (let [result (:result out)]
+ ;; (t/is (contains? result :page))
+ ;; (t/is (contains? result :file))
+ ;; (t/is (contains? result :project)))))
))
diff --git a/common/app/common/data.cljc b/common/app/common/data.cljc
index 972843b5d..e2ceb9a24 100644
--- a/common/app/common/data.cljc
+++ b/common/app/common/data.cljc
@@ -210,6 +210,13 @@
(assoc m key v)
m)))
+(defn domap
+ "A side effect map version."
+ ([f]
+ (map (fn [x] (f x) x)))
+ ([f coll]
+ (map (fn [x] (f x) x) coll)))
+
(defn merge
"A faster merge."
[& maps]
diff --git a/frontend/src/app/main/repo.cljs b/frontend/src/app/main/repo.cljs
index 42f7e4a14..262ca1582 100644
--- a/frontend/src/app/main/repo.cljs
+++ b/frontend/src/app/main/repo.cljs
@@ -46,13 +46,13 @@
(defn send-query!
[id params]
- (let [uri (str cfg/public-uri "/api/w/query/" (name id))]
+ (let [uri (str cfg/public-uri "/api/rpc/query/" (name id))]
(->> (http/send! {:method :get :uri uri :query params})
(rx/mapcat handle-response))))
(defn send-mutation!
[id params]
- (let [uri (str cfg/public-uri "/api/w/mutation/" (name id))]
+ (let [uri (str cfg/public-uri "/api/rpc/mutation/" (name id))]
(->> (http/send! {:method :post :uri uri :body params})
(rx/mapcat handle-response))))
diff --git a/frontend/src/app/worker/thumbnails.cljs b/frontend/src/app/worker/thumbnails.cljs
index 1f2788960..4bcf3cc77 100644
--- a/frontend/src/app/worker/thumbnails.cljs
+++ b/frontend/src/app/worker/thumbnails.cljs
@@ -33,7 +33,7 @@
(defn- request-page
[file-id page-id]
- (let [uri "/api/w/query/page"]
+ (let [uri "/api/rpc/query/page"]
(p/create
(fn [resolve reject]
(->> (http/send! {:uri uri
diff --git a/frontend/test.cljs b/frontend/test.cljs
new file mode 100644
index 000000000..e69de29bb