3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-21 23:26:11 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Replace mount with integrant.

Browse source
This commit is contained in:
Andrey Antukh 2020-12-24 14:32:19 +01:00 • committed by Alonso Torres
parent 31d7aacec1
commit 9f12456456
76 changed files with 2403 additions and 2215 deletions
Download patch file Download diff file Expand all files Collapse all files

5
backend/deps.edn
View file

@ -57,13 +57,14 @@
:exclusions [commons-codec/commons-codec]} :exclusions [commons-codec/commons-codec]}
puppetlabs/clj-ldap {:mvn/version"0.3.0"} puppetlabs/clj-ldap {:mvn/version"0.3.0"}
integrant/integrant {:mvn/version "0.8.0"}
;; exception printing ;; exception printing
io.aviso/pretty {:mvn/version "0.1.37"} io.aviso/pretty {:mvn/version "0.1.37"}
mount/mount {:mvn/version "0.1.16"} mount/mount {:mvn/version "0.1.16"}
environ/environ {:mvn/version "1.2.0"}} environ/environ {:mvn/version "1.2.0"}}
:paths ["src" "resources" "../common" "common"] :paths ["dev" "src" "resources" "../common" "common"]
:aliases :aliases
{:dev {:dev
{:extra-deps {:extra-deps
@ -89,7 +90,7 @@
{:main-opts ["-m" "clj-kondo.main"]} {:main-opts ["-m" "clj-kondo.main"]}
:tests :tests
{:extra-deps {lambdaisland/kaocha {:mvn/version "0.0-581"}} {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.732"}}
:main-opts ["-m" "kaocha.runner"]} :main-opts ["-m" "kaocha.runner"]}
:outdated :outdated

81
backend/tests/user.clj → backend/dev/user.clj
View file

@ -9,23 +9,26 @@
(ns user (ns user
(:require (: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.spec.alpha :as s]
[clojure.test :as test]
[clojure.tools.namespace.repl :as repl] [clojure.tools.namespace.repl :as repl]
[clojure.walk :refer [macroexpand-all]] [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]] [criterium.core :refer [quick-bench bench with-progress-reporting]]
[clj-kondo.core :as kondo] [integrant.core :as ig]))
[app.migrations]
[app.db :as db] (repl/disable-reload! (find-ns 'integrant.core))
[app.metrics :as mtx]
[app.util.storage :as st] (defonce system nil)
[app.util.time :as tm]
[app.util.blob :as blob]
[mount.core :as mount]))
;; --- Benchmarking Tools ;; --- Benchmarking Tools
@ -47,20 +50,6 @@
;; --- Development Stuff ;; --- 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 (defn- run-tests
([] (run-tests #"^app.tests.*")) ([] (run-tests #"^app.tests.*"))
([o] ([o]
@ -75,16 +64,28 @@
(test/test-vars [(resolve o)])) (test/test-vars [(resolve o)]))
(test/test-ns o))))) (test/test-ns o)))))
(defn lint (defn- start
([] (lint "")) []
([path] (alter-var-root #'system (fn [sys]
(-> (kondo/run! (when sys (ig/halt! sys))
{:lint [(str "src/" path)] (-> (main/build-system-config @cfg/config)
:cache false (ig/prep)
:config {:linters (ig/init))))
{:unresolved-symbol :started)
{:exclude ['(app.services.mutations/defmutation)
'(app.services.queries/defquery) (defn- stop
'(app.db/with-atomic) []
'(promesa.core/let)]}}}}) (alter-var-root #'system (fn [sys]
(kondo/print!)))) (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))

2
backend/resources/log4j2.xml
View file

@ -13,7 +13,7 @@
<DefaultRolloverStrategy max="9"/> <DefaultRolloverStrategy max="9"/>
</RollingFile> </RollingFile>
<CljFn name="error-reporter" ns="app.error-reporter" fn="enqueue"> <CljFn name="error-reporter" ns="app.error-reporter" fn="queue-fn">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/> <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
</CljFn> </CljFn>
</Appenders> </Appenders>

45
backend/src/app/cli/fixtures.clj
View file

@ -14,12 +14,12 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.migrations] [app.main :as main]
[app.services.mutations.profile :as profile] [app.rpc.mutations.profile :as profile]
[app.util.blob :as blob] [app.util.blob :as blob]
[buddy.hashers :as hashers] [buddy.hashers :as hashers]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[mount.core :as mount])) [integrant.core :as ig]))
(defn- mk-uuid (defn- mk-uuid
[prefix & args] [prefix & args]
@ -71,7 +71,7 @@
(#'profile/create-profile-relations conn))) (#'profile/create-profile-relations conn)))
(defn impl-run (defn impl-run
[opts] [pool opts]
(let [rng (java.util.Random. 1)] (let [rng (java.util.Random. 1)]
(letfn [(create-profile [conn index] (letfn [(create-profile [conn index]
(let [id (mk-uuid "profile" index) (let [id (mk-uuid "profile" index)
@ -206,33 +206,36 @@
(run! (partial create-draft-file conn profile) (run! (partial create-draft-file conn profile)
(range (:num-draft-files-per-profile opts)))) (range (:num-draft-files-per-profile opts))))
] ]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [profiles (create-profiles conn) (let [profiles (create-profiles conn)
teams (create-teams conn)] teams (create-teams conn)]
(assign-teams-and-profiles conn teams (map :id profiles)) (assign-teams-and-profiles conn teams (map :id profiles))
(run! (partial create-draft-files conn) profiles)))))) (run! (partial create-draft-files conn) profiles))))))
(defn run* (defn run-in-system
[preset] [system preset]
(let [preset (if (map? preset) (let [pool (:app.db/pool system)
preset (if (map? preset)
preset preset
(case preset (case preset
(nil "small" :small) preset-small (nil "small" :small) preset-small
;; "medium" preset-medium ;; "medium" preset-medium
;; "big" preset-big ;; "big" preset-big
preset-small))] preset-small))]
(impl-run preset))) (impl-run pool preset)))
(defn run (defn run
[{:keys [preset] [{:keys [preset] :or {preset :small}}]
:or {preset :small}}] (let [config (select-keys (main/build-system-config cfg/config)
(try [:app.db/pool
(-> (mount/only #{#'app.config/config :app.migrations/migrations
#'app.db/pool :app.metrics/metrics])
#'app.migrations/migrations}) _ (ig/load-namespaces config)
(mount/start)) system (-> (ig/prep config)
(run* preset) (ig/init))]
(catch Exception e (try
(log/errorf e "Unhandled exception.")) (run-in-system system preset)
(finally (catch Exception e
(mount/stop)))) (log/errorf e "Unhandled exception."))
(finally
(ig/halt! system)))))

232
backend/src/app/cli/media_loader.clj
View file

@ -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)))))

42
backend/src/app/config.clj
View file

@ -25,14 +25,12 @@
:database-username "penpot" :database-username "penpot"
:database-password "penpot" :database-password "penpot"
:secret-key "default" :secret-key "default"
:enabled-asserts true
:media-directory "resources/public/media" :media-directory "resources/public/media"
:assets-directory "resources/public/static"
:public-uri "http://localhost:3449/" :public-uri "http://localhost:3449/"
:redis-uri "redis://localhost/0" :redis-uri "redis://localhost/0"
:media-uri "http://localhost:3449/media/" :media-uri "http://localhost:3449/media/"
:assets-uri "http://localhost:3449/static/"
:image-process-max-threads 2 :image-process-max-threads 2
@ -76,11 +74,10 @@
(s/def ::database-password (s/nilable ::us/string)) (s/def ::database-password (s/nilable ::us/string))
(s/def ::database-uri ::us/string) (s/def ::database-uri ::us/string)
(s/def ::redis-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-uri ::us/string)
(s/def ::media-directory ::us/string) (s/def ::media-directory ::us/string)
(s/def ::secret-key ::us/string) (s/def ::secret-key ::us/string)
(s/def ::enable-asserts ::us/boolean)
(s/def ::host ::us/string) (s/def ::host ::us/string)
(s/def ::error-report-webhook ::us/string) (s/def ::error-report-webhook ::us/string)
@ -132,13 +129,12 @@
::gitlab-client-id ::gitlab-client-id
::gitlab-client-secret ::gitlab-client-secret
::gitlab-base-uri ::gitlab-base-uri
::enable-asserts
::redis-uri ::redis-uri
::public-uri ::public-uri
::database-username ::database-username
::database-password ::database-password
::database-uri ::database-uri
::assets-directory
::assets-uri
::media-directory ::media-directory
::media-uri ::media-uri
::error-report-webhook ::error-report-webhook
@ -200,8 +196,11 @@
:assets-directory "/tmp/app/static" :assets-directory "/tmp/app/static"
:migrations-verbose false)) :migrations-verbose false))
(defstate config (def config
:start (read-config env)) (delay (read-config env)))
(def test-config
(delay (read-test-config env)))
(def default-deletion-delay (def default-deletion-delay
(dt/duration {:hours 48})) (dt/duration {:hours 48}))
@ -209,14 +208,19 @@
(def version (def version
(delay (v/parse "%version%"))) (delay (v/parse "%version%")))
(defn smtp ;; (defmethod ig/init-key ::secrets
[cfg] ;; [type {:keys [key] :as opts}]
{:host (:smtp-host cfg "localhost") ;; (when (= key "default")
:port (:smtp-port cfg 25) ;; (log/warn "Using default SECRET-KEY, system will generate insecure tokens."))
:default-reply-to (:smtp-default-reply-to cfg) ;; {:key key
:default-from (:smtp-default-from cfg) ;; :factory
:tls (:smtp-tls cfg) ;; (fn [salt length]
:enabled (:smtp-enabled cfg) ;; (let [engine (bk/engine {:key key
:username (:smtp-username cfg) ;; :salt (name salt)
:password (:smtp-password cfg)}) ;; :alg :hkdf
;; :digest :blake2b-512})]
;; (bk/get-bytes engine length)))})
(prefer-method print-method
clojure.lang.IRecord
clojure.lang.IDeref)

81
backend/src/app/db.clj
View file

@ -9,16 +9,16 @@
(ns app.db (ns app.db
(:require (:require
[app.common.spec :as us]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.config :as cfg] [app.config :as cfg]
[app.metrics :as mtx]
[app.util.time :as dt] [app.util.time :as dt]
[app.util.transit :as t] [app.util.transit :as t]
[clojure.data.json :as json] [clojure.data.json :as json]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.string :as str] [clojure.string :as str]
[mount.core :as mount :refer [defstate]] [integrant.core :as ig]
[next.jdbc :as jdbc] [next.jdbc :as jdbc]
[next.jdbc.date-time :as jdbc-dt] [next.jdbc.date-time :as jdbc-dt]
[next.jdbc.optional :as jdbc-opt] [next.jdbc.optional :as jdbc-opt]
@ -35,30 +35,65 @@
org.postgresql.util.PGInterval org.postgresql.util.PGInterval
org.postgresql.util.PGobject)) 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 (def initsql
(str "SET statement_timeout = 10000;\n" (str "SET statement_timeout = 10000;\n"
"SET idle_in_transaction_session_timeout = 30000;")) "SET idle_in_transaction_session_timeout = 30000;"))
(defn- create-datasource-config (defn- create-datasource-config
[cfg] [{:keys [metrics] :as cfg}]
(let [dburi (:database-uri cfg) (let [dburi (:uri cfg)
username (:database-username cfg) username (:username cfg)
password (:database-password cfg) password (:password cfg)
config (HikariConfig.) config (HikariConfig.)
mfactory (PrometheusMetricsTrackerFactory. mtx/registry)] mtf (PrometheusMetricsTrackerFactory. (:registry metrics))]
(doto config (doto config
(.setJdbcUrl (str "jdbc:" dburi)) (.setJdbcUrl (str "jdbc:" dburi))
(.setPoolName "main") (.setPoolName (:name cfg "default"))
(.setAutoCommit true) (.setAutoCommit true)
(.setReadOnly false) (.setReadOnly false)
(.setConnectionTimeout 8000) ;; 8seg (.setConnectionTimeout 8000) ;; 8seg
(.setValidationTimeout 4000) ;; 4seg (.setValidationTimeout 8000) ;; 8seg
(.setIdleTimeout 300000) ;; 5min (.setIdleTimeout 120000) ;; 2min
(.setMaxLifetime 900000) ;; 15min (.setMaxLifetime 1800000) ;; 30min
(.setMinimumIdle 0) (.setMinimumIdle (:min-pool-size cfg 0))
(.setMaximumPoolSize 15) (.setMaximumPoolSize (:max-pool-size cfg 30))
(.setMetricsTrackerFactory mtf)
(.setConnectionInitSql initsql) (.setConnectionInitSql initsql)
(.setMetricsTrackerFactory mfactory)) (.setInitializationFailTimeout -1))
(when username (.setUsername config username)) (when username (.setUsername config username))
(when password (.setPassword config password)) (when password (.setPassword config password))
config)) config))
@ -79,12 +114,6 @@
(jdbc-dt/read-as-instant) (jdbc-dt/read-as-instant)
(HikariDataSource. dsc))) (HikariDataSource. dsc)))
(declare pool)
(defstate pool
:start (create-pool cfg/config)
:stop (.close pool))
(defmacro with-atomic (defmacro with-atomic
[& args] [& args]
`(jdbc/with-transaction ~@args)) `(jdbc/with-transaction ~@args))
@ -96,7 +125,7 @@
(jdbc-opt/as-unqualified-modified-maps rs (assoc opts :label-fn kebab-case))) (jdbc-opt/as-unqualified-modified-maps rs (assoc opts :label-fn kebab-case)))
(defn open (defn open
[] [pool]
(jdbc/get-connection pool)) (jdbc/get-connection pool))
(defn exec! (defn exec!
@ -258,11 +287,3 @@
(defn pgarray->vector (defn pgarray->vector
[v] [v]
(vec (.getArray ^PgArray 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."})

95
backend/src/app/error_reporter.clj
View file

@ -16,68 +16,71 @@
[app.db :as db] [app.db :as db]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.async :as aa] [app.util.async :as aa]
[app.worker :as wrk] [app.util.emails :as emails]
[app.util.http :as http]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.data.json :as json] [clojure.data.json :as json]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[cuerdas.core :as str] [cuerdas.core :as str]
[mount.core :as mount :refer [defstate]] [integrant.core :as ig]
[promesa.exec :as px])) [promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API ;; Error Reporting
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defonce enqueue identity) (declare send-notification!)
(defonce queue-fn identity)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (s/def ::http-client fn?)
;; Implementation (s/def ::uri (s/nilable ::us/uri))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- send-to-mattermost! (defmethod ig/pre-init-spec ::instance [_]
[log-event] (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/<! out)]
(if (nil? val)
(log/info "Closing error reporting loop.")
(do
(px/run! executor #(send-notification! cfg val))
(recur))))))
(log/info "No webhook uri is provided (error reporting becomes noop)."))
out))
(defmethod ig/halt-key! ::instance
[_ out]
(alter-var-root #'queue-fn (constantly identity))
(a/close! out))
(defn send-notification!
[cfg report]
(try (try
(let [text (str/fmt "Unhandled exception: `host='%s'`, `version=%s`.\n@channel ⇊\n```%s\n```" (let [send! (:http-client cfg)
(:host cfg/config) uri (:uri cfg)
(:full @cfg/version)
(str log-event))
rsp (http/send! {:uri (:error-reporter-webhook cfg/config) prefix (str/<< "Unhandled exception (@channel):\n"
:method :post "- host: `~(:host cfg/config)`\n"
:headers {"content-type" "application/json"} "- version: `~(:full cfg/version)`")
:body (json/write-str {:text text})})] text (str prefix "\n```" report "\n```")
rsp (send! {:uri uri
:method :post
:headers {"content-type" "application/json"}
:body (json/write-str {:text text})})]
(when (not= (:status rsp) 200) (when (not= (:status rsp) 200)
(log/warnf "Error reporting webhook replying with unexpected status: %s\n%s" (log/warnf "Error reporting webhook replying with unexpected status: %s\n%s"
(:status rsp) (:status rsp)
(pr-str rsp)))) (pr-str rsp))))
(catch Exception e (catch Exception e
(log/warnf e "Unexpected exception on error reporter.")))) (log/warnf e "Unexpected exception on error reporter."))))
(defn- send!
[val]
(aa/thread-call wrk/executor (partial send-to-mattermost! val)))
(defn- start
[]
(let [qch (a/chan (a/sliding-buffer 128))]
(log/info "Starting error reporter loop.")
;; Only enable when a valid URL is provided.
(when (:error-reporter-webhook cfg/config)
(alter-var-root #'enqueue (constantly #(a/>!! qch %)))
(a/go-loop []
(let [val (a/<! qch)]
(if (nil? val)
(do
(log/info "Closing error reporting loop.")
(alter-var-root #'enqueue (constantly identity)))
(do
(a/<! (send! val))
(recur))))))
qch))
(defstate reporter
:start (start)
:stop (a/close! reporter))

113
backend/src/app/http.clj
View file

@ -9,26 +9,73 @@
(ns app.http (ns app.http
(:require (:require
[clojure.pprint]
[app.config :as cfg] [app.config :as cfg]
[app.http.auth :as auth] [app.http.auth :as auth]
[app.http.auth.gitlab :as gitlab] ;; [app.http.auth.gitlab :as gitlab]
[app.http.auth.google :as google] [app.http.auth.google :as google]
[app.http.auth.ldap :as ldap] ;; [app.http.auth.ldap :as ldap]
[app.http.errors :as errors] [app.http.errors :as errors]
[app.http.handlers :as handlers]
[app.http.middleware :as middleware] [app.http.middleware :as middleware]
[app.http.session :as session] ;; [app.http.ws :as ws]
[app.http.ws :as ws]
[app.metrics :as mtx] [app.metrics :as mtx]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]] [integrant.core :as ig]
[reitit.ring :as rring] [clojure.spec.alpha :as s]
[ring.adapter.jetty9 :as jetty])) [reitit.ring :as rr]
[ring.adapter.jetty9 :as jetty])
(:import
org.eclipse.jetty.server.handler.ErrorHandler))
(defmethod ig/init-key ::server
[_ {:keys [router ws port] :as opts}]
(log/info "Starting http server.")
(let [options {:port port
:h2c? true
:join? false
:allow-null-path-info true
:websockets ws}
server (jetty/run-jetty router options)
handler (doto (ErrorHandler.)
(.setShowStacks true)
(.setServer server))]
(.setErrorHandler server handler)
server))
(defmethod ig/halt-key! ::server
[_ server]
(log/info "Stoping http server." server)
(.stop server))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Http Main Handler (Router)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare create-router)
(s/def ::rpc map?)
(s/def ::session map?)
(s/def ::metrics map?)
(s/def ::google-auth map?)
(s/def ::gitlab-auth map?)
(s/def ::ldap-auth fn?)
(defmethod ig/pre-init-spec ::router [_]
(s/keys :req-un [::rpc ::session ::metrics ::google-auth ::gitlab-auth]))
(defmethod ig/init-key ::router
[_ cfg]
(rr/ring-handler
(create-router cfg)
(rr/routes
(rr/create-resource-handler {:path "/"})
(rr/create-default-handler))))
(defn- create-router (defn- create-router
[] [{:keys [session rpc google-auth gitlab-auth metrics ldap-auth] :as cfg}]
(rring/router (rr/router
[["/metrics" {:get mtx/dump}] [["/metrics" {:get (:handler metrics)}]
["/api" {:middleware [[middleware/format-response-body] ["/api" {:middleware [[middleware/format-response-body]
[middleware/parse-request-body] [middleware/parse-request-body]
[middleware/errors errors/handle] [middleware/errors errors/handle]
@ -37,43 +84,21 @@
[middleware/keyword-params] [middleware/keyword-params]
[middleware/cookies]]} [middleware/cookies]]}
["/svg" {:post handlers/parse-svg}] ;; ["/svg" {:post handlers/parse-svg}]
["/oauth" ["/oauth"
["/google" {:post google/auth}] ["/google" {:post (:auth-handler google-auth)}]
["/google/callback" {:get google/callback}] ["/google/callback" {:get (:callback-handler google-auth)}]
["/gitlab" {:post gitlab/auth}]
["/gitlab/callback" {:get gitlab/callback}]]
["/echo" {:get handlers/echo-handler ["/gitlab" {:post (:auth-handler gitlab-auth)}]
:post handlers/echo-handler}] ["/gitlab/callback" {:get (:callback-handler gitlab-auth)}]]
["/login" {:post auth/login-handler}] ["/login" {:post #(auth/login-handler cfg %)}]
["/logout" {:post auth/logout-handler}] ["/logout" {:post #(auth/logout-handler cfg %)}]
["/login-ldap" {:post ldap/auth}]
["/w" {:middleware [session/middleware]} ["/login-ldap" {:post ldap-auth}]
["/query/:type" {:get handlers/query-handler}]
["/mutation/:type" {:post handlers/mutation-handler}]]]]))
(defn start-server ["/rpc" {:middleware [(:middleware session)]}
[] ["/query/:type" {:get (:query-handler rpc)}]
(let [wsockets {"/ws/notifications" ws/handler} ["/mutation/:type" {:post (:mutation-handler rpc)}]]]]))
options {:port (:http-server-port cfg/config)
:h2c? true
:join? false
:allow-null-path-info true
:websockets wsockets}
handler (rring/ring-handler
(create-router)
(constantly {:status 404, :body ""})
{:middleware [[middleware/development-resources]
[middleware/development-cors]
[middleware/metrics]]})]
(log/infof "Http server listening on http://localhost:%s/"
(:http-server-port cfg/config))
(jetty/run-jetty handler options)))
(defstate server
:start (start-server)
:stop (.stop server))

24
backend/src/app/http/auth.clj
View file

@ -9,23 +9,23 @@
(ns app.http.auth (ns app.http.auth
(:require (:require
[app.http.session :as session] [app.http.session :as session]))
[app.services.mutations :as sm]))
(defn login-handler (defn login-handler
[req] [{:keys [session rpc] :as cfg} request]
(let [data (:body-params req) (let [data (:params request)
uagent (get-in req [:headers "user-agent"]) uagent (get-in request [:headers "user-agent"])
profile (sm/handle (assoc data ::sm/type :login)) method (get-in rpc [:methods :mutation :login])
id (session/create (:id profile) uagent)] profile (method data)
id (session/create! session {:profile-id (:id profile)
:user-agent uagent})]
{:status 200 {:status 200
:cookies (session/cookies id) :cookies (session/cookies session {:value id})
:body profile})) :body profile}))
(defn logout-handler (defn logout-handler
[req] [{:keys [session] :as cfg} request]
(some-> (session/extract-auth-token req) (session/delete! cfg request)
(session/delete))
{:status 200 {:status 200
:cookies (session/cookies "" {:max-age -1}) :cookies (session/cookies session {:value "" :max-age -1})
:body ""}) :body ""})

117
backend/src/app/http/auth/gitlab.clj
View file

@ -10,54 +10,53 @@
(ns app.http.auth.gitlab (ns app.http.auth.gitlab
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.data :as d]
[app.config :as cfg] [app.config :as cfg]
[app.http.session :as session] [app.http.session :as session]
[app.services.mutations :as sm]
[app.services.tokens :as tokens]
[app.util.http :as http] [app.util.http :as http]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.data.json :as json] [clojure.data.json :as json]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[integrant.core :as ig]
[lambdaisland.uri :as uri])) [lambdaisland.uri :as uri]))
(def default-base-gitlab-uri "https://gitlab.com")
(def scope "read_user") (def scope "read_user")
(defn- build-redirect-url (defn- build-redirect-url
[] [cfg]
(let [public (uri/uri (:public-uri cfg/config))] (let [public (uri/uri (:public-uri cfg))]
(str (assoc public :path "/api/oauth/gitlab/callback")))) (str (assoc public :path "/api/oauth/gitlab/callback"))))
(defn- build-oauth-uri (defn- build-oauth-uri
[] [cfg]
(let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))] (let [base-uri (uri/uri (:base-uri cfg))]
(assoc base-uri :path "/oauth/authorize"))) (assoc base-uri :path "/oauth/authorize")))
(defn- build-token-url (defn- build-token-url
[] [cfg]
(let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))] (let [base-uri (uri/uri (:base-uri cfg))]
(str (assoc base-uri :path "/oauth/token")))) (str (assoc base-uri :path "/oauth/token"))))
(defn- build-user-info-url (defn- build-user-info-url
[] [cfg]
(let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))] (let [base-uri (uri/uri (:base-uri cfg))]
(str (assoc base-uri :path "/api/v4/user")))) (str (assoc base-uri :path "/api/v4/user"))))
(defn- get-access-token (defn- get-access-token
[code] [cfg code]
(let [params {:client_id (:gitlab-client-id cfg/config) (let [params {:client_id (:client-id cfg)
:client_secret (:gitlab-client-secret cfg/config) :client_secret (:client-secret cfg)
:code code :code code
:grant_type "authorization_code" :grant_type "authorization_code"
:redirect_uri (build-redirect-url)} :redirect_uri (build-redirect-url cfg)}
req {:method :post req {:method :post
:headers {"content-type" "application/x-www-form-urlencoded"} :headers {"content-type" "application/x-www-form-urlencoded"}
:uri (build-token-url) :uri (build-token-url cfg)
:body (uri/map->query-string params)} :body (uri/map->query-string params)}
res (http/send! req)] res (http/send! req)]
@ -98,12 +97,11 @@
nil)))) nil))))
(defn auth (defn auth
[_req] [{:keys [tokens] :as cfg} _request]
(let [token (tokens/generate (let [token (tokens :generate {:iss :gitlab-oauth
{:iss :gitlab-oauth :exp (dt/in-future "15m")})
:exp (dt/in-future "15m")})
params {:client_id (:gitlab-client-id cfg/config) params {:client_id (:client-id cfg)
:redirect_uri (build-redirect-url) :redirect_uri (build-redirect-url)
:response_type "code" :response_type "code"
:state token :state token
@ -115,33 +113,68 @@
:body {:redirect-uri (str uri)}})) :body {:redirect-uri (str uri)}}))
(defn callback (defn callback
[req] [{:keys [tokens rpc session] :as cfg} request]
(let [token (get-in req [:params :state]) (let [token (get-in request [:params :state])
_ (tokens/verify token {:iss :gitlab-oauth}) _ (tokens :verify {:token token :iss :gitlab-oauth})
info (some-> (get-in req [:params :code]) info (some->> (get-in request [:params :code])
(get-access-token) (get-access-token cfg)
(get-user-info))] (get-user-info))]
(when-not info (when-not info
(ex/raise :type :authentication (ex/raise :type :authentication
:code :unable-to-authenticate-with-gitlab)) :code :unable-to-authenticate-with-gitlab))
(let [profile (sm/handle {::sm/type :login-or-register (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
:email (:email info) profile (method-fn {:email (:email info)
:fullname (:fullname info)}) :fullname (:fullname info)})
uagent (get-in req [:headers "user-agent"]) uagent (get-in request [:headers "user-agent"])
token (tokens/generate token (tokens :generate {:iss :auth
{:iss :auth :exp (dt/in-future "15m")
:exp (dt/in-future "15m") :profile-id (:id profile)})
:profile-id (:id profile)})
uri (-> (uri/uri (:public-uri cfg/config)) uri (-> (uri/uri (:public-uri cfg))
(assoc :path "/#/auth/verify-token") (assoc :path "/#/auth/verify-token")
(assoc :query (uri/map->query-string {:token token}))) (assoc :query (uri/map->query-string {:token token})))
sid (session/create (:id profile) uagent)]
sid (session/create! session {:profile-id (:id profile)
:user-agent uagent})]
{:status 302 {:status 302
:headers {"location" (str uri)} :headers {"location" (str uri)}
:cookies (session/cookies sid) :cookies (session/cookies session {:value sid})
:body ""}))) :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}))

94
backend/src/app/http/auth/google.clj
View file

@ -10,14 +10,15 @@
(ns app.http.auth.google (ns app.http.auth.google
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us]
[app.config :as cfg] [app.config :as cfg]
[app.http.session :as session] [app.http.session :as session]
[app.services.mutations :as sm]
[app.services.tokens :as tokens]
[app.util.http :as http] [app.util.http :as http]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.data.json :as json] [clojure.data.json :as json]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[integrant.core :as ig]
[lambdaisland.uri :as uri])) [lambdaisland.uri :as uri]))
(def base-goauth-uri "https://accounts.google.com/o/oauth2/v2/auth") (def base-goauth-uri "https://accounts.google.com/o/oauth2/v2/auth")
@ -29,16 +30,16 @@
"openid")) "openid"))
(defn- build-redirect-url (defn- build-redirect-url
[] [cfg]
(let [public (uri/uri (:public-uri cfg/config))] (let [public (uri/uri (:public-uri cfg))]
(str (assoc public :path "/api/oauth/google/callback")))) (str (assoc public :path "/api/oauth/google/callback"))))
(defn- get-access-token (defn- get-access-token
[code] [cfg code]
(let [params {:code code (let [params {:code code
:client_id (:google-client-id cfg/config) :client_id (:client-id cfg)
:client_secret (:google-client-secret cfg/config) :client_secret (:client-secret cfg)
:redirect_uri (build-redirect-url) :redirect_uri (build-redirect-url cfg)
:grant_type "authorization_code"} :grant_type "authorization_code"}
req {:method :post req {:method :post
:headers {"content-type" "application/x-www-form-urlencoded"} :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) (log/error "unexpected error on parsing response body from google access token request" e)
nil)))) nil))))
(defn- get-user-info (defn- get-user-info
[token] [token]
(let [req {:uri "https://openidconnect.googleapis.com/v1/userinfo" (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) (log/error "unexpected error on parsing response body from google access token request" e)
nil)))) nil))))
(defn auth (defn- auth
[_req] [{:keys [tokens] :as cfg} _req]
(let [token (tokens/generate {:iss :google-oauth :exp (dt/in-future "15m")}) (let [token (tokens :generate {:iss :google-oauth :exp (dt/in-future "15m")})
params {:scope scope params {:scope scope
:access_type "offline" :access_type "offline"
:include_granted_scopes true :include_granted_scopes true
:state token :state token
:response_type "code" :response_type "code"
:redirect_uri (build-redirect-url) :redirect_uri (build-redirect-url)
:client_id (:google-client-id cfg/config)} :client_id (:client-id cfg)}
query (uri/map->query-string params) query (uri/map->query-string params)
uri (-> (uri/uri base-goauth-uri) uri (-> (uri/uri base-goauth-uri)
(assoc :query query))] (assoc :query query))]
{:status 200 {:status 200
:body {:redirect-uri (str uri)}})) :body {:redirect-uri (str uri)}}))
(defn- callback
(defn callback [{:keys [tokens rpc session] :as cfg} request]
[req] (let [token (get-in request [:params :state])
(let [token (get-in req [:params :state]) _ (tokens :verify {:token token :iss :google-oauth})
_ (tokens/verify token {:iss :google-oauth}) info (some->> (get-in request [:params :code])
info (some-> (get-in req [:params :code]) (get-access-token cfg)
(get-access-token) (get-user-info))]
(get-user-info))]
(when-not info (when-not info
(ex/raise :type :authentication (ex/raise :type :authentication
:code :unable-to-authenticate-with-google)) :code :unable-to-authenticate-with-google))
(let [profile (sm/handle {::sm/type :login-or-register (let [method-fn (get-in rpc [:method :mutations :login-or-register])
:email (:email info) profile (method-fn {:email (:email info)
:fullname (:fullname info)}) :fullname (:fullname info)})
uagent (get-in req [:headers "user-agent"]) uagent (get-in request [:headers "user-agent"])
token (tokens :generate {:iss :auth
token (tokens/generate :exp (dt/in-future "15m")
{:iss :auth :profile-id (:id profile)})
: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 {:status 302
:headers {"location" (str uri)} :headers {"location" (str uri)}
:cookies (session/cookies sid) :cookies (session/cookies session {:value sid})
:body ""}))) :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}))

147
backend/src/app/http/auth/ldap.clj
View file

@ -12,50 +12,110 @@
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.config :as cfg] [app.config :as cfg]
[app.http.session :as session] [app.http.session :as session]
[app.services.mutations :as sm]
[clj-ldap.client :as client] [clj-ldap.client :as client]
[clojure.set :as set] [clojure.set :as set]
[clojure.string] [clojure.spec.alpha :as s]
[clojure.string ]
[clojure.tools.logging :as log] [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)) (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] (defn- authenticate
(when-some [conn (some-> *ldap-pool deref)] [{:keys [conn username password] :as cfg}]
(let [user-search-query (replace-several (:ldap-auth-user-query cfg/config) (when-some [conn (some-> conn deref)]
"$username" username) (let [user-search-query (replace-several (:user-query cfg) "$username" username)
user-attributes (-> cfg/config user-attributes (-> cfg
(select-keys [:ldap-auth-username-attribute (select-keys [:username-attribute
:ldap-auth-email-attribute :email-attribute
:ldap-auth-fullname-attribute :fullname-attribute
:ldap-auth-avatar-attribute]) :avatar-attribute])
vals)] vals)]
(when-some [user-entry (-> conn (when-some [user-entry (-> conn
(client/search (:ldap-auth-base-dn cfg/config) (client/search (:base-dn cfg)
{:filter user-search-query {:filter user-search-query
:sizelimit 1 :sizelimit 1
:attributes user-attributes}) :attributes user-attributes})
@ -63,18 +123,7 @@
(when-not (client/bind? conn (:dn user-entry) password) (when-not (client/bind? conn (:dn user-entry) password)
(ex/raise :type :authentication (ex/raise :type :authentication
:code :wrong-credentials)) :code :wrong-credentials))
(set/rename-keys user-entry {(keyword (:ldap-auth-avatar-attribute cfg/config)) :photo (set/rename-keys user-entry {(keyword (:avatar-attribute cfg)) :photo
(keyword (:ldap-auth-fullname-attribute cfg/config)) :fullname (keyword (:fullname-attribute cfg)) :fullname
(keyword (:ldap-auth-email-attribute cfg/config)) :email}))))) (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}))))

116
backend/src/app/http/handlers.clj
View file

@ -8,7 +8,7 @@
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.http.handlers (ns app.http.handlers
(:require #_(:require
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.emails :as emails] [app.emails :as emails]
@ -18,69 +18,61 @@
[app.services.queries :as sq] [app.services.queries :as sq]
[app.services.svgparse :as svgp])) [app.services.svgparse :as svgp]))
(def unauthorized-services ;; (def unauthorized-services
#{:create-demo-profile ;; #{:create-demo-profile
:logout ;; :logout
:profile ;; :profile
:verify-token ;; :verify-token
:recover-profile ;; :recover-profile
:register-profile ;; :register-profile
:request-profile-recovery ;; :request-profile-recovery
:viewer-bundle ;; :viewer-bundle
:login}) ;; :login})
(defn query-handler ;; (defn query-handler
[{:keys [profile-id] :as request}] ;; [cfg {:keys [profile-id] :as request}]
(let [type (keyword (get-in request [:path-params :type])) ;; (let [type (keyword (get-in request [:path-params :type]))
data (assoc (:params request) ::sq/type type) ;; data (assoc (:params request) ::sq/type type)
data (if profile-id ;; data (if profile-id
(assoc data :profile-id profile-id) ;; (assoc data :profile-id profile-id)
(dissoc data :profile-id))] ;; (dissoc data :profile-id))]
(if (or (uuid? profile-id) ;; (if (or (uuid? profile-id)
(contains? unauthorized-services type)) ;; (contains? unauthorized-services type))
{:status 200 ;; {:status 200
:body (sq/handle (with-meta data {:req request}))} ;; :body (sq/handle (with-meta data {:req request}))}
{:status 403 ;; {:status 403
:body {:type :authentication ;; :body {:type :authentication
:code :unauthorized}}))) ;; :code :unauthorized}})))
(defn mutation-handler ;; (defn mutation-handler
[{:keys [profile-id] :as request}] ;; [cfg {:keys [profile-id] :as request}]
(let [type (keyword (get-in request [:path-params :type])) ;; (let [type (keyword (get-in request [:path-params :type]))
data (d/merge (:params request) ;; data (d/merge (:params request)
(:body-params request) ;; (:body-params request)
(:uploads request) ;; (:uploads request)
{::sm/type type}) ;; {::sm/type type})
data (if profile-id ;; data (if profile-id
(assoc data :profile-id profile-id) ;; (assoc data :profile-id profile-id)
(dissoc data :profile-id))] ;; (dissoc data :profile-id))]
(if (or (uuid? profile-id) ;; (if (or (uuid? profile-id)
(contains? unauthorized-services type)) ;; (contains? unauthorized-services type))
(let [result (sm/handle (with-meta data {:req request})) ;; (let [result (sm/handle (with-meta data {:req request}))
mdata (meta result) ;; mdata (meta result)
resp {:status (if (nil? (seq result)) 204 200) ;; resp {:status (if (nil? (seq result)) 204 200)
:body result}] ;; :body result}]
(cond->> resp ;; (cond->> resp
(:transform-response mdata) ((:transform-response mdata) request))) ;; (:transform-response mdata) ((:transform-response mdata) request)))
{:status 403 ;; {:status 403
:body {:type :authentication ;; :body {:type :authentication
:code :unauthorized}}))) ;; :code :unauthorized}})))
(defn echo-handler ;; (defn parse-svg
[req] ;; [{:keys [headers body] :as request}]
{:status 200 ;; (when (not= "image/svg+xml" (get headers "content-type"))
:body {:params (:params req) ;; (ex/raise :type :validation
:cookies (:cookies req) ;; :code :unsupported-mime-type
:headers (:headers req)}}) ;; :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)})

4
backend/src/app/http/middleware.clj
View file

@ -37,7 +37,7 @@
:json (parse-json body) :json (parse-json body)
:transit (parse-transit body)) :transit (parse-transit body))
(catch Exception e (catch Exception e
(let [type (if (:debug cfg/config) :json-verbose :json) (let [type (if (:debug @cfg/config) :json-verbose :json)
data {:type :parse data {:type :parse
:hint "unable to parse request body" :hint "unable to parse request body"
:message (ex-message e)}] :message (ex-message e)}]
@ -70,7 +70,7 @@
(defn- impl-format-response-body (defn- impl-format-response-body
[response] [response]
(let [body (:body response) (let [body (:body response)
type (if (:debug cfg/config) :json-verbose :json)] type (if (:debug @cfg/config) :json-verbose :json)]
(cond (cond
(coll? body) (coll? body)
(-> response (-> response

77
backend/src/app/http/session.clj
View file

@ -7,60 +7,65 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
;; TODO: move to services.
(ns app.http.session (ns app.http.session
(:require (:require
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[app.db :as db] [app.db :as db]
[buddy.core.codecs :as bc] [buddy.core.codecs :as bc]
[buddy.core.nonce :as bn])) [buddy.core.nonce :as bn]))
(defn next-token (defn next-session-id
[n] ([] (next-session-id 96))
(-> (bn/random-nonce n) ([n]
(bc/bytes->b64u) (-> (bn/random-nonce n)
(bc/bytes->str))) (bc/bytes->b64u)
(bc/bytes->str))))
(defn extract-auth-token (defn create!
[request] [{:keys [conn] :as cfg} {:keys [profile-id user-agent]}]
(get-in request [:cookies "auth-token" :value])) (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 (defn retrieve
[conn token] [{:keys [conn] :as cfg} token]
(when token (when token
(-> (db/exec-one! conn ["select profile_id from http_session where id = ?" token]) (-> (db/exec-one! conn ["select profile_id from http_session where id = ?" token])
(:profile-id)))) (:profile-id))))
(defn retrieve-from-request (defn retrieve-from-request
[conn request] [{:keys [cookie-name] :as cfg} request]
(->> (extract-auth-token request) (->> (get-in request [:cookies cookie-name :value])
(retrieve conn))) (retrieve cfg)))
(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)
(defn cookies (defn cookies
([id] (cookies id {})) [{:keys [cookie-name] :as cfg} vals]
([id opts] {cookie-name (merge vals {:path "/" :http-only true})})
{"auth-token" (merge opts {:value id :path "/" :http-only true})}))
(defn wrap-session (defn middleware
[handler] [cfg handler]
(fn [request] (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 (assoc request :profile-id profile-id))
(handler request)))) (handler request))))
(def middleware (defmethod ig/pre-init-spec ::session [_]
{:nane ::middleware (s/keys :req-un [::db/pool]))
:compile (constantly wrap-session)})
(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 %)})))

61
backend/src/app/http/ws.clj
View file

@ -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)))

208
backend/src/app/main.clj
View file

@ -10,33 +10,199 @@
(ns app.main (ns app.main
(:require (:require
[app.config :as cfg] [app.config :as cfg]
[app.common.data :as d]
[app.util.time :as dt]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[mount.core :as mount])) [integrant.core :as ig]))
(defn- enable-asserts
[_]
(let [m (System/getProperty "app.enable-asserts")]
(or (nil? m) (= "true" m))))
;; Set value for all new threads bindings. ;; Set value for all new threads bindings.
(alter-var-root #'*assert* enable-asserts) (alter-var-root #'*assert* (constantly (:enable-asserts @cfg/config)))
;; Set value for current thread binding.
(set! *assert* (enable-asserts nil))
;; --- Entry point ;; --- Entry point
(defn run (defn build-system-config
[_params] [config]
(require 'app.srepl.server {:app.db/pool
'app.services {:uri (:database-uri config)
'app.migrations :username (:database-username config)
'app.worker :password (:database-password config)
'app.media :metrics (ig/ref :app.metrics/metrics)
'app.http) :migrations (ig/ref :app.migrations/migrations)
(mount/start) :name "main"
(log/infof "Welcome to penpot! Version: '%s'." (:full @cfg/version))) :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 (defn -main
[& _args] [& _args]
(run {})) (start))

8
backend/src/app/media.clj
View file

@ -18,8 +18,7 @@
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.java.io :as io] [clojure.java.io :as io]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[datoteka.core :as fs] [datoteka.core :as fs])
[mount.core :refer [defstate]])
(:import (:import
java.io.ByteArrayInputStream java.io.ByteArrayInputStream
java.util.concurrent.Semaphore java.util.concurrent.Semaphore
@ -27,10 +26,7 @@
org.im4java.core.IMOperation org.im4java.core.IMOperation
org.im4java.core.Info)) org.im4java.core.Info))
(declare semaphore) (def semaphore (Semaphore. (:image-process-max-threads cfg/config 1)))
(defstate semaphore
:start (Semaphore. (:image-process-max-threads cfg/config 1)))
;; --- Generic specs ;; --- Generic specs

33
backend/src/app/media_storage.clj
View file

@ -10,28 +10,23 @@
(ns app.media-storage (ns app.media-storage
"A media storage impl for app." "A media storage impl for app."
(:require (:require
[integrant.core :as ig]
[app.common.spec :as us]
[clojure.spec.alpha :as s]
[app.config :refer [config]] [app.config :refer [config]]
[app.util.storage :as ust] [app.util.storage :as ust]
[mount.core :refer [defstate]])) [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 (defmethod ig/init-key ::storage
:start (ust/create {:base-path (:assets-directory config) [_ cfg]
:base-uri (:assets-uri config)})) (ust/create {:base-path (:media-directory cfg)
:base-uri (:media-uri cfg)
(declare media-storage) :xf (comp ust/random-path
ust/slugify-filename)}))
(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)))

272
backend/src/app/metrics.clj
View file

@ -5,9 +5,18 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns app.metrics (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 (:import
io.prometheus.client.CollectorRegistry io.prometheus.client.CollectorRegistry
io.prometheus.client.Counter io.prometheus.client.Counter
@ -17,28 +26,91 @@
io.prometheus.client.hotspot.DefaultExports io.prometheus.client.hotspot.DefaultExports
java.io.StringWriter)) 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.)] (let [registry (CollectorRegistry.)]
(DefaultExports/register registry) ;; (DefaultExports/register registry)
registry)) registry))
(defonce registry (create-registry))
(defonce cache (atom {}))
(defmacro with-measure (defmacro with-measure
[sym expr teardown] [& {:keys [expr cb]}]
`(let [~sym (System/nanoTime)] `(let [start# (System/nanoTime)
tdown# ~cb]
(try (try
~expr ~expr
(finally (finally
(let [~sym (/ (- (System/nanoTime) ~sym) 1000000)] (tdown# (/ (- (System/nanoTime) start#) 1000000))))))
~teardown)))))
(defn make-counter (defn make-counter
[{:keys [id help] :as props}] [{:keys [name help registry reg] :as props}]
(let [instance (doto (Counter/build) (let [registry (or registry reg)
(.name id) instance (doto (Counter/build)
(.name name)
(.help help)) (.help help))
instance (.register instance registry)] instance (.register instance registry)]
(reify (reify
@ -47,36 +119,16 @@
clojure.lang.IFn clojure.lang.IFn
(invoke [_ cmd] (invoke [_ cmd]
(.inc ^Counter instance)) (.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)))
(defn make-gauge (defn make-gauge
[{:keys [id help] :as props}] [{:keys [name help registry reg] :as props}]
(let [instance (doto (Gauge/build) (let [registry (or registry reg)
(.name id) instance (doto (Gauge/build)
(.name name)
(.help help)) (.help help))
instance (.register instance registry)] instance (.register instance registry)]
(reify (reify
clojure.lang.IDeref clojure.lang.IDeref
(deref [_] instance) (deref [_] instance)
@ -87,92 +139,92 @@
:inc (.inc ^Gauge instance) :inc (.inc ^Gauge instance)
:dec (.dec ^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 (defn make-summary
[{:keys [id help] :as props}] [{:keys [name help registry reg] :as props}]
(let [instance (doto (Summary/build) (let [registry (or registry reg)
(.name id) instance (doto (Summary/build)
(.name name)
(.help help) (.help help)
(.quantile 0.5 0.05) (.quantile 0.5 0.05)
(.quantile 0.9 0.01) (.quantile 0.9 0.01)
(.quantile 0.99 0.001)) (.quantile 0.99 0.001))
instance (.register instance registry)] instance (.register instance registry)]
(reify (reify
clojure.lang.IDeref clojure.lang.IDeref
(deref [_] instance) (deref [_] instance)
clojure.lang.IFn clojure.lang.IFn
(invoke [_ val]
(.observe ^Summary instance val))
(invoke [_ cmd val] (invoke [_ cmd val]
(case cmd (.observe ^Summary instance val)))))
: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 $$))))
(throw (IllegalArgumentException. "invalid arguments"))))))) (defn create
[{:keys [type name] :as props}]
(defn summary (case type
[{:keys [id] :as props}] :counter (make-counter props)
(or (get @cache id) :gauge (make-gauge props)
(let [v (make-summary props)] :summary (make-summary props)))
(swap! cache assoc id v)
v)))
(defn wrap-summary
[f props]
(let [sm (summary props)]
(sm :wrap f)))
(defn wrap-counter (defn wrap-counter
[f props] [rootf mobj]
(let [cnt (counter props)] (let [mdata (meta rootf)
(cnt :wrap f))) 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! (defn wrap-summary
[{:keys [var] :as props}] [rootf mobj]
(let [cnt (counter props) (let [mdata (meta rootf)
vars (if (var? var) [var] var)] origf (::original mdata rootf)]
(doseq [var vars] (with-meta
(alter-var-root var (fn [root] (fn
(let [mdata (meta root) ([a]
original (::counter-original mdata root)] (with-measure
(with-meta :expr (origf a)
(cnt :wrap original) :cb #(mobj :observe %)))
(assoc mdata ::counter-original original)))))))) ([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! (defn instrument-vars!
[{:keys [var] :as props}] [vars {:keys [wrap] :as props}]
(let [sm (summary props)] (let [obj (create props)]
(alter-var-root var (fn [root] (cond
(let [mdata (meta root) (instance? Counter @obj)
original (::summary-original mdata root)] (doseq [var vars]
(with-meta (alter-var-root var (or wrap wrap-counter) obj))
(sm :wrap original)
(assoc mdata ::summary-original original)))))))
(defn dump (instance? Summary @obj)
[& _args] (doseq [var vars]
(let [samples (.metricFamilySamples ^CollectorRegistry registry) (alter-var-root var (or wrap wrap-summary) obj))
writer (StringWriter.)]
(TextFormat/write004 writer samples)
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
:body (.toString writer)}))
: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))))

17
backend/src/app/migrations.clj
View file

@ -9,12 +9,12 @@
(ns app.migrations (ns app.migrations
(:require (:require
[integrant.core :as ig]
[app.db :as db] [app.db :as db]
[app.migrations.migration-0023 :as mg0023] [app.migrations.migration-0023 :as mg0023]
[app.util.migrations :as mg] [app.util.migrations :as mg]))
[mount.core :as mount :refer [defstate]]))
(def +migrations+ (def main-migrations
{:name "uxbox-main" {:name "uxbox-main"
:steps :steps
[{:name "0001-add-extensions" [{:name "0001-add-extensions"
@ -120,15 +120,14 @@
:fn (mg/resource "app/migrations/sql/0034-mod-profile-table-add-props-field.sql")} :fn (mg/resource "app/migrations/sql/0034-mod-profile-table-add-props-field.sql")}
]}) ]})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry point ;; Entry point
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn migrate (defmethod ig/init-key ::migrations
[] [_ _]
(with-open [conn (db/open)] (fn [conn]
(mg/setup! conn) (mg/setup! conn)
(mg/migrate! conn +migrations+))) (mg/migrate! conn main-migrations)))
(defstate migrations
:start (migrate))

148
backend/src/app/services/notifications.clj → backend/src/app/notifications.clj
View file

@ -7,17 +7,81 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.notifications (ns app.notifications
"A websocket based notifications mechanism." "A websocket based notifications mechanism."
(:require (:require
[app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.redis :as redis] [app.redis :as rd]
[app.util.async :as aa] [app.util.async :as aa]
[app.util.transit :as t] [app.util.transit :as t]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log] [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 ;; WebSocket Http Handler
@ -27,24 +91,24 @@
(defrecord WebSocket [conn in out sub]) (defrecord WebSocket [conn in out sub])
(defonce metrics-active-connections ;; (defonce metrics-active-connections
(mtx/gauge {:id "notificatons__active_connections" ;; (mtx/gauge {:id "notificatons__active_connections"
:help "Active connections to the notifications service."})) ;; :help "Active connections to the notifications service."}))
(defonce metrics-message-counter ;; (defonce metrics-message-counter
(mtx/counter {:id "notificatons__messages_counter" ;; (mtx/counter {:id "notificatons__messages_counter"
:help "A total number of messages handled by the notifications service."})) ;; :help "A total number of messages handled by the notifications service."}))
(defn websocket (defn websocket
[{:keys [file-id team-id] :as params}] [{:keys [file-id team-id redis] :as cfg}]
(let [in (a/chan 32) (let [in (a/chan 32)
out (a/chan 32)] out (a/chan 32)]
{:on-connect {:on-connect
(fn [conn] (fn [conn]
(metrics-active-connections :inc) ;; (metrics-active-connections :inc)
(let [sub (redis/subscribe {:xform (map t/decode-str) (let [sub (rd/subscribe redis {:xform (map t/decode-str)
:topics [file-id team-id]}) :topics [file-id team-id]})
ws (WebSocket. conn in out sub nil params)] ws (WebSocket. conn in out sub nil cfg)]
;; message forwarding loop ;; message forwarding loop
(a/go-loop [] (a/go-loop []
@ -64,13 +128,13 @@
:on-close :on-close
(fn [_conn _status _reason] (fn [_conn _status _reason]
(metrics-active-connections :dec) ;; (metrics-active-connections :dec)
(a/close! out) (a/close! out)
(a/close! in)) (a/close! in))
:on-text :on-text
(fn [_ws message] (fn [_ws message]
(metrics-message-counter :inc) ;; (metrics-message-counter :inc)
(let [message (t/decode-str message)] (let [message (t/decode-str message)]
(a/>!! in message))) (a/>!! in message)))
@ -99,6 +163,7 @@
(loop [] (loop []
(let [timeout (a/timeout 30000) (let [timeout (a/timeout 30000)
[val port] (a/alts! [in sub timeout])] [val port] (a/alts! [in sub timeout])]
;; (prn "alts" val "from" (cond (= port in) "input" ;; (prn "alts" val "from" (cond (= port in) "input"
;; (= port sub) "redis" ;; (= port sub) "redis"
;; :else "timeout")) ;; :else "timeout"))
@ -126,18 +191,14 @@
:else :else
nil))))) nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Incoming Messages Handling ;; Incoming Messages Handling
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- Impl
(defn- publish (defn- publish
[channel message] [redis channel message]
(aa/go-try (aa/go-try
(let [message (t/encode-str message)] (let [message (t/encode-str message)]
(aa/<? (redis/run :publish {:channel (str channel) (aa/<? (rd/run redis :publish {:channel (str channel)
:message message}))))) :message message})))))
(def ^:private (def ^:private
sql:retrieve-presence sql:retrieve-presence
@ -146,9 +207,9 @@
and (clock_timestamp() - updated_at) < '5 min'::interval") and (clock_timestamp() - updated_at) < '5 min'::interval")
(defn- retrieve-presence (defn- retrieve-presence
[file-id] [pool file-id]
(aa/thread-try (aa/thread-try
(let [rows (db/exec! db/pool [sql:retrieve-presence file-id])] (let [rows (db/exec! pool [sql:retrieve-presence file-id])]
(mapv (juxt :session-id :profile-id) rows)))) (mapv (juxt :session-id :profile-id) rows))))
(def ^:private (def ^:private
@ -159,17 +220,17 @@
do update set updated_at=clock_timestamp()") do update set updated_at=clock_timestamp()")
(defn- update-presence (defn- update-presence
[file-id session-id profile-id] [conn file-id session-id profile-id]
(aa/thread-try (aa/thread-try
(let [sql [sql:update-presence file-id session-id profile-id]] (let [sql [sql:update-presence file-id session-id profile-id]]
(db/exec-one! db/pool sql)))) (db/exec-one! conn sql))))
(defn- delete-presence (defn- delete-presence
[file-id session-id profile-id] [pool file-id session-id profile-id]
(aa/thread-try (aa/thread-try
(db/delete! db/pool :presence {:file-id file-id (db/delete! pool :presence {:file-id file-id
:profile-id profile-id :profile-id profile-id
:session-id session-id}))) :session-id session-id})))
(defmulti handle-message (defmulti handle-message
(fn [_ message] (:type message))) (fn [_ message] (:type message)))
@ -178,33 +239,34 @@
;; single use token for avoid explicit database query). ;; single use token for avoid explicit database query).
(defmethod handle-message :connect (defmethod handle-message :connect
[{:keys [file-id profile-id session-id] :as ws} _message] [{:keys [file-id profile-id session-id pool redis] :as ws} _message]
(log/debugf "profile '%s' is connected to file '%s'" profile-id file-id) (log/debugf "profile '%s' is connected to file '%s'" profile-id file-id)
(aa/go-try (aa/go-try
(aa/<? (update-presence file-id session-id profile-id)) (aa/<? (update-presence pool file-id session-id profile-id))
(let [members (aa/<? (retrieve-presence file-id))] (let [members (aa/<? (retrieve-presence pool file-id))]
(aa/<? (publish file-id {:type :presence :sessions members}))))) (aa/<? (publish redis file-id {:type :presence :sessions members})))))
(defmethod handle-message :disconnect (defmethod handle-message :disconnect
[{:keys [profile-id file-id session-id] :as ws} _message] [{:keys [profile-id file-id session-id redis pool] :as ws} _message]
(log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id) (log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id)
(aa/go-try (aa/go-try
(aa/<? (delete-presence file-id session-id profile-id)) (aa/<? (delete-presence pool file-id session-id profile-id))
(let [members (aa/<? (retrieve-presence file-id))] (let [members (aa/<? (retrieve-presence pool file-id))]
(aa/<? (publish file-id {:type :presence :sessions members}))))) (aa/<? (publish redis file-id {:type :presence :sessions members})))))
(defmethod handle-message :keepalive (defmethod handle-message :keepalive
[{:keys [profile-id file-id session-id] :as ws} _message] [{:keys [profile-id file-id session-id pool] :as ws} _message]
(update-presence file-id session-id profile-id)) (update-presence pool file-id session-id profile-id))
(defmethod handle-message :pointer-update (defmethod handle-message :pointer-update
[{:keys [profile-id file-id session-id] :as ws} message] [{:keys [profile-id file-id session-id redis] :as ws} message]
(let [message (assoc message (let [message (assoc message
:profile-id profile-id :profile-id profile-id
:session-id session-id)] :session-id session-id)]
(publish file-id message))) (publish redis file-id message)))
(defmethod handle-message :default (defmethod handle-message :default
[_ws message] [_ws message]
(a/go (a/go
(log/warnf "received unexpected message: %s" message))) (log/warnf "received unexpected message: %s" message)))

56
backend/src/app/redis.clj
View file

@ -7,41 +7,53 @@
(ns app.redis (ns app.redis
(:refer-clojure :exclude [run!]) (:refer-clojure :exclude [run!])
(:require (:require
[app.common.spec :as us]
[app.config :as cfg] [app.config :as cfg]
[app.util.redis :as redis] [app.util.redis :as redis]
[mount.core :as mount :refer [defstate]]) [clojure.spec.alpha :as s]
[integrant.core :as ig])
(:import (:import
java.lang.AutoCloseable)) java.lang.AutoCloseable))
;; --- Connection Handling & State ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; State
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- create-client (defmethod ig/pre-init-spec ::redis [_]
[config] (s/keys :req-un [::uri]))
(let [uri (:redis-uri config "redis://redis/0")]
(redis/client uri)))
(declare client) (defmethod ig/init-key ::redis
[_ cfg]
(let [client (redis/client (:uri cfg "redis://redis/0"))
conn (redis/connect client)]
{::client client
::conn conn}))
(defstate client (defmethod ig/halt-key! ::redis
:start (create-client cfg/config) [_ {:keys [::client ::conn]}]
:stop (.close ^AutoCloseable client)) (.close ^AutoCloseable conn)
(.close ^AutoCloseable client))
(declare conn) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defstate conn (s/def ::client some?)
:start (redis/connect client) (s/def ::conn some?)
:stop (.close ^AutoCloseable conn)) (s/def ::redis (s/keys :req [::client ::conn]))
;; --- API FORWARD
(defn subscribe (defn subscribe
[opts] [client opts]
(redis/subscribe client opts)) (us/assert ::redis client)
(redis/subscribe (::client client) opts))
(defn run! (defn run!
[cmd params] [client cmd params]
(redis/run! conn cmd params)) (us/assert ::redis client)
(redis/run! (::conn client) cmd params))
(defn run (defn run
[cmd params] [client cmd params]
(redis/run conn cmd params)) (us/assert ::redis client)
(redis/run (::conn client) cmd params))

118
backend/src/app/rpc.clj Normal file
View file

@ -0,0 +1,118 @@
;; 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 Andrey Antukh <niwi@niwi.nz>
(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 %)}))

50
backend/src/app/services/mutations/comments.clj → backend/src/app/rpc/mutations/comments.clj
View file

@ -7,16 +7,16 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.comments (ns app.rpc.mutations.comments
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm] [app.rpc.queries.comments :as comments]
[app.services.queries.comments :as comments] [app.rpc.queries.files :as files]
[app.services.queries.files :as files]
[app.util.blob :as blob] [app.util.blob :as blob]
[app.util.time :as dt] [app.util.time :as dt]
[app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
;; --- Mutation: Create Comment Thread ;; --- Mutation: Create Comment Thread
@ -34,9 +34,9 @@
(s/def ::create-comment-thread (s/def ::create-comment-thread
(s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id])) (s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id]))
(sm/defmutation ::create-comment-thread (sv/defmethod ::create-comment-thread
[{:keys [profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-read-permissions! conn profile-id file-id) (files/check-read-permissions! conn profile-id file-id)
(create-comment-thread conn params))) (create-comment-thread conn params)))
@ -113,9 +113,9 @@
(s/def ::update-comment-thread-status (s/def ::update-comment-thread-status
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::update-comment-thread-status (sv/defmethod ::update-comment-thread-status
[{:keys [profile-id id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [cthr (db/get-by-id conn :comment-thread id {:for-update true})] (let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not cthr (when-not cthr
(ex/raise :type :not-found)) (ex/raise :type :not-found))
@ -141,9 +141,9 @@
(s/def ::update-comment-thread (s/def ::update-comment-thread
(s/keys :req-un [::profile-id ::id ::is-resolved])) (s/keys :req-un [::profile-id ::id ::is-resolved]))
(sm/defmutation ::update-comment-thread (sv/defmethod ::update-comment-thread
[{:keys [profile-id id is-resolved] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id id is-resolved] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})] (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not thread (when-not thread
(ex/raise :type :not-found) (ex/raise :type :not-found)
@ -161,9 +161,9 @@
(s/def ::add-comment (s/def ::add-comment
(s/keys :req-un [::profile-id ::thread-id ::content])) (s/keys :req-un [::profile-id ::thread-id ::content]))
(sm/defmutation ::add-comment (sv/defmethod ::add-comment
[{:keys [profile-id thread-id content] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id thread-id content] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true}) (let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true})
(comments/decode-row)) (comments/decode-row))
pname (retrieve-page-name conn thread)] pname (retrieve-page-name conn thread)]
@ -218,9 +218,9 @@
(s/def ::update-comment (s/def ::update-comment
(s/keys :req-un [::profile-id ::id ::content])) (s/keys :req-un [::profile-id ::id ::content]))
(sm/defmutation ::update-comment (sv/defmethod ::update-comment
[{:keys [profile-id id content] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id id content] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true}) (let [comment (db/get-by-id conn :comment id {:for-update true})
_ (when-not comment (ex/raise :type :not-found)) _ (when-not comment (ex/raise :type :not-found))
thread (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true}) thread (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true})
@ -251,9 +251,9 @@
(s/def ::delete-comment-thread (s/def ::delete-comment-thread
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-comment-thread (sv/defmethod ::delete-comment-thread
[{:keys [profile-id id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})] (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not (= (:owner-id thread) profile-id) (when-not (= (:owner-id thread) profile-id)
(ex/raise :type :validation (ex/raise :type :validation
@ -267,9 +267,9 @@
(s/def ::delete-comment (s/def ::delete-comment
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-comment (sv/defmethod ::delete-comment
[{:keys [profile-id id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})] (let [comment (db/get-by-id conn :comment id {:for-update true})]
(when-not (= (:owner-id comment) profile-id) (when-not (= (:owner-id comment) profile-id)
(ex/raise :type :validation (ex/raise :type :validation

17
backend/src/app/services/mutations/demo.clj → backend/src/app/rpc/mutations/demo.clj
View file

@ -7,20 +7,23 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.demo (ns app.rpc.mutations.demo
"A demo specific mutations." "A demo specific mutations."
(:require (:require
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm] [app.rpc.mutations.profile :as profile]
[app.services.mutations.profile :as profile]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.services :as sv]
[buddy.core.codecs :as bc] [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) (let [id (uuid/next)
sem (System/currentTimeMillis) sem (System/currentTimeMillis)
email (str "demo-" sem ".demo@nodomain.com") email (str "demo-" sem ".demo@nodomain.com")
@ -33,7 +36,7 @@
:fullname fullname :fullname fullname
:demo? true :demo? true
:password password}] :password password}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(->> (#'profile/create-profile conn params) (->> (#'profile/create-profile conn params)
(#'profile/create-profile-relations conn)) (#'profile/create-profile-relations conn))

76
backend/src/app/services/mutations/files.clj → backend/src/app/rpc/mutations/files.clj
View file

@ -7,7 +7,7 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.files (ns app.rpc.mutations.files
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.pages :as cp] [app.common.pages :as cp]
@ -16,12 +16,12 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.redis :as redis] [app.redis :as rd]
[app.services.mutations :as sm] [app.rpc.queries.files :as files]
[app.services.queries.files :as files] [app.rpc.queries.projects :as proj]
[app.services.queries.projects :as proj]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.blob :as blob] [app.util.blob :as blob]
[app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.util.transit :as t] [app.util.transit :as t]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
@ -43,9 +43,9 @@
(s/keys :req-un [::profile-id ::name ::project-id] (s/keys :req-un [::profile-id ::name ::project-id]
:opt-un [::id ::is-shared])) :opt-un [::id ::is-shared]))
(sm/defmutation ::create-file (sv/defmethod ::create-file
[{:keys [profile-id project-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id project-id) (proj/check-edition-permissions! conn profile-id project-id)
(create-file conn params))) (create-file conn params)))
@ -82,9 +82,9 @@
(s/def ::rename-file (s/def ::rename-file
(s/keys :req-un [::profile-id ::name ::id])) (s/keys :req-un [::profile-id ::name ::id]))
(sm/defmutation ::rename-file (sv/defmethod ::rename-file
[{:keys [id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id) (files/check-edition-permissions! conn profile-id id)
(rename-file conn params))) (rename-file conn params)))
@ -102,9 +102,9 @@
(s/def ::set-file-shared (s/def ::set-file-shared
(s/keys :req-un [::profile-id ::id ::is-shared])) (s/keys :req-un [::profile-id ::id ::is-shared]))
(sm/defmutation ::set-file-shared (sv/defmethod ::set-file-shared
[{:keys [id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id) (files/check-edition-permissions! conn profile-id id)
(set-file-shared conn params))) (set-file-shared conn params)))
@ -122,9 +122,9 @@
(s/def ::delete-file (s/def ::delete-file
(s/keys :req-un [::id ::profile-id])) (s/keys :req-un [::id ::profile-id]))
(sm/defmutation ::delete-file (sv/defmethod ::delete-file
[{:keys [id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id) (files/check-edition-permissions! conn profile-id id)
;; Schedule object deletion ;; Schedule object deletion
@ -149,13 +149,13 @@
(s/def ::link-file-to-library (s/def ::link-file-to-library
(s/keys :req-un [::profile-id ::file-id ::library-id])) (s/keys :req-un [::profile-id ::file-id ::library-id]))
(sm/defmutation ::link-file-to-library (sv/defmethod ::link-file-to-library
[{:keys [profile-id file-id library-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
(when (= file-id library-id) (when (= file-id library-id)
(ex/raise :type :validation (ex/raise :type :validation
:code :invalid-library :code :invalid-library
:hint "A file cannot be linked to itself")) :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) (files/check-edition-permissions! conn profile-id file-id)
(link-file-to-library conn params))) (link-file-to-library conn params)))
@ -176,9 +176,9 @@
(s/def ::unlink-file-from-library (s/def ::unlink-file-from-library
(s/keys :req-un [::profile-id ::file-id ::library-id])) (s/keys :req-un [::profile-id ::file-id ::library-id]))
(sm/defmutation ::unlink-file-from-library (sv/defmethod ::unlink-file-from-library
[{:keys [profile-id file-id library-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(unlink-file-from-library conn params))) (unlink-file-from-library conn params)))
@ -196,9 +196,9 @@
(s/def ::update-sync (s/def ::update-sync
(s/keys :req-un [::profile-id ::file-id ::library-id])) (s/keys :req-un [::profile-id ::file-id ::library-id]))
(sm/defmutation ::update-sync (sv/defmethod ::update-sync
[{:keys [profile-id file-id library-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(update-sync conn params))) (update-sync conn params)))
@ -217,9 +217,9 @@
(s/def ::ignore-sync (s/def ::ignore-sync
(s/keys :req-un [::profile-id ::file-id ::date])) (s/keys :req-un [::profile-id ::file-id ::date]))
(sm/defmutation ::ignore-sync (sv/defmethod ::ignore-sync
[{:keys [profile-id file-id date] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id date] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(ignore-sync conn params))) (ignore-sync conn params)))
@ -256,15 +256,15 @@
(declare retrieve-lagged-changes) (declare retrieve-lagged-changes)
(declare insert-change) (declare insert-change)
(sm/defmutation ::update-file (sv/defmethod ::update-file
[{:keys [id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-update true})] (let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-update true})]
(files/check-edition-permissions! conn profile-id id) (files/check-edition-permissions! conn profile-id id)
(update-file conn file params)))) (update-file (assoc cfg :conn conn) file params))))
(defn- update-file (defn- update-file
[conn file params] [{:keys [conn redis]} file params]
(when (> (:revn params) (when (> (:revn params)
(:revn file)) (:revn file))
(ex/raise :type :validation (ex/raise :type :validation
@ -294,8 +294,8 @@
library-changes (filter library-change? changes)] library-changes (filter library-change? changes)]
@(redis/run! :publish {:channel (str (:id file)) @(rd/run! redis :publish {:channel (str (:id file))
:message (t/encode-str msg)}) :message (t/encode-str msg)})
(when (and (:is-shared file) (seq library-changes)) (when (and (:is-shared file) (seq library-changes))
(let [{:keys [team-id] :as project} (let [{:keys [team-id] :as project}
@ -309,8 +309,8 @@
:modified-at (dt/now) :modified-at (dt/now)
:changes library-changes}] :changes library-changes}]
@(redis/run! :publish {:channel (str team-id) @(rd/run! redis :publish {:channel (str team-id)
:message (t/encode-str msg)}))) :message (t/encode-str msg)})))
(db/update! conn :file (db/update! conn :file
{:revn (:revn file) {:revn (:revn file)

43
backend/src/app/services/mutations/media.clj → backend/src/app/rpc/mutations/media.clj
View file

@ -7,7 +7,7 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.media (ns app.rpc.mutations.media
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.media :as cm] [app.common.media :as cm]
@ -15,10 +15,9 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.media :as media] [app.media :as media]
[app.media-storage :as mst] [app.rpc.queries.teams :as teams]
[app.services.mutations :as sm]
[app.services.queries.teams :as teams]
[app.util.storage :as ust] [app.util.storage :as ust]
[app.util.services :as sv]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[datoteka.core :as fs])) [datoteka.core :as fs]))
@ -53,34 +52,36 @@
(s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content] (s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content]
:opt-un [::id])) :opt-un [::id]))
(sm/defmutation ::add-media-object-from-url (sv/defmethod ::add-media-object-from-url
[{:keys [profile-id file-id url name] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id url name] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [file (select-file-for-update conn file-id)] (let [file (select-file-for-update conn file-id)]
(teams/check-edition-permissions! conn profile-id (:team-id file)) (teams/check-edition-permissions! conn profile-id (:team-id file))
(let [content (media/download-media-object url) (let [content (media/download-media-object url)
cfg (assoc cfg :conn conn)
params' (merge params {:content content params' (merge params {:content content
:name (or name (:filename content))})] :name (or name (:filename content))})]
(create-media-object conn params'))))) (create-media-object cfg params')))))
(sm/defmutation ::upload-media-object (sv/defmethod ::upload-media-object
[{:keys [profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [file (select-file-for-update conn file-id)] (let [file (select-file-for-update conn file-id)
cfg (assoc cfg :conn conn)]
(teams/check-edition-permissions! conn profile-id (:team-id file)) (teams/check-edition-permissions! conn profile-id (:team-id file))
(create-media-object conn params)))) (create-media-object cfg params))))
(defn create-media-object (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)) (media/validate-media-type (:content-type content))
(let [info (media/run {:cmd :info :input {:path (:tempfile content) (let [info (media/run {:cmd :info :input {:path (:tempfile content)
:mtype (:content-type content)}}) :mtype (:content-type content)}})
path (persist-media-object-on-fs content) path (persist-media-object-on-fs cfg content)
opts (assoc thumbnail-options opts (assoc thumbnail-options
:input {:mtype (:mtype info) :input {:mtype (:mtype info)
:path path}) :path path})
thumb (if-not (= (:mtype info) "image/svg+xml") thumb (if-not (= (:mtype info) "image/svg+xml")
(persist-media-thumbnail-on-fs opts) (persist-media-thumbnail-on-fs cfg opts)
(assoc info (assoc info
:path path :path path
:quality 0)) :quality 0))
@ -123,13 +124,13 @@
row)) row))
(defn persist-media-object-on-fs (defn persist-media-object-on-fs
[{:keys [filename tempfile]}] [{:keys [storage]} {:keys [filename tempfile]}]
(let [filename (fs/name filename)] (let [filename (fs/name filename)]
(ust/save! mst/media-storage filename tempfile))) (ust/save! storage filename tempfile)))
(defn persist-media-thumbnail-on-fs (defn persist-media-thumbnail-on-fs
[{:keys [input] :as params}] [{:keys [storage]} {:keys [input] :as params}]
(let [path (ust/lookup mst/media-storage (:path input)) (let [path (ust/lookup storage (:path input))
thumb (media/run thumb (media/run
(-> params (-> params
(assoc :cmd :generic-thumbnail) (assoc :cmd :generic-thumbnail)
@ -138,7 +139,7 @@
name (str "thumbnail-" name (str "thumbnail-"
(first (fs/split-ext (fs/name (:path input)))) (first (fs/split-ext (fs/name (:path input))))
(cm/format->extension (:format thumb))) (cm/format->extension (:format thumb)))
path (ust/save! mst/media-storage name (:data thumb))] path (ust/save! storage name (:data thumb))]
(-> thumb (-> thumb
(dissoc :data :input) (dissoc :data :input)

123
backend/src/app/services/mutations/profile.clj → backend/src/app/rpc/mutations/profile.clj
View file

@ -7,7 +7,7 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.profile (ns app.rpc.mutations.profile
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
@ -17,12 +17,11 @@
[app.emails :as emails] [app.emails :as emails]
[app.http.session :as session] [app.http.session :as session]
[app.media :as media] [app.media :as media]
[app.services.mutations :as sm] [app.rpc.mutations.projects :as projects]
[app.services.mutations.projects :as projects] [app.rpc.mutations.teams :as teams]
[app.services.mutations.teams :as teams] [app.rpc.mutations.verify-token :refer [process-token]]
[app.services.mutations.verify-token :refer [process-token]] [app.rpc.queries.profile :as profile]
[app.services.queries.profile :as profile] [app.util.services :as sv]
[app.services.tokens :as tokens]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.time :as dt] [app.util.time :as dt]
[buddy.hashers :as hashers] [buddy.hashers :as hashers]
@ -53,8 +52,8 @@
(s/keys :req-un [::email ::password ::fullname] (s/keys :req-un [::email ::password ::fullname]
:opt-un [::token])) :opt-un [::token]))
(sm/defmutation ::register-profile (sv/defmethod ::register-profile {:auth false}
[{:keys [token] :as params}] [{:keys [pool tokens session] :as cfg} {:keys [token] :as params}]
(when-not (:registration-enabled cfg/config) (when-not (:registration-enabled cfg/config)
(ex/raise :type :restriction (ex/raise :type :restriction
:code :registration-disabled)) :code :registration-disabled))
@ -64,7 +63,7 @@
(ex/raise :type :validation (ex/raise :type :validation
:code :email-domain-is-not-allowed)) :code :email-domain-is-not-allowed))
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(check-profile-existence! conn params) (check-profile-existence! conn params)
(let [profile (->> (create-profile conn params) (let [profile (->> (create-profile conn params)
(create-profile-relations conn))] (create-profile-relations conn))]
@ -74,7 +73,7 @@
;; from team-invitation process; in this case we revalidate ;; from team-invitation process; in this case we revalidate
;; the token and process the token claims again with the new ;; the token and process the token claims again with the new
;; profile data. ;; 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)) claims (assoc claims :member-id (:id profile))
params (assoc params :profile-id (:id profile))] params (assoc params :profile-id (:id profile))]
(process-token conn params claims) (process-token conn params claims)
@ -94,16 +93,17 @@
{:transform-response {:transform-response
(fn [request response] (fn [request response]
(let [uagent (get-in request [:headers "user-agent"]) (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 (assoc response
:cookies (session/cookies id))))})) :cookies (session/cookies session {:value id}))))}))
;; If no token is provided, send a verification email ;; If no token is provided, send a verification email
(let [token (tokens/generate (let [token (tokens :generate
{:iss :verify-email {:iss :verify-email
:exp (dt/in-future "48h") :exp (dt/in-future "48h")
:profile-id (:id profile) :profile-id (:id profile)
:email (:email profile)})] :email (:email profile)})]
(emails/send! conn emails/register (emails/send! conn emails/register
{:to (:email profile) {:to (:email profile)
@ -198,8 +198,8 @@
(s/keys :req-un [::email ::password] (s/keys :req-un [::email ::password]
:opt-un [::scope])) :opt-un [::scope]))
(sm/defmutation ::login (sv/defmethod ::login {:auth false}
[{:keys [email password scope] :as params}] [{:keys [pool] :as cfg} {:keys [email password scope] :as params}]
(letfn [(check-password [profile password] (letfn [(check-password [profile password]
(when (= (:password profile) "!") (when (= (:password profile) "!")
(ex/raise :type :validation (ex/raise :type :validation
@ -218,7 +218,7 @@
:code :wrong-credentials)) :code :wrong-credentials))
profile)] profile)]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [prof (-> (profile/retrieve-profile-data-by-email conn email) (let [prof (-> (profile/retrieve-profile-data-by-email conn email)
(validate-profile) (validate-profile)
(profile/strip-private-attrs)) (profile/strip-private-attrs))
@ -228,8 +228,8 @@
;; --- Mutation: Register if not exists ;; --- Mutation: Register if not exists
(sm/defmutation ::login-or-register (sv/defmethod ::login-or-register
[{:keys [email fullname] :as params}] [{:keys [pool] :as cfg} {:keys [email fullname] :as params}]
(letfn [(populate-additional-data [conn profile] (letfn [(populate-additional-data [conn profile]
(let [data (profile/retrieve-additional-data conn (:id profile))] (let [data (profile/retrieve-additional-data conn (:id profile))]
(merge profile data))) (merge profile data)))
@ -248,7 +248,7 @@
(->> (create-profile conn params) (->> (create-profile conn params)
(create-profile-relations conn)))] (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) (let [profile (profile/retrieve-profile-data-by-email conn email)
profile (if profile profile (if profile
(populate-additional-data conn profile) (populate-additional-data conn profile)
@ -269,9 +269,9 @@
(s/def ::update-profile (s/def ::update-profile
(s/keys :req-un [::id ::fullname ::lang ::theme])) (s/keys :req-un [::id ::fullname ::lang ::theme]))
(sm/defmutation ::update-profile (sv/defmethod ::update-profile
[params] [{:keys [pool] :as cfg} params]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(update-profile conn params) (update-profile conn params)
nil)) nil))
@ -288,9 +288,9 @@
(s/def ::update-profile-password (s/def ::update-profile-password
(s/keys :req-un [::profile-id ::password ::old-password])) (s/keys :req-un [::profile-id ::password ::old-password]))
(sm/defmutation ::update-profile-password (sv/defmethod ::update-profile-password
[{:keys [password profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [password profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(validate-password! conn params) (validate-password! conn params)
(db/update! conn :profile (db/update! conn :profile
{:password (derive-password password)} {:password (derive-password password)}
@ -306,14 +306,14 @@
(s/def ::update-profile-photo (s/def ::update-profile-photo
(s/keys :req-un [::profile-id ::file])) (s/keys :req-un [::profile-id ::file]))
(sm/defmutation ::update-profile-photo (sv/defmethod ::update-profile-photo
[{:keys [profile-id file] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file] :as params}]
(media/validate-media-type (:content-type file)) (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) (let [profile (db/get-by-id conn :profile profile-id)
_ (media/run {:cmd :info :input {:path (:tempfile file) _ (media/run {:cmd :info :input {:path (:tempfile file)
:mtype (:content-type file)}}) :mtype (:content-type file)}})
photo (teams/upload-photo conn params)] photo (teams/upload-photo cfg params)]
;; Schedule deletion of old photo ;; Schedule deletion of old photo
(when (and (string? (:photo profile)) (when (and (string? (:photo profile))
@ -335,16 +335,16 @@
(s/def ::request-email-change (s/def ::request-email-change
(s/keys :req-un [::email])) (s/keys :req-un [::email]))
(sm/defmutation ::request-email-change (sv/defmethod ::request-email-change
[{:keys [profile-id email] :as params}] [{:keys [pool tokens] :as cfg} {:keys [profile-id email] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [email (str/lower email) (let [email (str/lower email)
profile (db/get-by-id conn :profile profile-id) profile (db/get-by-id conn :profile profile-id)
token (tokens/generate token (tokens :generate
{:iss :change-email {:iss :change-email
:exp (dt/in-future "15m") :exp (dt/in-future "15m")
:profile-id profile-id :profile-id profile-id
:email email})] :email email})]
(when (not= email (:email profile)) (when (not= email (:email profile))
(check-profile-existence! conn params)) (check-profile-existence! conn params))
@ -365,13 +365,13 @@
(s/def ::request-profile-recovery (s/def ::request-profile-recovery
(s/keys :req-un [::email])) (s/keys :req-un [::email]))
(sm/defmutation ::request-profile-recovery (sv/defmethod ::request-profile-recovery {:auth false}
[{:keys [email] :as params}] [{:keys [pool tokens] :as cfg} {:keys [email] :as params}]
(letfn [(create-recovery-token [{:keys [id] :as profile}] (letfn [(create-recovery-token [{:keys [id] :as profile}]
(let [token (tokens/generate (let [token (tokens :generate
{:iss :password-recovery {:iss :password-recovery
:exp (dt/in-future "15m") :exp (dt/in-future "15m")
:profile-id id})] :profile-id id})]
(assoc profile :token token))) (assoc profile :token token)))
(send-email-notification [conn profile] (send-email-notification [conn profile]
@ -380,7 +380,7 @@
:token (:token profile) :token (:token profile)
:name (:fullname profile)}))] :name (:fullname profile)}))]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(some->> email (some->> email
(profile/retrieve-profile-data-by-email conn) (profile/retrieve-profile-data-by-email conn)
(create-recovery-token) (create-recovery-token)
@ -394,17 +394,17 @@
(s/def ::recover-profile (s/def ::recover-profile
(s/keys :req-un [::token ::password])) (s/keys :req-un [::token ::password]))
(sm/defmutation ::recover-profile (sv/defmethod ::recover-profile {:auth false}
[{:keys [token password]}] [{:keys [pool tokens] :as cfg} {:keys [token password]}]
(letfn [(validate-token [token] (letfn [(validate-token [token]
(let [tdata (tokens/verify token {:iss :password-recovery})] (let [tdata (tokens :verify {:token token :iss :password-recovery})]
(:profile-id tdata))) (:profile-id tdata)))
(update-password [conn profile-id] (update-password [conn profile-id]
(let [pwd (derive-password password)] (let [pwd (derive-password password)]
(db/update! conn :profile {:password pwd} {:id profile-id})))] (db/update! conn :profile {:password pwd} {:id profile-id})))]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(->> (validate-token token) (->> (validate-token token)
(update-password conn)) (update-password conn))
nil))) nil)))
@ -415,9 +415,9 @@
(s/def ::update-profile-props (s/def ::update-profile-props
(s/keys :req-un [::profile-id ::props])) (s/keys :req-un [::profile-id ::props]))
(sm/defmutation ::update-profile-props (sv/defmethod ::update-profile-props
[{:keys [profile-id props]}] [{:keys [pool] :as cfg} {:keys [profile-id props]}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [profile (profile/retrieve-profile-data conn profile-id) (let [profile (profile/retrieve-profile-data conn profile-id)
props (reduce-kv (fn [props k v] props (reduce-kv (fn [props k v]
(if (nil? v) (if (nil? v)
@ -439,9 +439,9 @@
(s/def ::delete-profile (s/def ::delete-profile
(s/keys :req-un [::profile-id])) (s/keys :req-un [::profile-id]))
(sm/defmutation ::delete-profile (sv/defmethod ::delete-profile
[{:keys [profile-id] :as params}] [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(check-teams-ownership! conn profile-id) (check-teams-ownership! conn profile-id)
;; Schedule a complete deletion of profile ;; Schedule a complete deletion of profile
@ -456,10 +456,9 @@
(with-meta {} (with-meta {}
{:transform-response {:transform-response
(fn [request response] (fn [request response]
(some-> (session/extract-auth-token request) (session/delete! session request)
(session/delete))
(assoc response (assoc response
:cookies (session/cookies "" {:max-age -1})))}))) :cookies (session/cookies session {:value "" :max-age -1})))})))
(def ^:private sql:teams-ownership-check (def ^:private sql:teams-ownership-check
"with teams as ( "with teams as (

30
backend/src/app/services/mutations/projects.clj → backend/src/app/rpc/mutations/projects.clj
View file

@ -7,15 +7,15 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.projects (ns app.rpc.mutations.projects
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm] [app.rpc.queries.projects :as proj]
[app.services.queries.projects :as proj]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
;; --- Helpers & Specs ;; --- Helpers & Specs
@ -36,9 +36,9 @@
(s/keys :req-un [::profile-id ::team-id ::name] (s/keys :req-un [::profile-id ::team-id ::name]
:opt-un [::id])) :opt-un [::id]))
(sm/defmutation ::create-project (sv/defmethod ::create-project
[params] [{:keys [pool] :as cfg} params]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [proj (create-project conn params) (let [proj (create-project conn params)
params (assoc params :project-id (:id proj))] params (assoc params :project-id (:id proj))]
(create-project-profile conn params) (create-project-profile conn params)
@ -88,9 +88,9 @@
(s/def ::update-project-pin (s/def ::update-project-pin
(s/keys :req-un [::profile-id ::id ::team-id ::is-pinned])) (s/keys :req-un [::profile-id ::id ::team-id ::is-pinned]))
(sm/defmutation ::update-project-pin (sv/defmethod ::update-project-pin
[{:keys [id profile-id team-id is-pinned] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id team-id is-pinned] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned]) (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
nil)) nil))
@ -102,9 +102,9 @@
(s/def ::rename-project (s/def ::rename-project
(s/keys :req-un [::profile-id ::name ::id])) (s/keys :req-un [::profile-id ::name ::id]))
(sm/defmutation ::rename-project (sv/defmethod ::rename-project
[{:keys [id profile-id name] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id name] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id id) (proj/check-edition-permissions! conn profile-id id)
(db/update! conn :project (db/update! conn :project
{:name name} {:name name}
@ -117,9 +117,9 @@
(s/def ::delete-project (s/def ::delete-project
(s/keys :req-un [::id ::profile-id])) (s/keys :req-un [::id ::profile-id]))
(sm/defmutation ::delete-project (sv/defmethod ::delete-project
[{:keys [id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id id) (proj/check-edition-permissions! conn profile-id id)
;; Schedule object deletion ;; Schedule object deletion

82
backend/src/app/services/mutations/teams.clj → backend/src/app/rpc/mutations/teams.clj
View file

@ -7,7 +7,7 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.teams (ns app.rpc.mutations.teams
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
@ -18,11 +18,10 @@
[app.emails :as emails] [app.emails :as emails]
[app.media :as media] [app.media :as media]
[app.media-storage :as mst] [app.media-storage :as mst]
[app.services.mutations :as sm] [app.rpc.mutations.projects :as projects]
[app.services.mutations.projects :as projects] [app.rpc.queries.profile :as profile]
[app.services.queries.profile :as profile] [app.rpc.queries.teams :as teams]
[app.services.queries.teams :as teams] [app.util.services :as sv]
[app.services.tokens :as tokens]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.storage :as ust] [app.util.storage :as ust]
[app.util.time :as dt] [app.util.time :as dt]
@ -48,9 +47,9 @@
(s/keys :req-un [::profile-id ::name] (s/keys :req-un [::profile-id ::name]
:opt-un [::id])) :opt-un [::id]))
(sm/defmutation ::create-team (sv/defmethod ::create-team
[params] [{:keys [pool] :as cfg} params]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [team (create-team conn params) (let [team (create-team conn params)
params (assoc params :team-id (:id team))] params (assoc params :team-id (:id team))]
(create-team-profile conn params) (create-team-profile conn params)
@ -90,9 +89,9 @@
(s/def ::update-team (s/def ::update-team
(s/keys :req-un [::profile-id ::name ::id])) (s/keys :req-un [::profile-id ::name ::id]))
(sm/defmutation ::update-team (sv/defmethod ::update-team
[{:keys [id name profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id name profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id id) (teams/check-edition-permissions! conn profile-id id)
(db/update! conn :team (db/update! conn :team
{:name name} {:name name}
@ -105,9 +104,9 @@
(s/def ::leave-team (s/def ::leave-team
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::leave-team (sv/defmethod ::leave-team
[{:keys [id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [perms (teams/check-read-permissions! conn profile-id id) (let [perms (teams/check-read-permissions! conn profile-id id)
members (teams/retrieve-team-members conn id)] members (teams/retrieve-team-members conn id)]
@ -133,9 +132,9 @@
(s/def ::delete-team (s/def ::delete-team
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-team (sv/defmethod ::delete-team
[{:keys [id profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [perms (teams/check-edition-permissions! conn profile-id id)] (let [perms (teams/check-edition-permissions! conn profile-id id)]
(when-not (:is-owner perms) (when-not (:is-owner perms)
(ex/raise :type :validation (ex/raise :type :validation
@ -156,9 +155,9 @@
(s/def ::update-team-member-role (s/def ::update-team-member-role
(s/keys :req-un [::profile-id ::team-id ::member-id ::role])) (s/keys :req-un [::profile-id ::team-id ::member-id ::role]))
(sm/defmutation ::update-team-member-role (sv/defmethod ::update-team-member-role
[{:keys [team-id profile-id member-id role] :as params}] [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id role] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [perms (teams/check-read-permissions! conn profile-id team-id) (let [perms (teams/check-read-permissions! conn profile-id team-id)
;; We retrieve all team members instead of query the ;; We retrieve all team members instead of query the
@ -218,9 +217,9 @@
(s/def ::delete-team-member (s/def ::delete-team-member
(s/keys :req-un [::profile-id ::team-id ::member-id])) (s/keys :req-un [::profile-id ::team-id ::member-id]))
(sm/defmutation ::delete-team-member (sv/defmethod ::delete-team-member
[{:keys [team-id profile-id member-id] :as params}] [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [perms (teams/check-read-permissions! conn profile-id team-id)] (let [perms (teams/check-read-permissions! conn profile-id team-id)]
(when-not (or (:is-owner perms) (when-not (or (:is-owner perms)
(:is-admin perms)) (:is-admin perms))
@ -245,15 +244,16 @@
(s/def ::update-team-photo (s/def ::update-team-photo
(s/keys :req-un [::profile-id ::team-id ::file])) (s/keys :req-un [::profile-id ::team-id ::file]))
(sm/defmutation ::update-team-photo (sv/defmethod ::update-team-photo
[{:keys [profile-id file team-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file team-id] :as params}]
(media/validate-media-type (:content-type file)) (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) (teams/check-edition-permissions! conn profile-id team-id)
(let [team (teams/retrieve-team conn profile-id team-id) (let [team (teams/retrieve-team conn profile-id team-id)
_ (media/run {:cmd :info :input {:path (:tempfile file) _ (media/run {:cmd :info :input {:path (:tempfile file)
:mtype (:content-type 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 ;; Schedule deletion of old photo
(when (and (string? (:photo team)) (when (and (string? (:photo team))
@ -268,7 +268,7 @@
(assoc team :photo (str photo))))) (assoc team :photo (str photo)))))
(defn upload-photo (defn upload-photo
[_conn {:keys [file]}] [{:keys [storage]} {:keys [file]}]
(let [prefix (-> (bn/random-bytes 8) (let [prefix (-> (bn/random-bytes 8)
(bc/bytes->b64u) (bc/bytes->b64u)
(bc/bytes->str)) (bc/bytes->str))
@ -281,7 +281,7 @@
:input {:path (fs/path (:tempfile file)) :input {:path (fs/path (:tempfile file))
:mtype (:content-type file)}}) :mtype (:content-type file)}})
name (str prefix (cm/format->extension (:format thumb)))] 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 ;; --- Mutation: Invite Member
@ -290,21 +290,21 @@
(s/def ::invite-team-member (s/def ::invite-team-member
(s/keys :req-un [::profile-id ::team-id ::email ::role])) (s/keys :req-un [::profile-id ::team-id ::email ::role]))
(sm/defmutation ::invite-team-member (sv/defmethod ::invite-team-member
[{:keys [profile-id team-id email role] :as params}] [{:keys [pool tokens] :as cfg} {:keys [profile-id team-id email role] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [perms (teams/check-edition-permissions! conn profile-id team-id) (let [perms (teams/check-edition-permissions! conn profile-id team-id)
profile (db/get-by-id conn :profile profile-id) profile (db/get-by-id conn :profile profile-id)
member (profile/retrieve-profile-data-by-email conn email) member (profile/retrieve-profile-data-by-email conn email)
team (db/get-by-id conn :team team-id) team (db/get-by-id conn :team team-id)
token (tokens/generate token (tokens :generate
{:iss :team-invitation {:iss :team-invitation
:exp (dt/in-future "24h") :exp (dt/in-future "24h")
:profile-id (:id profile) :profile-id (:id profile)
:role role :role role
:team-id team-id :team-id team-id
:member-email (:email member email) :member-email (:email member email)
:member-id (:id member)})] :member-id (:id member)})]
(when-not (:is-admin perms) (when-not (:is-admin perms)
(ex/raise :type :validation (ex/raise :type :validation

35
backend/src/app/services/mutations/verify_token.clj → backend/src/app/rpc/mutations/verify_token.clj
View file

@ -7,16 +7,17 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.verify-token ;; TODO: session
(ns app.rpc.mutations.verify-token
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.http.session :as session] [app.http.session :as session]
[app.services.mutations :as sm] [app.rpc.mutations.teams :as teams]
[app.services.mutations.teams :as teams] [app.rpc.queries.profile :as profile]
[app.services.queries.profile :as profile] [app.util.services :as sv]
[app.services.tokens :as tokens]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
(defmulti process-token (fn [_ _ claims] (:iss claims))) (defmulti process-token (fn [_ _ claims] (:iss claims)))
@ -25,14 +26,15 @@
(s/keys :req-un [::token] (s/keys :req-un [::token]
:opt-un [::profile-id])) :opt-un [::profile-id]))
(sm/defmutation ::verify-token (sv/defmethod ::verify-token {:auth false}
[{:keys [token] :as params}] [{:keys [pool tokens] :as cfg} {:keys [token] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [claims (tokens/verify token)] (let [claims (tokens :verify {:token token})
(process-token conn params claims)))) cfg (assoc cfg :conn conn)]
(process-token cfg params claims))))
(defmethod process-token :change-email (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) (when (profile/retrieve-profile-data-by-email conn email)
(ex/raise :type :validation (ex/raise :type :validation
:code :email-already-exists)) :code :email-already-exists))
@ -42,7 +44,7 @@
claims) claims)
(defmethod process-token :verify-email (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})] (let [profile (db/get-by-id conn :profile profile-id {:for-update true})]
(when (:is-active profile) (when (:is-active profile)
(ex/raise :type :validation (ex/raise :type :validation
@ -58,7 +60,7 @@
claims)) claims))
(defmethod process-token :auth (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)] (let [profile (profile/retrieve-profile conn profile-id)]
(assoc claims :profile profile))) (assoc claims :profile profile)))
@ -83,7 +85,7 @@
:opt-un [:internal.tokens.team-invitation/member-id])) :opt-un [:internal.tokens.team-invitation/member-id]))
(defmethod process-token :team-invitation (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) (us/assert ::team-invitation-claims claims)
(if (uuid? member-id) (if (uuid? member-id)
(let [params (merge {:team-id team-id (let [params (merge {:team-id team-id
@ -107,9 +109,10 @@
{:transform-response {:transform-response
(fn [request response] (fn [request response]
(let [uagent (get-in request [:headers "user-agent"]) (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 (assoc response
:cookies (session/cookies id))))}))) :cookies (session/cookies session {:value id}))))})))
;; In this case, we waint until frontend app redirect user to ;; In this case, we waint until frontend app redirect user to
;; registeration page, the user is correctly registered and the ;; registeration page, the user is correctly registered and the

18
backend/src/app/services/mutations/viewer.clj → backend/src/app/rpc/mutations/viewer.clj
View file

@ -7,12 +7,12 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.mutations.viewer (ns app.rpc.mutations.viewer
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm] [app.rpc.queries.files :as files]
[app.services.queries.files :as files] [app.util.services :as sv]
[buddy.core.codecs :as bc] [buddy.core.codecs :as bc]
[buddy.core.nonce :as bn] [buddy.core.nonce :as bn]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
@ -24,9 +24,9 @@
(s/def ::create-file-share-token (s/def ::create-file-share-token
(s/keys :req-un [::profile-id ::file-id ::page-id])) (s/keys :req-un [::profile-id ::file-id ::page-id]))
(sm/defmutation ::create-file-share-token (sv/defmethod ::create-file-share-token
[{:keys [profile-id file-id page-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(let [token (-> (bn/random-bytes 16) (let [token (-> (bn/random-bytes 16)
(bc/bytes->b64u) (bc/bytes->b64u)
@ -42,9 +42,9 @@
(s/def ::delete-file-share-token (s/def ::delete-file-share-token
(s/keys :req-un [::profile-id ::file-id ::token])) (s/keys :req-un [::profile-id ::file-id ::token]))
(sm/defmutation ::delete-file-share-token (sv/defmethod ::delete-file-share-token
[{:keys [profile-id file-id token]}] [{:keys [pool] :as cfg} {:keys [profile-id file-id token]}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(db/delete! conn :file-share-token (db/delete! conn :file-share-token
{:file-id file-id {:file-id file-id

32
backend/src/app/services/queries/comments.clj → backend/src/app/rpc/queries/comments.clj
View file

@ -7,13 +7,13 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.comments (ns app.rpc.queries.comments
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.rpc.queries.files :as files]
[app.services.queries.files :as files] [app.rpc.queries.teams :as teams]
[app.services.queries.teams :as teams] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
(defn decode-row (defn decode-row
@ -34,9 +34,9 @@
:opt-un [::file-id ::team-id]) :opt-un [::file-id ::team-id])
#(or (:file-id %) (:team-id %)))) #(or (:file-id %) (:team-id %))))
(sq/defquery ::comment-threads (sv/defmethod ::comment-threads
[{:keys [profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(files/check-read-permissions! conn profile-id file-id) (files/check-read-permissions! conn profile-id file-id)
(retrieve-comment-threads conn params))) (retrieve-comment-threads conn params)))
@ -77,9 +77,9 @@
(s/def ::unread-comment-threads (s/def ::unread-comment-threads
(s/keys :req-un [::profile-id ::team-id])) (s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::unread-comment-threads (sv/defmethod ::unread-comment-threads
[{:keys [profile-id team-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id) (teams/check-read-permissions! conn profile-id team-id)
(retrieve-unread-comment-threads conn params))) (retrieve-unread-comment-threads conn params)))
@ -122,9 +122,9 @@
(s/def ::comment-thread (s/def ::comment-thread
(s/keys :req-un [::profile-id ::file-id ::id])) (s/keys :req-un [::profile-id ::file-id ::id]))
(sq/defquery ::comment-thread (sv/defmethod ::comment-thread
[{:keys [profile-id file-id id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id id] :as params}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(files/check-read-permissions! conn profile-id file-id) (files/check-read-permissions! conn profile-id file-id)
(let [sql (str "with threads as (" sql:comment-threads ")" (let [sql (str "with threads as (" sql:comment-threads ")"
"select * from threads where id = ?")] "select * from threads where id = ?")]
@ -141,9 +141,9 @@
(s/def ::comments (s/def ::comments
(s/keys :req-un [::profile-id ::thread-id])) (s/keys :req-un [::profile-id ::thread-id]))
(sq/defquery ::comments (sv/defmethod ::comments
[{:keys [profile-id thread-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id thread-id] :as params}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(let [thread (db/get-by-id conn :comment-thread thread-id)] (let [thread (db/get-by-id conn :comment-thread thread-id)]
(files/check-read-permissions! conn profile-id (:file-id thread)) (files/check-read-permissions! conn profile-id (:file-id thread))
(retrieve-comments conn thread-id)))) (retrieve-comments conn thread-id))))

48
backend/src/app/services/queries/files.clj → backend/src/app/rpc/queries/files.clj
View file

@ -7,14 +7,14 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.files (ns app.rpc.queries.files
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.pages.migrations :as pmg] [app.common.pages.migrations :as pmg]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.rpc.queries.projects :as projects]
[app.services.queries.projects :as projects] [app.util.services :as sv]
[app.util.blob :as blob] [app.util.blob :as blob]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
@ -127,9 +127,9 @@
(s/def ::search-files (s/def ::search-files
(s/keys :req-un [::profile-id ::team-id ::search-term])) (s/keys :req-un [::profile-id ::team-id ::search-term]))
(sq/defquery ::search-files (sv/defmethod ::search-files
[{:keys [profile-id team-id search-term] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id team-id search-term] :as params}]
(let [rows (db/exec! db/pool [sql:search-files (let [rows (db/exec! pool [sql:search-files
profile-id team-id profile-id team-id
profile-id team-id profile-id team-id
search-term])] search-term])]
@ -149,9 +149,9 @@
(s/def ::files (s/def ::files
(s/keys :req-un [::profile-id ::project-id])) (s/keys :req-un [::profile-id ::project-id]))
(sq/defquery ::files (sv/defmethod ::files
[{:keys [profile-id project-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(projects/check-read-permissions! conn profile-id project-id) (projects/check-read-permissions! conn profile-id project-id)
(into [] decode-row-xf (db/exec! conn [sql:files project-id])))) (into [] decode-row-xf (db/exec! conn [sql:files project-id]))))
@ -167,18 +167,18 @@
(s/def ::file (s/def ::file
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sq/defquery ::file (sv/defmethod ::file
[{:keys [profile-id id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id id) (check-edition-permissions! conn profile-id id)
(retrieve-file conn id))) (retrieve-file conn id)))
(s/def ::page (s/def ::page
(s/keys :req-un [::profile-id ::id ::file-id])) (s/keys :req-un [::profile-id ::id ::file-id]))
(sq/defquery ::page (sv/defmethod ::page
[{:keys [profile-id file-id id]}] [{:keys [pool] :as cfg} {:keys [profile-id file-id id]}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id) (check-edition-permissions! conn profile-id file-id)
(let [file (retrieve-file conn file-id)] (let [file (retrieve-file conn file-id)]
(get-in file [:data :pages-index id])))) (get-in file [:data :pages-index id]))))
@ -199,9 +199,9 @@
(s/def ::shared-files (s/def ::shared-files
(s/keys :req-un [::profile-id ::team-id])) (s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::shared-files (sv/defmethod ::shared-files
[{:keys [profile-id team-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(into [] decode-row-xf (db/exec! db/pool [sql:shared-files team-id]))) (into [] decode-row-xf (db/exec! pool [sql:shared-files team-id])))
;; --- Query: File Libraries used by a File ;; --- Query: File Libraries used by a File
@ -237,9 +237,9 @@
(s/def ::file-libraries (s/def ::file-libraries
(s/keys :req-un [::profile-id ::file-id])) (s/keys :req-un [::profile-id ::file-id]))
(sq/defquery ::file-libraries (sv/defmethod ::file-libraries
[{:keys [profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id) (check-edition-permissions! conn profile-id file-id)
(retrieve-file-libraries conn false file-id))) (retrieve-file-libraries conn false file-id)))
@ -263,9 +263,9 @@
(s/def ::file-library (s/def ::file-library
(s/keys :req-un [::profile-id ::file-id])) (s/keys :req-un [::profile-id ::file-id]))
(sq/defquery ::file-library (sv/defmethod ::file-library
[{:keys [profile-id file-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id) ;; TODO: this should check read permissions (check-edition-permissions! conn profile-id file-id) ;; TODO: this should check read permissions
(retrieve-file-library conn file-id))) (retrieve-file-library conn file-id)))

11
backend/src/app/services/queries/profile.clj → backend/src/app/rpc/queries/profile.clj
View file

@ -7,13 +7,13 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.profile (ns app.rpc.queries.profile
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.util.services :as sv]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str])) [cuerdas.core :as str]))
@ -38,11 +38,10 @@
(s/def ::profile (s/def ::profile
(s/keys :opt-un [::profile-id])) (s/keys :opt-un [::profile-id]))
(sq/defquery ::profile (sv/defmethod ::profile {:auth false}
[{:keys [profile-id] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
(if profile-id (if profile-id
(with-open [conn (db/open)] (retrieve-profile pool profile-id)
(retrieve-profile conn profile-id))
{:id uuid/zero {:id uuid/zero
:fullname "Anonymous User"})) :fullname "Anonymous User"}))

18
backend/src/app/services/queries/projects.clj → backend/src/app/rpc/queries/projects.clj
View file

@ -7,13 +7,13 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.projects (ns app.rpc.queries.projects
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.rpc.queries.teams :as teams]
[app.services.queries.teams :as teams] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
;; --- Check Project Permissions ;; --- Check Project Permissions
@ -68,9 +68,9 @@
(s/def ::projects (s/def ::projects
(s/keys :req-un [::profile-id ::team-id])) (s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::projects (sv/defmethod ::projects
[{:keys [profile-id team-id]}] [{:keys [pool]} {:keys [profile-id team-id]}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id) (teams/check-read-permissions! conn profile-id team-id)
(retrieve-projects conn profile-id team-id))) (retrieve-projects conn profile-id team-id)))
@ -100,9 +100,9 @@
(s/def ::project (s/def ::project
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sq/defquery ::project (sv/defmethod ::project
[{:keys [profile-id id]}] [{:keys [pool]} {:keys [profile-id id]}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(let [project (db/get-by-id conn :project id)] (let [project (db/get-by-id conn :project id)]
(check-read-permissions! conn profile-id id) (check-read-permissions! conn profile-id id)
project))) project)))

14
backend/src/app/services/queries/recent_files.clj → backend/src/app/rpc/queries/recent_files.clj
View file

@ -7,13 +7,13 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.recent-files (ns app.rpc.queries.recent-files
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.rpc.queries.files :refer [decode-row-xf]]
[app.services.queries.files :refer [decode-row-xf]] [app.rpc.queries.teams :as teams]
[app.services.queries.teams :as teams] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
(def sql:recent-files (def sql:recent-files
@ -35,9 +35,9 @@
(s/def ::recent-files (s/def ::recent-files
(s/keys :req-un [::profile-id ::team-id])) (s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::recent-files (sv/defmethod ::recent-files
[{:keys [profile-id team-id]}] [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id) (teams/check-read-permissions! conn profile-id team-id)
(let [files (db/exec! conn [sql:recent-files team-id])] (let [files (db/exec! conn [sql:recent-files team-id])]
(into [] decode-row-xf files)))) (into [] decode-row-xf files))))

36
backend/src/app/services/queries/teams.clj → backend/src/app/rpc/queries/teams.clj
View file

@ -7,13 +7,13 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.teams (ns app.rpc.queries.teams
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.rpc.queries.profile :as profile]
[app.services.queries.profile :as profile] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
;; --- Team Edition Permissions ;; --- Team Edition Permissions
@ -54,9 +54,9 @@
(s/def ::teams (s/def ::teams
(s/keys :req-un [::profile-id])) (s/keys :req-un [::profile-id]))
(sq/defquery ::teams (sv/defmethod ::teams
[{:keys [profile-id]}] [{:keys [pool] :as cfg} {:keys [profile-id]}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(retrieve-teams conn profile-id))) (retrieve-teams conn profile-id)))
(def sql:teams (def sql:teams
@ -84,9 +84,9 @@
(s/def ::team (s/def ::team
(s/keys :req-un [::profile-id ::id])) (s/keys :req-un [::profile-id ::id]))
(sq/defquery ::team (sv/defmethod ::team
[{:keys [profile-id id]}] [{:keys [pool] :as cfg} {:keys [profile-id id]}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(retrieve-team conn profile-id id))) (retrieve-team conn profile-id id)))
(defn retrieve-team (defn retrieve-team
@ -108,9 +108,9 @@
(s/def ::team-members (s/def ::team-members
(s/keys :req-un [::profile-id ::team-id])) (s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::team-members (sv/defmethod ::team-members
[{:keys [profile-id team-id]}] [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(check-edition-permissions! conn profile-id team-id) (check-edition-permissions! conn profile-id team-id)
(retrieve-team-members conn team-id))) (retrieve-team-members conn team-id)))
@ -141,9 +141,9 @@
:opt-un [::team-id ::file-id]) :opt-un [::team-id ::file-id])
#(or (:team-id %) (:file-id %)))) #(or (:team-id %) (:file-id %))))
(sq/defquery ::team-users (sv/defmethod ::team-users
[{:keys [profile-id team-id file-id]}] [{:keys [pool] :as cfg} {:keys [profile-id team-id file-id]}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(if team-id (if team-id
(do (do
(check-edition-permissions! conn profile-id team-id) (check-edition-permissions! conn profile-id team-id)
@ -197,9 +197,9 @@
(s/def ::team-stats (s/def ::team-stats
(s/keys :req-un [::profile-id ::team-id])) (s/keys :req-un [::profile-id ::team-id]))
(sq/defquery ::team-stats (sv/defmethod ::team-stats
[{:keys [profile-id team-id]}] [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
(with-open [conn (db/open)] (with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id) (check-read-permissions! conn profile-id team-id)
(retrieve-team-stats conn team-id))) (retrieve-team-stats conn team-id)))

14
backend/src/app/services/queries/viewer.clj → backend/src/app/rpc/queries/viewer.clj
View file

@ -7,14 +7,14 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.queries.viewer (ns app.rpc.queries.viewer
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.services.queries :as sq] [app.rpc.queries.files :as files]
[app.services.queries.files :as files] [app.rpc.queries.teams :as teams]
[app.services.queries.teams :as teams] [app.util.services :as sv]
[clojure.spec.alpha :as s])) [clojure.spec.alpha :as s]))
;; --- Query: Viewer Bundle (by Page ID) ;; --- Query: Viewer Bundle (by Page ID)
@ -42,9 +42,9 @@
(s/keys :req-un [::file-id ::page-id] (s/keys :req-un [::file-id ::page-id]
:opt-un [::profile-id ::token])) :opt-un [::profile-id ::token]))
(sq/defquery ::viewer-bundle (sv/defmethod ::viewer-bundle {:auth false}
[{:keys [profile-id file-id page-id token] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id token] :as params}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [file (files/retrieve-file conn file-id) (let [file (files/retrieve-file conn file-id)
project (retrieve-project conn (:project-id file)) project (retrieve-project conn (:project-id file))
page (get-in file [:data :pages-index page-id]) page (get-in file [:data :pages-index page-id])

43
backend/src/app/services.clj
View file

@ -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))

10
backend/src/app/services/init.clj
View file

@ -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)

71
backend/src/app/services/middleware.clj
View file

@ -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)))

21
backend/src/app/services/mutations.clj
View file

@ -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))

21
backend/src/app/services/queries.clj
View file

@ -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))

62
backend/src/app/services/tokens.clj
View file

@ -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)))

57
backend/src/app/srepl.clj Normal file
View file

@ -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)))

5
backend/src/app/srepl/main.clj
View file

@ -4,6 +4,7 @@
(:require (:require
[clojure.pprint :refer [pprint]] [clojure.pprint :refer [pprint]]
[app.db :as db] [app.db :as db]
[app.main :refer [system]]
[app.common.pages.migrations :as pmg] [app.common.pages.migrations :as pmg]
[app.util.blob :as blob] [app.util.blob :as blob]
[app.common.pages :as cp])) [app.common.pages :as cp]))
@ -11,7 +12,7 @@
(defn update-file (defn update-file
([id f] (update-file id f false)) ([id f] (update-file id f false))
([id f save?] ([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}) (let [file (db/get-by-id conn :file id {:for-update true})
file (-> file file (-> file
(update :data app.util.blob/decode) (update :data app.util.blob/decode)
@ -27,7 +28,7 @@
(defn update-file-raw (defn update-file-raw
[id data] [id data]
(db/with-atomic [conn db/pool] (db/with-atomic [conn (:app.db/pool system)]
(db/update! conn :file (db/update! conn :file
{:data data} {:data data}
{:id id}))) {:id id})))

38
backend/src/app/srepl/server.clj
View file

@ -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"))

2
backend/src/app/services/svgparse.clj → backend/src/app/svgparse.clj
View file

@ -7,7 +7,7 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.services.svgparse (ns app.svgparse
(:require (:require
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[clojure.xml :as xml] [clojure.xml :as xml]

33
backend/src/app/tasks.clj
View file

@ -12,7 +12,7 @@
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] ;; [app.metrics :as mtx]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log])) [clojure.tools.logging :as log]))
@ -33,20 +33,19 @@
returning id") returning id")
(defn submit! (defn submit!
([opts] (submit! db/pool opts)) [conn {:keys [name delay props queue priority max-retries]
([conn {:keys [name delay props queue priority max-retries] :or {delay 0 props {} queue "default" priority 100 max-retries 3}
:or {delay 0 props {} queue "default" priority 100 max-retries 3} :as options}]
:as options}] (us/verify ::task-options options)
(us/verify ::task-options options) (let [duration (dt/duration delay)
(let [duration (dt/duration delay) interval (db/interval duration)
interval (db/interval duration) props (db/tjson props)
props (db/tjson props) id (uuid/next)]
id (uuid/next)] (log/infof "Submit task '%s' to be executed in '%s'." name (str duration))
(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])
(db/exec-one! conn [sql:insert-new-task id name props queue priority max-retries interval]) id))
id)))
(mtx/instrument-with-counter! ;; (mtx/instrument-with-counter!
{:var #'submit! ;; {:var #'submit!
:id "tasks__submit_counter" ;; :id "tasks__submit_counter"
:help "Absolute task submit counter."}) ;; :help "Absolute task submit counter."})

39
backend/src/app/tasks/delete_object.clj
View file

@ -11,16 +11,36 @@
"Generic task for permanent deletion of objects." "Generic task for permanent deletion of objects."
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[integrant.core :as ig]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log])) [clojure.tools.logging :as log]))
(s/def ::type keyword?) (declare handler)
(s/def ::id ::us/uuid) (declare handle-deletion)
(s/def ::props (defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::id ::type])) (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))) (defmulti handle-deletion (fn [_ props] (:type props)))
@ -28,17 +48,6 @@
[_conn {:keys [type]}] [_conn {:keys [type]}]
(log/warn "no handler found for" 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 (defmethod handle-deletion :file
[conn {:keys [id] :as props}] [conn {:keys [id] :as props}]
(let [sql "delete from file where id=? and deleted_at is not null"] (let [sql "delete from file where id=? and deleted_at is not null"]

28
backend/src/app/tasks/delete_profile.clj
View file

@ -14,7 +14,22 @@
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[clojure.spec.alpha :as s] [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-profile-data)
(declare delete-teams) (declare delete-teams)
@ -26,10 +41,10 @@
(s/keys :req-un [::profile-id])) (s/keys :req-un [::profile-id]))
(defn handler (defn handler
[{:keys [props] :as task}] [{:keys [pool]} {:keys [props] :as task}]
(us/verify ::props props) (us/verify ::props props)
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [id (:profile-id props) (let [id (:profile-id props)
profile (db/get-by-id conn :profile id {:for-update true})] profile (db/get-by-id conn :profile id {:for-update true})]
(if (or (:is-demo profile) (if (or (:is-demo profile)
(not (nil? (:deleted-at profile)))) (not (nil? (:deleted-at profile))))
@ -37,11 +52,6 @@
(log/warn "Profile " (:id profile) (log/warn "Profile " (:id profile)
"does not match constraints for deletion"))))) "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 (defn- delete-profile-data
[conn profile-id] [conn profile-id]
(log/info "Proceding to delete all data related to profile" profile-id) (log/info "Proceding to delete all data related to profile" profile-id)

56
backend/src/app/tasks/file_media_gc.clj
View file

@ -13,20 +13,49 @@
after some period of inactivity (the default threshold is 72h)." after some period of inactivity (the default threshold is 72h)."
(:require (:require
[app.common.pages.migrations :as pmg] [app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.config :as cfg] [app.config :as cfg]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.tasks :as tasks] [app.tasks :as tasks]
[app.util.blob :as blob] [app.util.blob :as blob]
[app.util.time :as dt] [app.util.time :as dt]
[integrant.core :as ig]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log])) [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}] [{:keys [data] :as row}]
(cond-> row (cond-> row
(bytes? data) (assoc :data (blob/decode data)))) (bytes? data) (assoc :data (blob/decode data))))
(def sql:retrieve-candidates-chunk (def ^:private
sql:retrieve-candidates-chunk
"select f.id, "select f.id,
f.data, f.data,
extract(epoch from (now() - f.modified_at))::bigint as age extract(epoch from (now() - f.modified_at))::bigint as age
@ -37,9 +66,7 @@
limit 10 limit 10
for update skip locked") for update skip locked")
(defn retrieve-candidates (defn- retrieve-candidates
"Retrieves a list of files that are candidates to be garbage
collected."
[conn] [conn]
(let [threshold (:file-trimming-threshold cfg/config) (let [threshold (:file-trimming-threshold cfg/config)
interval (db/interval threshold)] interval (db/interval threshold)]
@ -47,7 +74,8 @@
(map (fn [{:keys [age] :as row}] (map (fn [{:keys [age] :as row}]
(assoc row :age (dt/duration {:seconds age}))))))) (assoc row :age (dt/duration {:seconds age})))))))
(def collect-media-xf (def ^:private
collect-media-xf
(comp (comp
(map :objects) (map :objects)
(mapcat vals) (mapcat vals)
@ -92,19 +120,3 @@
{:id id})) {:id id}))
nil)) 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"})

35
backend/src/app/tasks/file_xlog_gc.clj
View file

@ -12,27 +12,38 @@
change (transaction) log." change (transaction) log."
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[integrant.core :as ig]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log])) [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 "delete from task_completed
where scheduled_at < now() - ?::interval") where scheduled_at < now() - ?::interval")
(defn handler (defn- handler
[{:keys [props] :as task}] [{:keys [pool max-age]} _]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [interval (db/interval max-age) (let [interval (db/interval max-age)
result (db/exec-one! conn [sql:delete-files-xlog interval])] 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 (:next.jdbc/update-count result)]
(log/infof "removed %s rows from file_changes table" result)
nil))) nil)))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__file_xlog_gc"
:help "Timing of task: file_xlog_gc"})

99
backend/src/app/tasks/remove_media.clj
View file

@ -8,13 +8,14 @@
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tasks.remove-media (ns app.tasks.remove-media
"Demo accounts garbage collector." "TODO: pending to be refactored together with the storage
subsystem."
(:require (:require
[app.common.spec :as us] [app.common.spec :as us]
[app.db :as db] [app.db :as db]
[app.media-storage :as mst] ;; [app.media-storage :as mst]
[app.metrics :as mtx] ;; [app.metrics :as mtx]
[app.util.storage :as ust] ;; [app.util.storage :as ust]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log])) [clojure.tools.logging :as log]))
@ -26,21 +27,21 @@
;; system. Mainly used for profile photo change; when we really know ;; system. Mainly used for profile photo change; when we really know
;; that the previous photo becomes unused. ;; that the previous photo becomes unused.
(s/def ::path ::us/not-empty-string) ;; (s/def ::path ::us/not-empty-string)
(s/def ::props ;; (s/def ::props
(s/keys :req-un [::path])) ;; (s/keys :req-un [::path]))
(defn handler ;; (defn handler
[{:keys [props] :as task}] ;; [{:keys [props] :as task}]
(us/verify ::props props) ;; (us/verify ::props props)
(when (ust/exists? mst/media-storage (:path props)) ;; (when (ust/exists? mst/media-storage (:path props))
(ust/delete! mst/media-storage (:path props)) ;; (ust/delete! mst/media-storage (:path props))
(log/debug "Media " (:path props) " removed."))) ;; (log/debug "Media " (:path props) " removed.")))
(mtx/instrument-with-summary! ;; (mtx/instrument-with-summary!
{:var #'handler ;; {:var #'handler
:id "tasks__remove_media" ;; :id "tasks__remove_media"
:help "Timing of remove-media task."}) ;; :help "Timing of remove-media task."})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Task: Trim Media Storage ;; Task: Trim Media Storage
@ -59,37 +60,35 @@
;; task (`remove-deleted-media`) permanently delete the file from the ;; task (`remove-deleted-media`) permanently delete the file from the
;; filesystem when is executed (by scheduler). ;; filesystem when is executed (by scheduler).
(def ^:private ;; (def ^:private
sql:retrieve-peding-to-delete ;; sql:retrieve-peding-to-delete
"with items_part as ( ;; "with items_part as (
select i.id ;; select i.id
from pending_to_delete as i ;; from pending_to_delete as i
order by i.created_at ;; order by i.created_at
limit ? ;; limit ?
for update skip locked ;; for update skip locked
) ;; )
delete from pending_to_delete ;; delete from pending_to_delete
where id in (select id from items_part) ;; where id in (select id from items_part)
returning *") ;; 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))))))
;; (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))))))

56
backend/src/app/tasks/sendmail.clj
View file

@ -9,15 +9,50 @@
(ns app.tasks.sendmail (ns app.tasks.sendmail
(:require (:require
[app.common.spec :as us]
[app.config :as cfg] [app.config :as cfg]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.util.emails :as emails] [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! (defn- send-console!
[config email] [cfg email]
(let [baos (java.io.ByteArrayOutputStream.) (let [baos (java.io.ByteArrayOutputStream.)
mesg (emails/smtp-message config email)] mesg (emails/smtp-message cfg email)]
(.writeTo mesg baos) (.writeTo mesg baos)
(let [out (with-out-str (let [out (with-out-str
(println "email console dump:") (println "email console dump:")
@ -27,14 +62,7 @@
(log/info out)))) (log/info out))))
(defn handler (defn handler
{:app.tasks/name "sendmail"} [cfg {:keys [props] :as task}]
[{:keys [props] :as task}] (if (:enabled cfg)
(let [config (cfg/smtp cfg/config)] (emails/send! cfg props)
(if (:enabled config) (send-console! cfg props)))
(emails/send! config props)
(send-console! config props))))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__sendmail"
:help "Timing of sendmail task."})

41
backend/src/app/tasks/clean_tasks_table.clj → backend/src/app/tasks/tasks_gc.clj
View file

@ -7,7 +7,7 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; 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 "A maintenance task that performs a cleanup of already executed tasks
from the database table." from the database table."
(:require (:require
@ -16,25 +16,36 @@
[app.metrics :as mtx] [app.metrics :as mtx]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [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 "delete from task_completed
where scheduled_at < now() - ?::interval") where scheduled_at < now() - ?::interval")
(defn handler (defn- handler
[task] [{:keys [pool max-age]} _]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [interval (db/interval max-age) (let [interval (db/interval max-age)
result (db/exec-one! conn [sql:delete-completed-tasks interval])] 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 (:next.jdbc/update-count result)]
(log/infof "removed %s rows from tasks_completed table" result)
nil))) nil)))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__clean_tasks_table"
:help "Timing of task: clean_task_table"})

72
backend/src/app/tokens.clj Normal file
View file

@ -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)))))

65
backend/src/app/util/async.clj
View file

@ -6,10 +6,48 @@
(ns app.util.async (ns app.util.async
(:require (:require
[clojure.spec.alpha :as s]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.spec.alpha :as s]) [cuerdas.core :as str])
(:import (: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 (defmacro go-try
[& body] [& body]
@ -18,13 +56,6 @@
~@body ~@body
(catch Exception e# e#)))) (catch Exception e# e#))))
(defmacro <?
[ch]
`(let [r# (a/<! ~ch)]
(if (instance? Exception r#)
(throw r#)
r#)))
(defmacro thread-try (defmacro thread-try
[& body] [& body]
`(a/thread `(a/thread
@ -33,8 +64,12 @@
(catch Exception e# (catch Exception e#
e#)))) e#))))
(defmacro <?
(s/def ::executor #(instance? Executor %)) [ch]
`(let [r# (a/<! ~ch)]
(if (instance? Exception r#)
(throw r#)
r#)))
(defn thread-call (defn thread-call
[^Executor executor f] [^Executor executor f]
@ -50,6 +85,12 @@
(a/close! c))))) (a/close! c)))))
c c
(catch java.util.concurrent.RejectedExecutionException e (catch java.util.concurrent.RejectedExecutionException e
(a/offer! c e)
(a/close! c) (a/close! c)
c)))) c))))
(defmacro with-thread
[executor & body]
(if (= executor ::default)
`(a/thread-call (^:once fn* [] (try ~@body (catch Exception e# e#))))
`(thread-call ~executor (^:once fn* [] ~@body))))

39
backend/src/app/util/services.clj Normal file
View file

@ -0,0 +1,39 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020-2021 Andrey Antukh <niwi@niwi.nz>
(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))

445
backend/src/app/worker.clj
View file

@ -5,105 +5,174 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as ;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0. ;; defined by the Mozilla Public License, v. 2.0.
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns app.worker (ns app.worker
"Async tasks abstraction (impl)."
(:require (:require
[app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db] [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.async :as aa]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.core.async :as a] [clojure.core.async :as a]
[clojure.pprint :refer [pprint]]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[clojure.tools.logging :as log] [clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]] [cuerdas.core :as str]
[integrant.core :as ig]
[promesa.exec :as px]) [promesa.exec :as px])
(:import (:import
org.eclipse.jetty.util.thread.QueuedThreadPool org.eclipse.jetty.util.thread.QueuedThreadPool
java.util.concurrent.ExecutorService java.util.concurrent.ExecutorService
java.util.concurrent.Executors java.util.concurrent.Executors
java.time.Instant)) java.util.concurrent.Executor
java.time.Duration
java.time.Instant
java.util.Date))
(declare start-scheduler-worker!) (s/def ::executor #(instance? Executor %))
(declare start-worker!)
(declare thread-pool)
(declare stop!)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry Point (state initialization) ;; Executor
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private tasks (s/def ::name ::us/string)
{"delete-profile" #'app.tasks.delete-profile/handler (s/def ::min-threads ::us/integer)
"delete-object" #'app.tasks.delete-object/handler (s/def ::max-threads ::us/integer)
"remove-media" #'app.tasks.remove-media/handler (s/def ::idle-timeout ::us/integer)
"sendmail" #'app.tasks.sendmail/handler})
(def ^:private schedule (defmethod ig/pre-init-spec ::executor [_]
[{:id "remove-deleted-media" (s/keys :opt-un [::min-threads ::max-threads ::idle-timeout ::name]))
:cron #app/cron "0 0 0 */1 * ? *" ;; daily
:fn #'app.tasks.remove-media/trim-media-storage}
{:id "file-media-gc" (defmethod ig/prep-key ::executor
:cron #app/cron "0 0 0 */1 * ? *" ;; daily [_ cfg]
:fn #'app.tasks.file-media-gc/handler} (merge {:min-threads 0
:max-threads 256
:idle-timeout 60000
:name "worker"}
cfg))
{:id "file-xlog-gc" (defmethod ig/init-key ::executor
:cron #app/cron "0 0 0 */1 * ?" ;; daily [_ {:keys [min-threads max-threads idle-timeout name]}]
:fn #'app.tasks.file-xlog-gc/handler} (doto (QueuedThreadPool. (int max-threads)
(int min-threads)
(int idle-timeout))
(.setStopTimeout 500)
(.setName name)
(.start)))
{:id "clean-tasks-table" (defmethod ig/halt-key! ::executor
:cron #app/cron "0 0 0 */1 * ?" ;; daily [_ instance]
:fn #'app.tasks.clean-tasks-table/handler} (.stop ^QueuedThreadPool instance))
])
(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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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/<! (a/timeout poll-interval))
(recur))
(and (instance? java.sql.SQLException val)
(= "40001" (.getSQLState ^java.sql.SQLException val)))
(do
(log/debug "Serialization failure (retrying in some instants).")
(a/<! (a/timeout poll-ms))
(recur))
(instance? Exception val)
(do
(log/errorf val "Unexpected error ocurried on polling the database (will resume in some instants).")
(a/<! (a/timeout poll-ms))
(recur))
(= ::handled val)
(recur)
(= ::empty val)
(do
(a/<! (a/timeout poll-ms))
(recur)))))
(reify
java.lang.AutoCloseable
(close [_]
(a/close! cch)))))
(defmethod ig/halt-key! ::worker
[_ instance]
(.close ^java.lang.AutoCloseable instance))
(def ^:private (def ^:private
sql:mark-as-retry sql:mark-as-retry
"update task "update task
set scheduled_at = clock_timestamp() + '10 seconds'::interval, set scheduled_at = clock_timestamp() + ?::interval,
modified_at = clock_timestamp(), modified_at = clock_timestamp(),
error = ?, error = ?,
status = 'retry', status = 'retry',
retry_num = retry_num + ? retry_num = retry_num + ?
where id = ?") where id = ?")
(def default-delay
(dt/duration {:seconds 10}))
(defn- mark-as-retry (defn- mark-as-retry
[conn {:keys [task error inc-by] [conn {:keys [task error inc-by delay]
:or {inc-by 1}}] :or {inc-by 1 delay default-delay}}]
(let [explain (ex-message error) (let [explain (ex-message error)
sqlv [sql:mark-as-retry explain inc-by (:id task)]] delay (db/interval delay)
sqlv [sql:mark-as-retry delay explain inc-by (:id task)]]
(db/exec-one! conn sqlv) (db/exec-one! conn sqlv)
nil)) nil))
@ -118,7 +187,7 @@
nil)) nil))
(defn- mark-as-completed (defn- mark-as-completed
[conn {:keys [task] :as opts}] [conn {:keys [task] :as cfg}]
(let [now (dt/now)] (let [now (dt/now)]
(db/update! conn :task (db/update! conn :task
{:completed-at now {:completed-at now
@ -138,40 +207,45 @@
(let [task-fn (get tasks name)] (let [task-fn (get tasks name)]
(if task-fn (if task-fn
(task-fn item) (task-fn item)
(log/warn "no task handler found for" (pr-str name)))
{:status :completed :task item}))
(defn- handle-exception
[error item]
(let [edata (ex-data error)]
(if (and (< (:retry-num item)
(:max-retries item))
(= ::retry (:type edata)))
(cond-> {:status :retry :task item :error error}
(dt/duration? (:delay edata))
(assoc :delay (:delay edata))
(= ::noop (:strategy edata))
(assoc :inc-by 0))
(do (do
(log/warn "no task handler found for" (pr-str name)) (log/errorf error
nil)))) (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 (defn- run-task
[{:keys [tasks]} item] [{:keys [tasks conn]} item]
(try (try
(log/debugf "Started task '%s/%s/%s'." (:name item) (:id item) (:retry-num item)) (log/debugf "Started task '%s/%s/%s'." (:name item) (:id item) (:retry-num item))
(handle-task tasks item) (handle-task tasks item)
{:status :completed :task item}
(catch Exception e (catch Exception e
(let [data (ex-data e)] (handle-exception e item))
(cond
(and (= ::retry (:type data))
(= ::noop (:strategy data)))
{:status :retry :task item :error e :inc-by 0}
(and (< (:retry-num item)
(:max-retries item))
(= ::retry (:type data)))
{:status :retry :task item :error e}
:else
(do
(log/errorf e "Unhandled exception on task '%s' (retry: %s)\nProps: %s"
(:name item) (:retry-num item) (pr-str (:props item)))
(if (>= (:retry-num item) (:max-retries item))
{:status :failed :task item :error e}
{:status :retry :task item :error e})))))
(finally (finally
(log/debugf "Finished task '%s/%s/%s'." (:name item) (:id item) (:retry-num item))))) (log/debugf "Finished task '%s/%s/%s'." (:name item) (:id item) (:retry-num item)))))
(def ^:private (def sql:select-next-tasks
sql:select-next-tasks
"select * from task as t "select * from task as t
where t.scheduled_at <= now() where t.scheduled_at <= now()
and t.queue = ? and t.queue = ?
@ -181,103 +255,69 @@
for update skip locked") for update skip locked")
(defn- event-loop-fn* (defn- event-loop-fn*
[{:keys [executor batch-size] :as opts}] [{:keys [tasks pool executor batch-size] :as cfg}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(let [queue (:queue opts "default") (let [queue (:queue cfg)
items (->> (db/exec! conn [sql:select-next-tasks queue batch-size]) items (->> (db/exec! conn [sql:select-next-tasks queue batch-size])
(map decode-task-row) (map decode-task-row)
(seq)) (seq))
opts (assoc opts :conn conn)] cfg (assoc cfg :conn conn)]
(if (nil? items) (if (nil? items)
::empty ::empty
(let [results (->> items (let [proc-xf (comp (map #(partial run-task cfg %))
(map #(partial run-task opts %)) (map #(px/submit! executor %)))]
(map #(px/submit! executor %)))] (->> (into [] proc-xf items)
(doseq [res results] (map deref)
(let [res (deref res)] (run! (fn [res]
(case (:status res) (case (:status res)
:retry (mark-as-retry conn res) :retry (mark-as-retry conn res)
:failed (mark-as-failed conn res) :failed (mark-as-failed conn res)
:completed (mark-as-completed conn res)))) :completed (mark-as-completed conn res)))))
::handled))))) ::handled)))))
(defn- event-loop-fn (defn- event-loop-fn
[{:keys [executor] :as opts}] [{:keys [executor] :as cfg}]
(aa/thread-call executor #(event-loop-fn* opts))) (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 ::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/def ::scheduled-task
(s/keys :req-un [::tasks ::aa/executor ::batch-size] (s/keys :req-un [::id ::cron ::fn]
:opt-un [::poll-interval])) :opt-un [::props]))
(defn start-worker! (s/def ::schedule (s/coll-of ::scheduled-task))
[{: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"))
(db/pool-closed? db/pool) (defmethod ig/pre-init-spec ::scheduler [_]
(do (s/keys :req-un [::executor ::db/pool ::schedule]))
(log/info "Worker eventloop is aborted because pool is closed.")
(a/close! cch))
(and (instance? java.sql.SQLException val)
(contains? #{"08003" "08006" "08001" "08004"} (.getSQLState val)))
(do
(log/error "Connection error, trying resume in some instants.")
(a/<! (a/timeout poll-interval))
(recur))
(and (instance? java.sql.SQLException val)
(= "40001" (.getSQLState ^java.sql.SQLException val)))
(do
(log/debug "Serialization failure (retrying in some instants).")
(a/<! (a/timeout 1000))
(recur))
(instance? Exception val)
(do
(log/errorf val "Unexpected error ocurried on polling the database (will resume operations in some instants). ")
(a/<! (a/timeout poll-interval))
(recur))
(= ::handled val)
(recur)
(= ::empty val)
(do
(a/<! (a/timeout poll-interval))
(recur)))))
(defmethod ig/init-key ::scheduler
[_ {:keys [executor schedule] :as cfg}]
(let [scheduler (Executors/newScheduledThreadPool (int 1))
cfg (assoc cfg :scheduler scheduler)]
(synchronize-schedule cfg)
(run! (partial schedule-task cfg) schedule)
(reify (reify
java.lang.AutoCloseable java.lang.AutoCloseable
(close [_] (close [_]
(a/close! cch))))) (.shutdownNow ^ExecutorService scheduler)))))
(defmethod ig/halt-key! ::scheduler
[_ instance]
(.close ^java.lang.AutoCloseable instance))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (def sql:upsert-scheduled-task
;; Scheduled Tasks (cron based) IMPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private
sql:upsert-scheduled-task
"insert into scheduled_task (id, cron_expr) "insert into scheduled_task (id, cron_expr)
values (?, ?) values (?, ?)
on conflict (id) on conflict (id)
@ -286,18 +326,18 @@
(defn- synchronize-schedule-item (defn- synchronize-schedule-item
[conn {:keys [id cron]}] [conn {:keys [id cron]}]
(let [cron (str cron)] (let [cron (str cron)]
(log/debugf "Initialize scheduled task '%s' (cron: '%s')." id cron) (log/debugf "initialize scheduled task '%s' (cron: '%s')." id cron)
(db/exec-one! conn [sql:upsert-scheduled-task id cron cron]))) (db/exec-one! conn [sql:upsert-scheduled-task id cron cron])))
(defn- synchronize-schedule! (defn- synchronize-schedule
[schedule] [{:keys [pool schedule]}]
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(run! (partial synchronize-schedule-item conn) schedule))) (run! (partial synchronize-schedule-item conn) schedule)))
(def ^:private sql:lock-scheduled-task (def sql:lock-scheduled-task
"select id from scheduled_task where id=? for update skip locked") "select id from scheduled_task where id=? for update skip locked")
(declare schedule-task!) (declare schedule-task)
(defn exception->string (defn exception->string
[error] [error]
@ -305,7 +345,7 @@
(.printStackTrace ^Throwable error (java.io.PrintWriter. *out*)))) (.printStackTrace ^Throwable error (java.io.PrintWriter. *out*))))
(defn- execute-scheduled-task (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] (letfn [(run-task [conn]
(try (try
(when (db/exec-one! conn [sql:lock-scheduled-task id]) (when (db/exec-one! conn [sql:lock-scheduled-task id])
@ -318,7 +358,7 @@
(let [result (run-task conn)] (let [result (run-task conn)]
(if (instance? Throwable result) (if (instance? Throwable result)
(do (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 (db/insert! conn :scheduled-task-history
{:id (uuid/next) {:id (uuid/next)
:task-id id :task-id id
@ -328,75 +368,22 @@
{:id (uuid/next) {:id (uuid/next)
:task-id id})))) :task-id id}))))
(handle-task [] (handle-task []
(db/with-atomic [conn db/pool] (db/with-atomic [conn pool]
(handle-task* conn)))] (handle-task* conn)))]
(try (try
(px/run! executor handle-task) (px/run! executor handle-task)
(finally (finally
(schedule-task! opts task))))) (schedule-task cfg task)))))
(defn ms-until-valid (defn- ms-until-valid
[cron] [cron]
(s/assert dt/cron? cron) (s/assert dt/cron? cron)
(let [^Instant now (dt/now) (let [now (dt/now)
^Instant next (dt/next-valid-instant-from cron now)] next (dt/next-valid-instant-from cron now)]
(inst-ms (dt/duration-between now next)))) (inst-ms (dt/duration-between now next))))
(defn- schedule-task! (defn- schedule-task
[{:keys [scheduler] :as opts} {:keys [cron] :as task}] [{:keys [scheduler] :as cfg} {:keys [cron] :as task}]
(let [ms (ms-until-valid cron)] (let [ms (ms-until-valid cron)]
(px/schedule! scheduler ms (partial execute-scheduled-task opts task)))) (px/schedule! scheduler ms (partial execute-scheduled-task cfg 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)))

101
backend/tests/app/tests/helpers.clj
View file

@ -9,58 +9,54 @@
(ns app.tests.helpers (ns app.tests.helpers
(:require (: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.java.io :as io]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[promesa.core :as p]
[datoteka.core :as fs]
[cuerdas.core :as str] [cuerdas.core :as str]
[mount.core :as mount] [datoteka.core :as fs]
[environ.core :refer [env]] [environ.core :refer [env]]
[app.common.pages :as cp] [integrant.core :as ig]
[app.services] [promesa.core :as p])
[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])
(:import org.postgresql.ds.PGSimpleDataSource)) (:import org.postgresql.ds.PGSimpleDataSource))
(defn testing-datasource (def ^:dynamic *system* nil)
[] (def ^:dynamic *pool* nil)
(doto (PGSimpleDataSource.)
(.setServerName "postgres")
(.setDatabaseName "penpot_test")
(.setUser "penpot")
(.setPassword "penpot")))
(defn state-init (defn state-init
[next] [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 (try
(let [pool (testing-datasource)] (binding [*system* system
(-> (mount/only #{#'app.config/config *pool* (:app.db/pool system)]
#'app.db/pool (next))
#'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)
(finally (finally
(mount/stop))))) (ig/halt! system)))))
(defn database-reset (defn database-reset
[next] [next]
@ -68,7 +64,7 @@
" FROM information_schema.tables " " FROM information_schema.tables "
" WHERE table_schema = 'public' " " WHERE table_schema = 'public' "
" AND table_name != 'migrations';")] " AND table_name != 'migrations';")]
(db/with-atomic [conn db/pool] (db/with-atomic [conn *pool*]
(let [result (->> (db/exec! conn [sql]) (let [result (->> (db/exec! conn [sql])
(map :table-name))] (map :table-name))]
(db/exec! conn [(str "TRUNCATE " (db/exec! conn [(str "TRUNCATE "
@ -77,14 +73,12 @@
(try (try
(next) (next)
(finally (finally
(ust/clear! app.media-storage/media-storage) (ust/clear! (:app.media-storage/storage *system*)))))
(ust/clear! app.media-storage/assets-storage))))
(defn mk-uuid (defn mk-uuid
[prefix & args] [prefix & args]
(uuid/namespaced uuid/zero (apply str prefix args))) (uuid/namespaced uuid/zero (apply str prefix args)))
;; --- Profile creation
(defn create-profile (defn create-profile
[conn i] [conn i]
@ -157,12 +151,27 @@
{:error (handle-error e#) {:error (handle-error e#)
:result nil}))) :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! (defn print-error!
[error] [error]
(let [data (ex-data error)] (let [data (ex-data error)]
(cond (cond
(= :spec-validation (:code data)) (= :spec-validation (:code data))
(println (:explain data)) (expound/printer (:data data))
(= :service-error (:type data)) (= :service-error (:type data))
(print-error! (.getCause ^Throwable error)) (print-error! (.getCause ^Throwable error))

2
backend/tests/app/tests/test_common_geom.clj
View file

@ -7,7 +7,7 @@
;; ;;
;; Copyright (c) 2020 UXBOX Labs SL ;; Copyright (c) 2020 UXBOX Labs SL
(ns app.tests.test_common_geom (ns app.tests.test-common-geom
(:require (:require
[clojure.test :as t] [clojure.test :as t]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]

12
backend/tests/app/tests/test_common_geom_shapes.clj
View file

@ -15,11 +15,12 @@
[app.common.pages :refer [make-minimal-shape]] [app.common.pages :refer [make-minimal-shape]]
[clojure.test :as t])) [clojure.test :as t]))
(def default-path [{:command :move-to :params {:x 0 :y 0}} (def default-path
{:command :line-to :params {:x 20 :y 20}} [{:command :move-to :params {:x 0 :y 0}}
{:command :line-to :params {:x 30 :y 30}} {:command :line-to :params {:x 20 :y 20}}
{:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}} {:command :line-to :params {:x 30 :y 30}}
{:command :close-path}]) {:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
{:command :close-path}])
(defn add-path-data [shape] (defn add-path-data [shape]
(let [content (:content shape default-path) (let [content (:content shape default-path)
@ -56,7 +57,6 @@
:rect :path)) :rect :path))
(t/testing "Transform shape with translation modifiers" (t/testing "Transform shape with translation modifiers"
(t/are [type] (t/are [type]
(let [modifiers {:displacement (gmt/translate-matrix (gpt/point 10 -10))}] (let [modifiers {:displacement (gmt/translate-matrix (gpt/point 10 -10))}]

18
backend/tests/app/tests/test_emails.clj
View file

@ -27,21 +27,3 @@
(t/is (contains? result :to)) (t/is (contains? result :to))
#_(t/is (contains? result :reply-to)) #_(t/is (contains? result :reply-to))
(t/is (vector? (:body result))))) (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))))))

44
backend/tests/app/tests/test_services_files.clj
View file

@ -14,8 +14,6 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.http :as http] [app.http :as http]
[app.services.mutations :as sm]
[app.services.queries :as sq]
[app.tests.helpers :as th] [app.tests.helpers :as th]
[app.util.storage :as ust])) [app.util.storage :as ust]))
@ -23,20 +21,20 @@
(t/use-fixtures :each th/database-reset) (t/use-fixtures :each th/database-reset)
(t/deftest files-crud (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) team-id (:default-team-id prof)
proj-id (:default-project-id prof) proj-id (:default-project-id prof)
file-id (uuid/next) file-id (uuid/next)
page-id (uuid/next)] page-id (uuid/next)]
(t/testing "create file" (t/testing "create file"
(let [data {::sm/type :create-file (let [data {::th/type :create-file
:profile-id (:id prof) :profile-id (:id prof)
:project-id proj-id :project-id proj-id
:id file-id :id file-id
:is-shared false :name "foobar"
:name "test file"} :is-shared false}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -46,11 +44,11 @@
(t/is (= proj-id (:project-id result)))))) (t/is (= proj-id (:project-id result))))))
(t/testing "rename file" (t/testing "rename file"
(let [data {::sm/type :rename-file (let [data {::th/type :rename-file
:id file-id :id file-id
:name "new name" :name "new name"
:profile-id (:id prof)} :profile-id (:id prof)}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(let [result (:result out)] (let [result (:result out)]
@ -58,10 +56,10 @@
(t/is (= (:name data) (:name result)))))) (t/is (= (:name data) (:name result))))))
(t/testing "query files" (t/testing "query files"
(let [data {::sq/type :files (let [data {::th/type :files
:project-id proj-id :project-id proj-id
:profile-id (:id prof)} :profile-id (:id prof)}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -73,10 +71,10 @@
(t/is (= 1 (count (get-in result [0 :data :pages]))))))) (t/is (= 1 (count (get-in result [0 :data :pages])))))))
(t/testing "query single file without users" (t/testing "query single file without users"
(let [data {::sq/type :file (let [data {::th/type :file
:profile-id (:id prof) :profile-id (:id prof)
:id file-id} :id file-id}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -88,38 +86,32 @@
(t/is (nil? (:users result)))))) (t/is (nil? (:users result))))))
(t/testing "delete file" (t/testing "delete file"
(let [data {::sm/type :delete-file (let [data {::th/type :delete-file
:id file-id :id file-id
:profile-id (:id prof)} :profile-id (:id prof)}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (nil? (:result out))))) (t/is (nil? (:result out)))))
(t/testing "query single file after delete" (t/testing "query single file after delete"
(let [data {::sq/type :file (let [data {::th/type :file
:profile-id (:id prof) :profile-id (:id prof)
:id file-id} :id file-id}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(let [error (:error 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))
error-data (ex-data error)] error-data (ex-data error)]
(t/is (th/ex-info? error)) (t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found))))) (t/is (= (:type error-data) :not-found)))))
(t/testing "query list files after delete" (t/testing "query list files after delete"
(let [data {::sq/type :files (let [data {::th/type :files
:project-id proj-id :project-id proj-id
:profile-id (:id prof)} :profile-id (:id prof)}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))

83
backend/tests/app/tests/test_services_media.clj
View file

@ -13,8 +13,6 @@
[datoteka.core :as fs] [datoteka.core :as fs]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm]
[app.services.queries :as sq]
[app.tests.helpers :as th] [app.tests.helpers :as th]
[app.util.storage :as ust])) [app.util.storage :as ust]))
@ -22,22 +20,22 @@
(t/use-fixtures :each th/database-reset) (t/use-fixtures :each th/database-reset)
(t/deftest media-crud (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) team-id (:default-team-id prof)
proj (th/create-project db/pool (:id prof) team-id 1) proj (th/create-project th/*pool* (:id prof) team-id 1)
file (th/create-file db/pool (:id prof) (:id proj) false 1) file (th/create-file th/*pool* (:id prof) (:id proj) false 1)
object-id-1 (uuid/next) object-id-1 (uuid/next)
object-id-2 (uuid/next)] object-id-2 (uuid/next)]
(t/testing "create media object from url to file" (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" (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 :id object-id-1
:profile-id (:id prof) :profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:is-local true :is-local true
:url url} :url url}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -57,14 +55,14 @@
:tempfile (th/tempfile "app/tests/_files/sample.jpg") :tempfile (th/tempfile "app/tests/_files/sample.jpg")
:content-type "image/jpeg" :content-type "image/jpeg"
:size 312043} :size 312043}
data {::sm/type :upload-media-object data {::th/type :upload-media-object
:id object-id-2 :id object-id-2
:profile-id (:id prof) :profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:is-local true :is-local true
:name "testfile" :name "testfile"
:content content} :content content}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error 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 :path])))
(t/is (string? (get-in out [:result :thumb-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))))))
)) ))

63
backend/tests/app/tests/test_services_profile.clj
View file

@ -15,50 +15,44 @@
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.core :as fs] [datoteka.core :as fs]
[app.db :as db] [app.db :as db]
[app.services.mutations :as sm] ;; [app.services.mutations.profile :as profile]
[app.services.queries :as sq]
[app.services.mutations.profile :as profile]
[app.tests.helpers :as th])) [app.tests.helpers :as th]))
(t/use-fixtures :once th/state-init) (t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset) (t/use-fixtures :each th/database-reset)
(t/deftest profile-login (t/deftest profile-login
(let [profile (th/create-profile db/pool 1)] (let [profile (th/create-profile th/*pool* 1)]
(t/testing "failed" (t/testing "failed"
(let [event {::sm/type :login (let [data {::th/type :login
:email "profile1.test@nodomain.com" :email "profile1.test@nodomain.com"
:password "foobar" :password "foobar"
:scope "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)] (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-info? error))
(t/is (th/ex-of-type? error :validation)) (t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :wrong-credentials))))) (t/is (th/ex-of-code? error :wrong-credentials)))))
(t/testing "success" (t/testing "success"
(let [event {::sm/type :login (let [data {::th/type :login
:email "profile1.test@nodomain.com" :email "profile1.test@nodomain.com"
:password "123123" :password "123123"
:scope "foobar"} :scope "foobar"}
out (th/try-on! (sm/handle event))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (= (:id profile) (get-in out [:result :id]))))))) (t/is (= (:id profile) (get-in out [:result :id])))))))
(t/deftest profile-query-and-manipulation (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" (t/testing "query profile"
(let [data {::sq/type :profile (let [data {::th/type :profile
:profile-id (:id profile)} :profile-id (:id profile)}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -70,20 +64,21 @@
(t/testing "update profile" (t/testing "update profile"
(let [data (assoc profile (let [data (assoc profile
::sm/type :update-profile :profile-id (:id profile)
::th/type :update-profile
:fullname "Full Name" :fullname "Full Name"
:lang "en" :lang "en"
:theme "dark") :theme "dark")
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (nil? (:result out))))) (t/is (nil? (:result out)))))
(t/testing "query profile after update" (t/testing "query profile after update"
(let [data {::sq/type :profile (let [data {::th/type :profile
:profile-id (:id profile)} :profile-id (:id profile)}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -94,25 +89,25 @@
(t/is (= "dark" (:theme result)))))) (t/is (= "dark" (:theme result))))))
(t/testing "update photo" (t/testing "update photo"
(let [data {::sm/type :update-profile-photo (let [data {::th/type :update-profile-photo
:profile-id (:id profile) :profile-id (:id profile)
:file {:filename "sample.jpg" :file {:filename "sample.jpg"
:size 123123 :size 123123
:tempfile "tests/app/tests/_files/sample.jpg" :tempfile "tests/app/tests/_files/sample.jpg"
:content-type "image/jpeg"}} :content-type "image/jpeg"}}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))))
)))) ))
#_(t/deftest profile-deletion #_(t/deftest profile-deletion
(let [prof (th/create-profile db/pool 1) (let [prof (th/create-profile th/*pool* 1)
team (:default-team prof) team (:default-team prof)
proj (:default-project prof) proj (:default-project prof)
file (th/create-file db/pool (:id prof) (:id proj) 1) file (th/create-file th/*pool* (:id prof) (:id proj) 1)
page (th/create-page db/pool (:id prof) (:id file) 1)] page (th/create-page th/*pool* (:id prof) (:id file) 1)]
;; (t/testing "try to delete profile not marked for deletion" ;; (t/testing "try to delete profile not marked for deletion"
;; (let [params {:props {:profile-id (:id prof)}} ;; (let [params {:props {:profile-id (:id prof)}}
@ -198,14 +193,14 @@
)) ))
(t/deftest registration-domain-whitelist ;; (t/deftest registration-domain-whitelist
(let [whitelist "gmail.com, hey.com, ya.ru"] ;; (let [whitelist "gmail.com, hey.com, ya.ru"]
(t/testing "allowed email domain" ;; (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? whitelist "username@ya.ru")))
(t/is (true? (profile/email-domain-in-whitelist? "" "username@somedomain.com")))) ;; (t/is (true? (profile/email-domain-in-whitelist? "" "username@somedomain.com"))))
(t/testing "not allowed email domain" ;; (t/testing "not allowed email domain"
(t/is (false? (profile/email-domain-in-whitelist? whitelist "username@somedomain.com")))))) ;; (t/is (false? (profile/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
;; TODO: profile deletion with teams ;; TODO: profile deletion with teams
;; TODO: profile deletion with owner teams ;; TODO: profile deletion with owner teams

26
backend/tests/app/tests/test_services_projects.clj
View file

@ -13,8 +13,6 @@
[promesa.core :as p] [promesa.core :as p]
[app.db :as db] [app.db :as db]
[app.http :as http] [app.http :as http]
[app.services.mutations :as sm]
[app.services.queries :as sq]
[app.tests.helpers :as th] [app.tests.helpers :as th]
[app.common.uuid :as uuid])) [app.common.uuid :as uuid]))
@ -22,17 +20,17 @@
(t/use-fixtures :each th/database-reset) (t/use-fixtures :each th/database-reset)
(t/deftest projects-crud (t/deftest projects-crud
(let [prof (th/create-profile db/pool 1) (let [prof (th/create-profile th/*pool* 1)
team (th/create-team db/pool (:id prof) 1) team (th/create-team th/*pool* (:id prof) 1)
project-id (uuid/next)] project-id (uuid/next)]
(t/testing "create a project" (t/testing "create a project"
(let [data {::sm/type :create-project (let [data {::th/type :create-project
:id project-id :id project-id
:profile-id (:id prof) :profile-id (:id prof)
:team-id (:id team) :team-id (:id team)
:name "test project"} :name "test project"}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -40,10 +38,10 @@
(t/is (= (:name data) (:name result)))))) (t/is (= (:name data) (:name result))))))
(t/testing "query a list of projects" (t/testing "query a list of projects"
(let [data {::sq/type :projects (let [data {::th/type :projects
:team-id (:id team) :team-id (:id team)
:profile-id (:id prof)} :profile-id (:id prof)}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -53,11 +51,11 @@
(t/is "test project" (get-in result [0 :name]))))) (t/is "test project" (get-in result [0 :name])))))
(t/testing "rename project" (t/testing "rename project"
(let [data {::sm/type :rename-project (let [data {::th/type :rename-project
:id project-id :id project-id
:name "renamed project" :name "renamed project"
:profile-id (:id prof)} :profile-id (:id prof)}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(let [result (:result out)] (let [result (:result out)]
@ -66,20 +64,20 @@
(t/is (= (:profile-id data) (:id prof)))))) (t/is (= (:profile-id data) (:id prof))))))
(t/testing "delete project" (t/testing "delete project"
(let [data {::sm/type :delete-project (let [data {::th/type :delete-project
:id project-id :id project-id
:profile-id (:id prof)} :profile-id (:id prof)}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(t/is (nil? (:result out))))) (t/is (nil? (:result out)))))
(t/testing "query a list of projects after delete" (t/testing "query a list of projects after delete"
(let [data {::sq/type :projects (let [data {::th/type :projects
:team-id (:id team) :team-id (:id team)
:profile-id (:id prof)} :profile-id (:id prof)}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))

73
backend/tests/app/tests/test_services_viewer.clj
View file

@ -13,9 +13,6 @@
[datoteka.core :as fs] [datoteka.core :as fs]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.http :as http]
[app.services.mutations :as sm]
[app.services.queries :as sq]
[app.tests.helpers :as th] [app.tests.helpers :as th]
[app.util.storage :as ust])) [app.util.storage :as ust]))
@ -23,21 +20,21 @@
(t/use-fixtures :each th/database-reset) (t/use-fixtures :each th/database-reset)
(t/deftest retrieve-bundle (t/deftest retrieve-bundle
(let [prof (th/create-profile db/pool 1) (let [prof (th/create-profile th/*pool* 1)
prof2 (th/create-profile db/pool 2) prof2 (th/create-profile th/*pool* 2)
team-id (:default-team-id prof) team-id (:default-team-id prof)
proj-id (:default-project-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)] token (atom nil)]
(t/testing "authenticated with page-id" (t/testing "authenticated with page-id"
(let [data {::sq/type :viewer-bundle (let [data {::th/type :viewer-bundle
:profile-id (:id prof) :profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:page-id (get-in file [:data :pages 0])} :page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -49,11 +46,11 @@
(t/is (contains? result :project))))) (t/is (contains? result :project)))))
(t/testing "generate share token" (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) :profile-id (:id prof)
:file-id (:id file) :file-id (:id file)
:page-id (get-in file [:data :pages 0])} :page-id (get-in file [:data :pages 0])}
out (th/try-on! (sm/handle data))] out (th/mutation! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
@ -62,51 +59,45 @@
(reset! token (:token result))))) (reset! token (:token result)))))
(t/testing "not authenticated with page-id" (t/testing "not authenticated with page-id"
(let [data {::sq/type :viewer-bundle (let [data {::th/type :viewer-bundle
:profile-id (:id prof2) :profile-id (:id prof2)
:file-id (:id file) :file-id (:id file)
:page-id (get-in file [:data :pages 0])} :page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))] out (th/query! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(let [error (:error out) (let [error (:error out)
error-data (ex-data error)] error-data (ex-data error)]
(t/is (th/ex-info? 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 (= (:type error-data) :validation))
(t/is (= (:code error-data) :not-authorized))))) (t/is (= (:code error-data) :not-authorized)))))
(t/testing "authenticated with token & profile" ;; (t/testing "authenticated with token & profile"
(let [data {::sq/type :viewer-bundle ;; (let [data {::sq/type :viewer-bundle
:profile-id (:id prof2) ;; :profile-id (:id prof2)
:token @token ;; :token @token
:file-id (:id file) ;; :file-id (:id file)
:page-id (get-in file [:data :pages 0])} ;; :page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))] ;; out (th/try-on! (sq/handle data))]
;; (th/print-result! out) ;; ;; (th/print-result! out)
(let [result (:result out)] ;; (let [result (:result out)]
(t/is (contains? result :page)) ;; (t/is (contains? result :page))
(t/is (contains? result :file)) ;; (t/is (contains? result :file))
(t/is (contains? result :project))))) ;; (t/is (contains? result :project)))))
(t/testing "authenticated with token" ;; (t/testing "authenticated with token"
(let [data {::sq/type :viewer-bundle ;; (let [data {::sq/type :viewer-bundle
:token @token ;; :token @token
:file-id (:id file) ;; :file-id (:id file)
:page-id (get-in file [:data :pages 0])} ;; :page-id (get-in file [:data :pages 0])}
out (th/try-on! (sq/handle data))] ;; out (th/try-on! (sq/handle data))]
;; (th/print-result! out) ;; ;; (th/print-result! out)
(let [result (:result out)] ;; (let [result (:result out)]
(t/is (contains? result :page)) ;; (t/is (contains? result :page))
(t/is (contains? result :file)) ;; (t/is (contains? result :file))
(t/is (contains? result :project))))) ;; (t/is (contains? result :project)))))
)) ))

7
common/app/common/data.cljc
View file

@ -210,6 +210,13 @@
(assoc m key v) (assoc m key v)
m))) 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 (defn merge
"A faster merge." "A faster merge."
[& maps] [& maps]

4
frontend/src/app/main/repo.cljs
View file

@ -46,13 +46,13 @@
(defn send-query! (defn send-query!
[id params] [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}) (->> (http/send! {:method :get :uri uri :query params})
(rx/mapcat handle-response)))) (rx/mapcat handle-response))))
(defn send-mutation! (defn send-mutation!
[id params] [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}) (->> (http/send! {:method :post :uri uri :body params})
(rx/mapcat handle-response)))) (rx/mapcat handle-response))))

2
frontend/src/app/worker/thumbnails.cljs
View file

@ -33,7 +33,7 @@
(defn- request-page (defn- request-page
[file-id page-id] [file-id page-id]
(let [uri "/api/w/query/page"] (let [uri "/api/rpc/query/page"]
(p/create (p/create
(fn [resolve reject] (fn [resolve reject]
(->> (http/send! {:uri uri (->> (http/send! {:uri uri

0
frontend/test.cljs Normal file
View file