3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-21 07:46:10 +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]}
puppetlabs/clj-ldap {:mvn/version"0.3.0"}
integrant/integrant {:mvn/version "0.8.0"}
;; exception printing
io.aviso/pretty {:mvn/version "0.1.37"}
mount/mount {:mvn/version "0.1.16"}
environ/environ {:mvn/version "1.2.0"}}
:paths ["src" "resources" "../common" "common"]
:paths ["dev" "src" "resources" "../common" "common"]
:aliases
{:dev
{:extra-deps
@ -89,7 +90,7 @@
{:main-opts ["-m" "clj-kondo.main"]}
:tests
{:extra-deps {lambdaisland/kaocha {:mvn/version "0.0-581"}}
{:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.732"}}
:main-opts ["-m" "kaocha.runner"]}
:outdated

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

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

2
backend/resources/log4j2.xml
View file

@ -13,7 +13,7 @@
<DefaultRolloverStrategy max="9"/>
</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"/>
</CljFn>
</Appenders>

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

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

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

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

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

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

@ -16,68 +16,71 @@
[app.db :as db]
[app.tasks :as tasks]
[app.util.async :as aa]
[app.worker :as wrk]
[app.util.http :as http]
[app.util.emails :as emails]
[clojure.core.async :as a]
[clojure.data.json :as json]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[cuerdas.core :as str]
[mount.core :as mount :refer [defstate]]
[integrant.core :as ig]
[promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Public API
;; Error Reporting
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defonce enqueue identity)
(declare send-notification!)
(defonce queue-fn identity)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::http-client fn?)
(s/def ::uri (s/nilable ::us/uri))
(defn- send-to-mattermost!
[log-event]
(defmethod ig/pre-init-spec ::instance [_]
(s/keys :req-un [::aa/executor ::uri ::http-client]))
(defmethod ig/init-key ::instance
[_ {:keys [executor uri] :as cfg}]
(let [out (a/chan (a/sliding-buffer 64))]
(log/info "Intializing error reporter.")
(if uri
(do
(alter-var-root #'queue-fn (constantly (fn [x] (a/>!! out (str x)))))
(a/go-loop []
(let [val (a/<! 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
(let [text (str/fmt "Unhandled exception: `host='%s'`, `version=%s`.\n@channel ⇊\n```%s\n```"
(:host cfg/config)
(:full @cfg/version)
(str log-event))
rsp (http/send! {:uri (:error-reporter-webhook cfg/config)
:method :post
:headers {"content-type" "application/json"}
:body (json/write-str {:text text})})]
(let [send! (:http-client cfg)
uri (:uri cfg)
prefix (str/<< "Unhandled exception (@channel):\n"
"- host: `~(:host cfg/config)`\n"
"- version: `~(:full cfg/version)`")
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)
(log/warnf "Error reporting webhook replying with unexpected status: %s\n%s"
(:status rsp)
(pr-str rsp))))
(catch Exception e
(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
(:require
[clojure.pprint]
[app.config :as cfg]
[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.ldap :as ldap]
;; [app.http.auth.ldap :as ldap]
[app.http.errors :as errors]
[app.http.handlers :as handlers]
[app.http.middleware :as middleware]
[app.http.session :as session]
[app.http.ws :as ws]
;; [app.http.ws :as ws]
[app.metrics :as mtx]
[clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]]
[reitit.ring :as rring]
[ring.adapter.jetty9 :as jetty]))
[integrant.core :as ig]
[clojure.spec.alpha :as s]
[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
[]
(rring/router
[["/metrics" {:get mtx/dump}]
[{:keys [session rpc google-auth gitlab-auth metrics ldap-auth] :as cfg}]
(rr/router
[["/metrics" {:get (:handler metrics)}]
["/api" {:middleware [[middleware/format-response-body]
[middleware/parse-request-body]
[middleware/errors errors/handle]
@ -37,43 +84,21 @@
[middleware/keyword-params]
[middleware/cookies]]}
["/svg" {:post handlers/parse-svg}]
;; ["/svg" {:post handlers/parse-svg}]
["/oauth"
["/google" {:post google/auth}]
["/google/callback" {:get google/callback}]
["/gitlab" {:post gitlab/auth}]
["/gitlab/callback" {:get gitlab/callback}]]
["/google" {:post (:auth-handler google-auth)}]
["/google/callback" {:get (:callback-handler google-auth)}]
["/echo" {:get handlers/echo-handler
:post handlers/echo-handler}]
["/gitlab" {:post (:auth-handler gitlab-auth)}]
["/gitlab/callback" {:get (:callback-handler gitlab-auth)}]]
["/login" {:post auth/login-handler}]
["/logout" {:post auth/logout-handler}]
["/login-ldap" {:post ldap/auth}]
["/login" {:post #(auth/login-handler cfg %)}]
["/logout" {:post #(auth/logout-handler cfg %)}]
["/w" {:middleware [session/middleware]}
["/query/:type" {:get handlers/query-handler}]
["/mutation/:type" {:post handlers/mutation-handler}]]]]))
["/login-ldap" {:post ldap-auth}]
(defn start-server
[]
(let [wsockets {"/ws/notifications" ws/handler}
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)))
["/rpc" {:middleware [(:middleware session)]}
["/query/:type" {:get (:query-handler rpc)}]
["/mutation/:type" {:post (:mutation-handler rpc)}]]]]))
(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
(:require
[app.http.session :as session]
[app.services.mutations :as sm]))
[app.http.session :as session]))
(defn login-handler
[req]
(let [data (:body-params req)
uagent (get-in req [:headers "user-agent"])
profile (sm/handle (assoc data ::sm/type :login))
id (session/create (:id profile) uagent)]
[{:keys [session rpc] :as cfg} request]
(let [data (:params request)
uagent (get-in request [:headers "user-agent"])
method (get-in rpc [:methods :mutation :login])
profile (method data)
id (session/create! session {:profile-id (:id profile)
:user-agent uagent})]
{:status 200
:cookies (session/cookies id)
:cookies (session/cookies session {:value id})
:body profile}))
(defn logout-handler
[req]
(some-> (session/extract-auth-token req)
(session/delete))
[{:keys [session] :as cfg} request]
(session/delete! cfg request)
{:status 200
:cookies (session/cookies "" {:max-age -1})
:cookies (session/cookies session {:value "" :max-age -1})
:body ""})

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

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

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

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

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

@ -12,50 +12,110 @@
[app.common.exceptions :as ex]
[app.config :as cfg]
[app.http.session :as session]
[app.services.mutations :as sm]
[clj-ldap.client :as client]
[clojure.set :as set]
[clojure.string]
[clojure.spec.alpha :as s]
[clojure.string ]
[clojure.tools.logging :as log]
[mount.core :refer [defstate]]))
[integrant.core :as ig]))
(defn replace-several [s & {:as replacements}]
(declare authenticate)
(declare create-connection)
(declare replace-several)
(s/def ::host ::cfg/ldap-auth-host)
(s/def ::port ::cfg/ldap-auth-port)
(s/def ::ssl ::cfg/ldap-auth-ssl)
(s/def ::starttls ::cfg/ldap-auth-starttls)
(s/def ::user-query ::cfg/ldap-auth-user-query)
(s/def ::base-dn ::cfg/ldap-auth-base-dn)
(s/def ::username-attribute ::cfg/ldap-auth-username-attribute)
(s/def ::email-attribute ::cfg/ldap-auth-email-attribute)
(s/def ::fullname-attribute ::cfg/ldap-auth-fullname-attribute)
(s/def ::avatar-attribute ::cfg/ldap-auth-avatar-attribute)
(s/def ::rpc map?)
(s/def ::session map?)
(defmethod ig/pre-init-spec :app.http.auth/ldap
[_]
(s/keys
:req-un [::rpc ::session]
:opt-un [::host
::port
::ssl
::starttls
::username-attribute
::base-dn
::username-attribute
::email-attribute
::fullname-attribute
::avatar-attribute]))
(defmethod ig/init-key :app.http.auth/ldap
[_ {:keys [session rpc] :as cfg}]
(let [conn (create-connection cfg)]
(with-meta
(fn [request]
(let [data (:body-params request)]
(when-some [info (authenticate (assoc cfg
:conn conn
:username (:email data)
:password (:password data)))]
(let [method-fn (get-in rpc [:methods :mutation :login-or-register])
profile (method-fn {:email (:email info)
:fullname (:fullname info)})
uagent (get-in request [:headers "user-agent"])
sid (session/create! session {:profile-id (:id profile)
:user-agent uagent})]
{:status 200
:cookies (session/cookies session {:value sid})
:body profile}))))
{::conn conn})))
(defmethod ig/halt-key! ::client
[_ handler]
(let [{:keys [::conn]} (meta handler)]
(when (realized? conn)
(.close @conn))))
(defn- replace-several [s & {:as replacements}]
(reduce-kv clojure.string/replace s replacements))
(declare *ldap-pool)
(defn- create-connection
[cfg]
(let [params (merge {:host {:address (:host cfg)
:port (:port cfg)}}
(-> cfg
(select-keys [:ssl
:starttls
:ldap-bind-dn
:ldap-bind-password])
(set/rename-keys {:ssl :ssl?
:starttls :startTLS?
:ldap-bind-dn :bind-dn
:ldap-bind-password :password})))]
(delay
(try
(client/connect params)
(catch Exception e
(log/errorf e "Cannot connect to LDAP %s:%s"
(:host cfg) (:port cfg)))))))
(defstate *ldap-pool
:start (delay
(try
(client/connect (merge {:host {:address (:ldap-auth-host cfg/config)
:port (:ldap-auth-port cfg/config)}}
(-> cfg/config
(select-keys [:ldap-auth-ssl
:ldap-auth-starttls
:ldap-bind-dn
:ldap-bind-password])
(set/rename-keys {:ldap-auth-ssl :ssl?
:ldap-auth-starttls :startTLS?
:ldap-bind-dn :bind-dn
:ldap-bind-password :password}))))
(catch Exception e
(log/errorf e "Cannot connect to LDAP %s:%s"
(:ldap-auth-host cfg/config) (:ldap-auth-port cfg/config)))))
:stop (when (realized? *ldap-pool)
(some-> *ldap-pool deref (.close))))
(defn- auth-with-ldap [username password]
(when-some [conn (some-> *ldap-pool deref)]
(let [user-search-query (replace-several (:ldap-auth-user-query cfg/config)
"$username" username)
user-attributes (-> cfg/config
(select-keys [:ldap-auth-username-attribute
:ldap-auth-email-attribute
:ldap-auth-fullname-attribute
:ldap-auth-avatar-attribute])
vals)]
(defn- authenticate
[{:keys [conn username password] :as cfg}]
(when-some [conn (some-> conn deref)]
(let [user-search-query (replace-several (:user-query cfg) "$username" username)
user-attributes (-> cfg
(select-keys [:username-attribute
:email-attribute
:fullname-attribute
:avatar-attribute])
vals)]
(when-some [user-entry (-> conn
(client/search (:ldap-auth-base-dn cfg/config)
(client/search (:base-dn cfg)
{:filter user-search-query
:sizelimit 1
:attributes user-attributes})
@ -63,18 +123,7 @@
(when-not (client/bind? conn (:dn user-entry) password)
(ex/raise :type :authentication
:code :wrong-credentials))
(set/rename-keys user-entry {(keyword (:ldap-auth-avatar-attribute cfg/config)) :photo
(keyword (:ldap-auth-fullname-attribute cfg/config)) :fullname
(keyword (:ldap-auth-email-attribute cfg/config)) :email})))))
(set/rename-keys user-entry {(keyword (:avatar-attribute cfg)) :photo
(keyword (:fullname-attribute cfg)) :fullname
(keyword (:email-attribute cfg)) :email})))))
(defn auth [req]
(let [data (:body-params req)
uagent (get-in req [:headers "user-agent"])]
(when-some [info (auth-with-ldap (:email data) (:password data))]
(let [profile (sm/handle {::sm/type :login-or-register
:email (:email info)
:fullname (:fullname info)})
sid (session/create (:id profile) uagent)]
{:status 200
:cookies (session/cookies sid)
:body profile}))))

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

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

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

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

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

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

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
(:require
[app.config :as cfg]
[app.common.data :as d]
[app.util.time :as dt]
[clojure.tools.logging :as log]
[mount.core :as mount]))
(defn- enable-asserts
[_]
(let [m (System/getProperty "app.enable-asserts")]
(or (nil? m) (= "true" m))))
[integrant.core :as ig]))
;; Set value for all new threads bindings.
(alter-var-root #'*assert* enable-asserts)
;; Set value for current thread binding.
(set! *assert* (enable-asserts nil))
(alter-var-root #'*assert* (constantly (:enable-asserts @cfg/config)))
;; --- Entry point
(defn run
[_params]
(require 'app.srepl.server
'app.services
'app.migrations
'app.worker
'app.media
'app.http)
(mount/start)
(log/infof "Welcome to penpot! Version: '%s'." (:full @cfg/version)))
(defn build-system-config
[config]
{:app.db/pool
{:uri (:database-uri config)
:username (:database-username config)
:password (:database-password config)
:metrics (ig/ref :app.metrics/metrics)
:migrations (ig/ref :app.migrations/migrations)
:name "main"
:min-pool-size 0
:max-pool-size 10}
:app.metrics/metrics
{}
:app.migrations/migrations
{}
:app.redis/redis
{:uri (:redis-uri config)}
:app.tokens/tokens
{:secret-key (:secret-key config)}
:app.media-storage/storage
{:media-directory (:media-directory config)
:media-uri (:media-uri config)}
:app.http.session/session
{:pool (ig/ref :app.db/pool)
:cookie-name "auth-token"}
:app.http/server
{:port (:http-server-port config)
:router (ig/ref :app.http/router)
:ws {"/ws/notifications" (ig/ref :app.notifications/handler)}}
:app.http/router
{:rpc (ig/ref :app.rpc/rpc)
:session (ig/ref :app.http.session/session)
:tokens (ig/ref :app.tokens/tokens)
:public-uri (:public-uri config)
:metrics (ig/ref :app.metrics/metrics)
:google-auth (ig/ref :app.http.auth/google)
:gitlab-auth (ig/ref :app.http.auth/gitlab)
:ldap-auth (ig/ref :app.http.auth/ldap)}
:app.rpc/rpc
{:pool (ig/ref :app.db/pool)
:session (ig/ref :app.http.session/session)
:tokens (ig/ref :app.tokens/tokens)
:metrics (ig/ref :app.metrics/metrics)
:storage (ig/ref :app.media-storage/storage)
:redis (ig/ref :app.redis/redis)}
:app.notifications/handler
{:redis (ig/ref :app.redis/redis)
:pool (ig/ref :app.db/pool)
:session (ig/ref :app.http.session/session)}
:app.http.auth/google
{:rpc (ig/ref :app.rpc/rpc)
:session (ig/ref :app.http.session/session)
:tokens (ig/ref :app.tokens/tokens)
:public-uri (:public-uri config)
:client-id (:google-client-id config)
:client-secret (:google-client-secret config)}
:app.http.auth/gitlab
{:rpc (ig/ref :app.rpc/rpc)
:session (ig/ref :app.http.session/session)
:tokens (ig/ref :app.tokens/tokens)
:public-uri (:public-uri config)
:base-uri (:gitlab-base-uri config)
:client-id (:gitlab-client-id config)
:client-secret (:gitlab-client-secret config)}
:app.http.auth/ldap
{:host (:ldap-auth-host config)
:port (:ldap-auth-port config)
:ssl (:ldap-auth-ssl config)
:starttls (:ldap-auth-starttls config)
:user-query (:ldap-auth-user-query config)
:username-attribute (:ldap-auth-username-attribute config)
:email-attribute (:ldap-auth-email-attribute config)
:fullname-attribute (:ldap-auth-fullname-attribute config)
:avatar-attribute (:ldap-auth-avatar-attribute config)
:base-dn (:ldap-auth-base-dn config)
:session (ig/ref :app.http.session/session)
:rpc (ig/ref :app.rpc/rpc)}
:app.worker/executor
{:name "worker"}
:app.worker/worker
{:executor (ig/ref :app.worker/executor)
:pool (ig/ref :app.db/pool)
:tasks (ig/ref :app.tasks/all)}
:app.worker/scheduler
{:executor (ig/ref :app.worker/executor)
:pool (ig/ref :app.db/pool)
:schedule [;; TODO: pending to refactor
;; {:id "file-media-gc"
;; :cron #app/cron "0 0 0 */1 * ? *" ;; daily
;; :fn (ig/ref :app.tasks.file-media-gc/handler)}
{:id "file-xlog-gc"
:cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn (ig/ref :app.tasks.file-xlog-gc/handler)}
{:id "tasks-gc"
:cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn (ig/ref :app.tasks.tasks-gc/handler)}]}
:app.tasks/all
{"sendmail" (ig/ref :app.tasks.sendmail/handler)
"delete-object" (ig/ref :app.tasks.delete-object/handler)
"delete-profile" (ig/ref :app.tasks.delete-profile/handler)}
:app.tasks.sendmail/handler
{:host (:smtp-host config)
:port (:smtp-port config)
:ssl (:smtp-ssl config)
:tls (:smtp-tls config)
:enabled (:smtp-enabled config)
:username (:smtp-username config)
:password (:smtp-password config)
:metrics (ig/ref :app.metrics/metrics)
:default-reply-to (:smtp-default-reply-to config)
:default-from (:smtp-default-from config)}
:app.tasks.tasks-gc/handler
{:pool (ig/ref :app.db/pool)
:max-age (dt/duration {:hours 24})
:metrics (ig/ref :app.metrics/metrics)}
:app.tasks.delete-object/handler
{:pool (ig/ref :app.db/pool)
:metrics (ig/ref :app.metrics/metrics)}
:app.tasks.delete-profile/handler
{:pool (ig/ref :app.db/pool)
:metrics (ig/ref :app.metrics/metrics)}
:app.tasks.file-media-gc/handler
{:pool (ig/ref :app.db/pool)
:metrics (ig/ref :app.metrics/metrics)}
:app.tasks.file-xlog-gc/handler
{:pool (ig/ref :app.db/pool)
:max-age (dt/duration {:hours 12})
:metrics (ig/ref :app.metrics/metrics)}
:app.srepl/server
{:port 6062}
})
(defmethod ig/init-key :default [_ data] data)
(defmethod ig/prep-key :default [_ data] (d/without-nils data))
(defonce system {})
(defn start
[]
(let [system-config (build-system-config @cfg/config)]
(ig/load-namespaces system-config)
(alter-var-root #'system (fn [sys]
(when sys (ig/halt! sys))
(-> system-config
(ig/prep)
(ig/init))))
(log/infof "Welcome to penpot! Version: '%s'."
(:full @cfg/version))))
(defn stop
[]
(alter-var-root #'system (fn [sys]
(when sys (ig/halt! sys))
nil)))
(defn -main
[& _args]
(run {}))
(start))

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

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

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

@ -10,28 +10,23 @@
(ns app.media-storage
"A media storage impl for app."
(:require
[integrant.core :as ig]
[app.common.spec :as us]
[clojure.spec.alpha :as s]
[app.config :refer [config]]
[app.util.storage :as ust]
[mount.core :refer [defstate]]))
;; --- State
(s/def ::media-directory ::us/not-empty-string)
(s/def ::media-uri ::us/not-empty-string)
(declare assets-storage)
(defmethod ig/pre-init-spec ::storage [_]
(s/keys :req-un [::media-directory
::media-uri]))
(defstate assets-storage
:start (ust/create {:base-path (:assets-directory config)
:base-uri (:assets-uri config)}))
(declare media-storage)
(defstate media-storage
:start (ust/create {:base-path (:media-directory config)
:base-uri (:media-uri config)
:xf (comp ust/random-path
ust/slugify-filename)}))
;; --- Public Api
(defn resolve-asset
[path]
(str (ust/public-uri assets-storage path)))
(defmethod ig/init-key ::storage
[_ cfg]
(ust/create {:base-path (:media-directory cfg)
:base-uri (:media-uri cfg)
:xf (comp ust/random-path
ust/slugify-filename)}))

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

@ -5,9 +5,18 @@
;; This Source Code Form is "Incompatible With Secondary Licenses", as
;; defined by the Mozilla Public License, v. 2.0.
;;
;; Copyright (c) 2020 UXBOX Labs SL
;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
(ns app.metrics
(:require
[app.common.exceptions :as ex]
[app.util.time :as dt]
[app.worker]
[clojure.tools.logging :as log]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[next.jdbc :as jdbc])
(:import
io.prometheus.client.CollectorRegistry
io.prometheus.client.Counter
@ -17,28 +26,91 @@
io.prometheus.client.hotspot.DefaultExports
java.io.StringWriter))
(defn- create-registry
(declare instrument-vars!)
(declare instrument)
(declare create-registry)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry Point
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- instrument-jdbc!
[registry]
(instrument-vars!
[#'next.jdbc/execute-one!
#'next.jdbc/execute!]
{:registry registry
:type :counter
:name "database_query_counter"
:help "An absolute counter of database queries."}))
(defn- instrument-workers!
[registry]
(instrument-vars!
[#'app.worker/run-task]
{:registry registry
:type :summary
:name "worker_task_checkout_millis"
:help "Latency measured between scheduld_at and execution time."
:wrap (fn [rootf mobj]
(let [mdata (meta rootf)
origf (::original mdata rootf)]
(with-meta
(fn [tasks item]
(let [now (inst-ms (dt/now))
sat (inst-ms (:scheduled-at item))]
(mobj :observe (- now sat))
(origf tasks item)))
{::original origf})))}))
(defn- handler
[registry request]
(let [samples (.metricFamilySamples ^CollectorRegistry registry)
writer (StringWriter.)]
(TextFormat/write004 writer samples)
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
:body (.toString writer)}))
(defmethod ig/init-key ::metrics
[_ opts]
(log/infof "Initializing prometheus registry and instrumentation.")
(let [registry (create-registry)]
(instrument-workers! registry)
(instrument-jdbc! registry)
{:handler (partial handler registry)
:registry registry}))
(s/def ::handler fn?)
(s/def ::registry #(instance? CollectorRegistry %))
(s/def ::metrics
(s/keys :req-un [::registry ::handler]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn create-registry
[]
(let [registry (CollectorRegistry.)]
(DefaultExports/register registry)
;; (DefaultExports/register registry)
registry))
(defonce registry (create-registry))
(defonce cache (atom {}))
(defmacro with-measure
[sym expr teardown]
`(let [~sym (System/nanoTime)]
[& {:keys [expr cb]}]
`(let [start# (System/nanoTime)
tdown# ~cb]
(try
~expr
(finally
(let [~sym (/ (- (System/nanoTime) ~sym) 1000000)]
~teardown)))))
(tdown# (/ (- (System/nanoTime) start#) 1000000))))))
(defn make-counter
[{:keys [id help] :as props}]
(let [instance (doto (Counter/build)
(.name id)
[{:keys [name help registry reg] :as props}]
(let [registry (or registry reg)
instance (doto (Counter/build)
(.name name)
(.help help))
instance (.register instance registry)]
(reify
@ -47,36 +119,16 @@
clojure.lang.IFn
(invoke [_ cmd]
(.inc ^Counter instance))
(invoke [_ cmd val]
(case cmd
:wrap (fn
([a]
(.inc ^Counter instance)
(val a))
([a b]
(.inc ^Counter instance)
(val a b))
([a b c]
(.inc ^Counter instance)
(val a b c)))
(throw (IllegalArgumentException. "invalid arguments")))))))
(defn counter
[{:keys [id] :as props}]
(or (get @cache id)
(let [v (make-counter props)]
(swap! cache assoc id v)
v)))
(.inc ^Counter instance)))))
(defn make-gauge
[{:keys [id help] :as props}]
(let [instance (doto (Gauge/build)
(.name id)
[{:keys [name help registry reg] :as props}]
(let [registry (or registry reg)
instance (doto (Gauge/build)
(.name name)
(.help help))
instance (.register instance registry)]
(reify
clojure.lang.IDeref
(deref [_] instance)
@ -87,92 +139,92 @@
:inc (.inc ^Gauge instance)
:dec (.dec ^Gauge instance))))))
(defn gauge
[{:keys [id] :as props}]
(or (get @cache id)
(let [v (make-gauge props)]
(swap! cache assoc id v)
v)))
(defn make-summary
[{:keys [id help] :as props}]
(let [instance (doto (Summary/build)
(.name id)
[{:keys [name help registry reg] :as props}]
(let [registry (or registry reg)
instance (doto (Summary/build)
(.name name)
(.help help)
(.quantile 0.5 0.05)
(.quantile 0.9 0.01)
(.quantile 0.99 0.001))
instance (.register instance registry)]
instance (.register instance registry)]
(reify
clojure.lang.IDeref
(deref [_] instance)
clojure.lang.IFn
(invoke [_ val]
(.observe ^Summary instance val))
(invoke [_ cmd val]
(case cmd
:wrap (fn
([a]
(with-measure $$
(val a)
(.observe ^Summary instance $$)))
([a b]
(with-measure $$
(val a b)
(.observe ^Summary instance $$)))
([a b c]
(with-measure $$
(val a b c)
(.observe ^Summary instance $$))))
(.observe ^Summary instance val)))))
(throw (IllegalArgumentException. "invalid arguments")))))))
(defn summary
[{:keys [id] :as props}]
(or (get @cache id)
(let [v (make-summary props)]
(swap! cache assoc id v)
v)))
(defn wrap-summary
[f props]
(let [sm (summary props)]
(sm :wrap f)))
(defn create
[{:keys [type name] :as props}]
(case type
:counter (make-counter props)
:gauge (make-gauge props)
:summary (make-summary props)))
(defn wrap-counter
[f props]
(let [cnt (counter props)]
(cnt :wrap f)))
[rootf mobj]
(let [mdata (meta rootf)
origf (::original mdata rootf)]
(with-meta
(fn
([a]
(mobj :inc)
(origf a))
([a b]
(mobj :inc)
(origf a b))
([a b & more]
(mobj :inc)
(apply origf a b more)))
(assoc mdata ::original origf))))
(defn instrument-with-counter!
[{:keys [var] :as props}]
(let [cnt (counter props)
vars (if (var? var) [var] var)]
(doseq [var vars]
(alter-var-root var (fn [root]
(let [mdata (meta root)
original (::counter-original mdata root)]
(with-meta
(cnt :wrap original)
(assoc mdata ::counter-original original))))))))
(defn wrap-summary
[rootf mobj]
(let [mdata (meta rootf)
origf (::original mdata rootf)]
(with-meta
(fn
([a]
(with-measure
:expr (origf a)
:cb #(mobj :observe %)))
([a b]
(with-measure
:expr (origf a b)
:cb #(mobj :observe %)))
([a b & more]
(with-measure
:expr (apply origf a b more)
:cb #(mobj :observe %))))
(assoc mdata ::original origf))))
(defn instrument-with-summary!
[{:keys [var] :as props}]
(let [sm (summary props)]
(alter-var-root var (fn [root]
(let [mdata (meta root)
original (::summary-original mdata root)]
(with-meta
(sm :wrap original)
(assoc mdata ::summary-original original)))))))
(defn instrument-vars!
[vars {:keys [wrap] :as props}]
(let [obj (create props)]
(cond
(instance? Counter @obj)
(doseq [var vars]
(alter-var-root var (or wrap wrap-counter) obj))
(defn dump
[& _args]
(let [samples (.metricFamilySamples ^CollectorRegistry registry)
writer (StringWriter.)]
(TextFormat/write004 writer samples)
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
:body (.toString writer)}))
(instance? Summary @obj)
(doseq [var vars]
(alter-var-root var (or wrap wrap-summary) obj))
:else
(ex/raise :type :not-implemented))))
(defn instrument
[f {:keys [wrap] :as props}]
(let [obj (create props)]
(cond
(instance? Counter @obj)
((or wrap wrap-counter) f obj)
(instance? Summary @obj)
((or wrap wrap-summary) f obj)
:else
(ex/raise :type :not-implemented))))

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

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

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

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

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

@ -7,41 +7,53 @@
(ns app.redis
(:refer-clojure :exclude [run!])
(:require
[app.common.spec :as us]
[app.config :as cfg]
[app.util.redis :as redis]
[mount.core :as mount :refer [defstate]])
[clojure.spec.alpha :as s]
[integrant.core :as ig])
(:import
java.lang.AutoCloseable))
;; --- Connection Handling & State
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; State
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- create-client
[config]
(let [uri (:redis-uri config "redis://redis/0")]
(redis/client uri)))
(defmethod ig/pre-init-spec ::redis [_]
(s/keys :req-un [::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
:start (create-client cfg/config)
:stop (.close ^AutoCloseable client))
(defmethod ig/halt-key! ::redis
[_ {:keys [::client ::conn]}]
(.close ^AutoCloseable conn)
(.close ^AutoCloseable client))
(declare conn)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defstate conn
:start (redis/connect client)
:stop (.close ^AutoCloseable conn))
;; --- API FORWARD
(s/def ::client some?)
(s/def ::conn some?)
(s/def ::redis (s/keys :req [::client ::conn]))
(defn subscribe
[opts]
(redis/subscribe client opts))
[client opts]
(us/assert ::redis client)
(redis/subscribe (::client client) opts))
(defn run!
[cmd params]
(redis/run! conn cmd params))
[client cmd params]
(us/assert ::redis client)
(redis/run! (::conn client) cmd params))
(defn run
[cmd params]
(redis/run conn cmd params))
[client 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
(ns app.services.mutations.comments
(ns app.rpc.mutations.comments
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.db :as db]
[app.services.mutations :as sm]
[app.services.queries.comments :as comments]
[app.services.queries.files :as files]
[app.rpc.queries.comments :as comments]
[app.rpc.queries.files :as files]
[app.util.blob :as blob]
[app.util.time :as dt]
[app.util.services :as sv]
[clojure.spec.alpha :as s]))
;; --- Mutation: Create Comment Thread
@ -34,9 +34,9 @@
(s/def ::create-comment-thread
(s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id]))
(sm/defmutation ::create-comment-thread
[{:keys [profile-id file-id] :as params}]
(db/with-atomic [conn db/pool]
(sv/defmethod ::create-comment-thread
[{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(files/check-read-permissions! conn profile-id file-id)
(create-comment-thread conn params)))
@ -113,9 +113,9 @@
(s/def ::update-comment-thread-status
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::update-comment-thread-status
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(sv/defmethod ::update-comment-thread-status
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not cthr
(ex/raise :type :not-found))
@ -141,9 +141,9 @@
(s/def ::update-comment-thread
(s/keys :req-un [::profile-id ::id ::is-resolved]))
(sm/defmutation ::update-comment-thread
[{:keys [profile-id id is-resolved] :as params}]
(db/with-atomic [conn db/pool]
(sv/defmethod ::update-comment-thread
[{:keys [pool] :as cfg} {:keys [profile-id id is-resolved] :as params}]
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not thread
(ex/raise :type :not-found)
@ -161,9 +161,9 @@
(s/def ::add-comment
(s/keys :req-un [::profile-id ::thread-id ::content]))
(sm/defmutation ::add-comment
[{:keys [profile-id thread-id content] :as params}]
(db/with-atomic [conn db/pool]
(sv/defmethod ::add-comment
[{:keys [pool] :as cfg} {:keys [profile-id thread-id content] :as params}]
(db/with-atomic [conn pool]
(let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true})
(comments/decode-row))
pname (retrieve-page-name conn thread)]
@ -218,9 +218,9 @@
(s/def ::update-comment
(s/keys :req-un [::profile-id ::id ::content]))
(sm/defmutation ::update-comment
[{:keys [profile-id id content] :as params}]
(db/with-atomic [conn db/pool]
(sv/defmethod ::update-comment
[{:keys [pool] :as cfg} {:keys [profile-id id content] :as params}]
(db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})
_ (when-not comment (ex/raise :type :not-found))
thread (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true})
@ -251,9 +251,9 @@
(s/def ::delete-comment-thread
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-comment-thread
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(sv/defmethod ::delete-comment-thread
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not (= (:owner-id thread) profile-id)
(ex/raise :type :validation
@ -267,9 +267,9 @@
(s/def ::delete-comment
(s/keys :req-un [::profile-id ::id]))
(sm/defmutation ::delete-comment
[{:keys [profile-id id] :as params}]
(db/with-atomic [conn db/pool]
(sv/defmethod ::delete-comment
[{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})]
(when-not (= (:owner-id comment) profile-id)
(ex/raise :type :validation

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
(ns app.services.mutations.demo
(ns app.rpc.mutations.demo
"A demo specific mutations."
(:require
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.services.mutations :as sm]
[app.services.mutations.profile :as profile]
[app.rpc.mutations.profile :as profile]
[app.tasks :as tasks]
[app.util.services :as sv]
[buddy.core.codecs :as bc]
[buddy.core.nonce :as bn]))
[buddy.core.nonce :as bn]
[clojure.spec.alpha :as s]))
(sm/defmutation ::create-demo-profile
[_]
(s/def ::create-demo-profile any?)
(sv/defmethod ::create-demo-profile {:auth false}
[{:keys [pool] :as cfg} _]
(let [id (uuid/next)
sem (System/currentTimeMillis)
email (str "demo-" sem ".demo@nodomain.com")
@ -33,7 +36,7 @@
:fullname fullname
:demo? true
:password password}]
(db/with-atomic [conn db/pool]
(db/with-atomic [conn pool]
(->> (#'profile/create-profile conn params)
(#'profile/create-profile-relations conn))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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
(ns app.services.svgparse
(ns app.svgparse
(:require
[app.common.exceptions :as ex]
[clojure.xml :as xml]

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

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

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

@ -11,16 +11,36 @@
"Generic task for permanent deletion of objects."
(:require
[app.common.spec :as us]
[integrant.core :as ig]
[app.db :as db]
[app.metrics :as mtx]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
(s/def ::type keyword?)
(s/def ::id ::us/uuid)
(declare handler)
(declare handle-deletion)
(s/def ::props
(s/keys :req-un [::id ::type]))
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool ::mtx/metrics]))
(defmethod ig/init-key ::handler
[_ {:keys [metrics] :as cfg}]
(let [handler #(handler cfg %)]
(->> {:registry (:registry metrics)
:type :summary
:name "task_delete_object_timing"
:help "delete object task timing"}
(mtx/instrument handler))))
(s/def ::type ::us/keyword)
(s/def ::id ::us/uuid)
(s/def ::props (s/keys :req-un [::id ::type]))
(defn- handler
[{:keys [pool]} {:keys [props] :as task}]
(us/verify ::props props)
(db/with-atomic [conn pool]
(handle-deletion conn props)))
(defmulti handle-deletion (fn [_ props] (:type props)))
@ -28,17 +48,6 @@
[_conn {:keys [type]}]
(log/warn "no handler found for" type))
(defn handler
[{:keys [props] :as task}]
(us/verify ::props props)
(db/with-atomic [conn db/pool]
(handle-deletion conn props)))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__delete_object"
:help "Timing of remove-object task."})
(defmethod handle-deletion :file
[conn {:keys [id] :as props}]
(let [sql "delete from file where id=? and deleted_at is not null"]

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

@ -14,7 +14,22 @@
[app.db :as db]
[app.metrics :as mtx]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
[clojure.tools.logging :as log]
[integrant.core :as ig]))
(declare handler)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool ::mtx/metrics]))
(defmethod ig/init-key ::handler
[_ {:keys [metrics] :as cfg}]
(let [handler #(handler cfg %)]
(->> {:registry (:registry metrics)
:type :summary
:name "task_delete_profile_timing"
:help "delete profile task timing"}
(mtx/instrument handler))))
(declare delete-profile-data)
(declare delete-teams)
@ -26,10 +41,10 @@
(s/keys :req-un [::profile-id]))
(defn handler
[{:keys [props] :as task}]
[{:keys [pool]} {:keys [props] :as task}]
(us/verify ::props props)
(db/with-atomic [conn db/pool]
(let [id (:profile-id props)
(db/with-atomic [conn pool]
(let [id (:profile-id props)
profile (db/get-by-id conn :profile id {:for-update true})]
(if (or (:is-demo profile)
(not (nil? (:deleted-at profile))))
@ -37,11 +52,6 @@
(log/warn "Profile " (:id profile)
"does not match constraints for deletion")))))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__delete_profile"
:help "Timing of delete-profile task."})
(defn- delete-profile-data
[conn profile-id]
(log/info "Proceding to delete all data related to profile" profile-id)

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)."
(:require
[app.common.pages.migrations :as pmg]
[app.common.spec :as us]
[app.config :as cfg]
[app.db :as db]
[app.metrics :as mtx]
[app.tasks :as tasks]
[app.util.blob :as blob]
[app.util.time :as dt]
[integrant.core :as ig]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
(defn decode-row
(declare handler)
(declare retrieve-candidates)
(declare process-file)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool]))
(defmethod ig/init-key ::handler
[_ cfg]
(partial handler cfg))
(defn- handler
[{:keys [pool]} _]
(db/with-atomic [conn pool]
(loop []
(let [files (retrieve-candidates conn)]
(when (seq files)
(run! (partial process-file conn) files)
(recur))))))
;; (mtx/instrument-with-summary!
;; {:var #'handler
;; :id "tasks__file_media_gc"
;; :help "Timing of task: file_media_gc"})
(defn- decode-row
[{:keys [data] :as row}]
(cond-> row
(bytes? data) (assoc :data (blob/decode data))))
(def sql:retrieve-candidates-chunk
(def ^:private
sql:retrieve-candidates-chunk
"select f.id,
f.data,
extract(epoch from (now() - f.modified_at))::bigint as age
@ -37,9 +66,7 @@
limit 10
for update skip locked")
(defn retrieve-candidates
"Retrieves a list of files that are candidates to be garbage
collected."
(defn- retrieve-candidates
[conn]
(let [threshold (:file-trimming-threshold cfg/config)
interval (db/interval threshold)]
@ -47,7 +74,8 @@
(map (fn [{:keys [age] :as row}]
(assoc row :age (dt/duration {:seconds age})))))))
(def collect-media-xf
(def ^:private
collect-media-xf
(comp
(map :objects)
(mapcat vals)
@ -92,19 +120,3 @@
{:id id}))
nil))
(defn handler
[_task]
(db/with-atomic [conn db/pool]
(loop []
(let [files (retrieve-candidates conn)]
(when (seq files)
(run! (partial process-file conn) files)
(recur))))))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__file_media_gc"
:help "Timing of task: file_media_gc"})

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

@ -12,27 +12,38 @@
change (transaction) log."
(:require
[app.common.spec :as us]
[integrant.core :as ig]
[app.db :as db]
[app.metrics :as mtx]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
(def max-age (dt/duration {:hours 12}))
(declare handler)
(def sql:delete-files-xlog
(s/def ::max-age ::dt/duration)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool ::mtx/metrics ::max-age]))
(defmethod ig/init-key ::handler
[_ {:keys [metrics] :as cfg}]
(let [handler #(handler cfg %)]
(->> {:registry (:registry metrics)
:type :summary
:name "task_file_xlog_gc_timing"
:help "file changes garbage collection task timing"}
(mtx/instrument handler))))
(def ^:private
sql:delete-files-xlog
"delete from task_completed
where scheduled_at < now() - ?::interval")
(defn handler
[{:keys [props] :as task}]
(db/with-atomic [conn db/pool]
(defn- handler
[{:keys [pool max-age]} _]
(db/with-atomic [conn pool]
(let [interval (db/interval max-age)
result (db/exec-one! conn [sql:delete-files-xlog interval])]
(log/infof "removed %s rows from file_changes table." (:next.jdbc/update-count result))
result (db/exec-one! conn [sql:delete-files-xlog interval])
result (:next.jdbc/update-count result)]
(log/infof "removed %s rows from file_changes table" result)
nil)))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__file_xlog_gc"
:help "Timing of task: file_xlog_gc"})

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

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

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

@ -9,15 +9,50 @@
(ns app.tasks.sendmail
(:require
[app.common.spec :as us]
[app.config :as cfg]
[app.metrics :as mtx]
[app.util.emails :as emails]
[clojure.tools.logging :as log]))
[clojure.tools.logging :as log]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
(declare handler)
(s/def ::username ::cfg/smtp-username)
(s/def ::password ::cfg/smtp-password)
(s/def ::tls ::cfg/smtp-tls)
(s/def ::ssl ::cfg/smtp-ssl)
(s/def ::host ::cfg/smtp-host)
(s/def ::port ::cfg/smtp-port)
(s/def ::default-reply-to ::cfg/smtp-default-reply-to)
(s/def ::default-from ::cfg/smtp-default-from)
(s/def ::enabled ::cfg/smtp-enabled)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::enabled ::mtx/metrics]
:opt-un [::username
::password
::tls
::ssl
::host
::port
::default-from
::default-reply-to]))
(defmethod ig/init-key ::handler
[_ {:keys [metrics] :as cfg}]
(let [handler #(handler cfg %)]
(->> {:registry (:registry metrics)
:type :summary
:name "task_sendmail_timing"
:help "sendmail task timing"}
(mtx/instrument handler))))
(defn- send-console!
[config email]
[cfg email]
(let [baos (java.io.ByteArrayOutputStream.)
mesg (emails/smtp-message config email)]
mesg (emails/smtp-message cfg email)]
(.writeTo mesg baos)
(let [out (with-out-str
(println "email console dump:")
@ -27,14 +62,7 @@
(log/info out))))
(defn handler
{:app.tasks/name "sendmail"}
[{:keys [props] :as task}]
(let [config (cfg/smtp cfg/config)]
(if (:enabled config)
(emails/send! config props)
(send-console! config props))))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__sendmail"
:help "Timing of sendmail task."})
[cfg {:keys [props] :as task}]
(if (:enabled cfg)
(emails/send! cfg props)
(send-console! cfg props)))

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
(ns app.tasks.clean-tasks-table
(ns app.tasks.tasks-gc
"A maintenance task that performs a cleanup of already executed tasks
from the database table."
(:require
@ -16,25 +16,36 @@
[app.metrics :as mtx]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]))
[clojure.tools.logging :as log]
[integrant.core :as ig]))
(def max-age (dt/duration {:hours 24}))
(declare handler)
(def sql:delete-completed-tasks
(s/def ::max-age ::dt/duration)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req-un [::db/pool ::mtx/metrics ::max-age]))
(defmethod ig/init-key ::handler
[_ {:keys [metrics] :as cfg}]
(let [handler #(handler cfg %)]
(->> {:registry (:registry metrics)
:type :summary
:name "task_tasks_gc_timing"
:help "tasks garbage collection task timing"}
(mtx/instrument handler))))
(def ^:private
sql:delete-completed-tasks
"delete from task_completed
where scheduled_at < now() - ?::interval")
(defn handler
[task]
(db/with-atomic [conn db/pool]
(defn- handler
[{:keys [pool max-age]} _]
(db/with-atomic [conn pool]
(let [interval (db/interval max-age)
result (db/exec-one! conn [sql:delete-completed-tasks interval])]
(log/infof "removed %s rows from tasks_completed table." (:next.jdbc/update-count result))
result (db/exec-one! conn [sql:delete-completed-tasks interval])
result (:next.jdbc/update-count result)]
(log/infof "removed %s rows from tasks_completed table" result)
nil)))
(mtx/instrument-with-summary!
{:var #'handler
:id "tasks__clean_tasks_table"
:help "Timing of task: clean_task_table"})

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
(:require
[clojure.spec.alpha :as s]
[clojure.core.async :as a]
[clojure.spec.alpha :as s])
[cuerdas.core :as str])
(:import
java.util.concurrent.Executor))
java.util.concurrent.Executor
java.util.concurrent.ThreadFactory
java.util.concurrent.ForkJoinPool
java.util.concurrent.ForkJoinPool$ForkJoinWorkerThreadFactory
java.util.concurrent.ExecutorService
java.util.concurrent.atomic.AtomicLong))
(s/def ::executor #(instance? Executor %))
(defonce processors
(delay (.availableProcessors (Runtime/getRuntime))))
;; (defn forkjoin-thread-factory
;; [f]
;; (reify ForkJoinPool$ForkJoinWorkerThreadFactory
;; (newThread [this pool]
;; (let [wth (.newThread ForkJoinPool/defaultForkJoinWorkerThreadFactory pool)]
;; (f wth)))))
;; (defn forkjoin-named-thread-factory
;; [name]
;; (reify ForkJoinPool$ForkJoinWorkerThreadFactory
;; (newThread [this pool]
;; (let [wth (.newThread ForkJoinPool/defaultForkJoinWorkerThreadFactory pool)]
;; (.setName wth (str name ":" (.getPoolIndex wth)))
;; wth))))
;; (defn forkjoin-pool
;; [{:keys [factory async? parallelism]
;; :or {async? true}
;; :as opts}]
;; (let [parallelism (or parallelism @processors)
;; factory (cond
;; (fn? factory) (forkjoin-thread-factory factory)
;; (instance? ForkJoinPool$ForkJoinWorkerThreadFactory factory) factory
;; (nil? factory) ForkJoinPool/defaultForkJoinWorkerThreadFactory
;; :else (throw (ex-info "Unexpected thread factory" {:factory factory})))]
;; (ForkJoinPool. (or parallelism @processors) factory nil async?)))
(defmacro go-try
[& body]
@ -18,13 +56,6 @@
~@body
(catch Exception e# e#))))
(defmacro <?
[ch]
`(let [r# (a/<! ~ch)]
(if (instance? Exception r#)
(throw r#)
r#)))
(defmacro thread-try
[& body]
`(a/thread
@ -33,8 +64,12 @@
(catch Exception e#
e#))))
(s/def ::executor #(instance? Executor %))
(defmacro <?
[ch]
`(let [r# (a/<! ~ch)]
(if (instance? Exception r#)
(throw r#)
r#)))
(defn thread-call
[^Executor executor f]
@ -50,6 +85,12 @@
(a/close! c)))))
c
(catch java.util.concurrent.RejectedExecutionException e
(a/offer! c e)
(a/close! 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
;; 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
"Async tasks abstraction (impl)."
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.tasks.clean-tasks-table]
[app.tasks.delete-object]
[app.tasks.delete-profile]
[app.tasks.file-media-gc]
[app.tasks.file-xlog-gc]
[app.tasks.remove-media]
[app.tasks.sendmail]
[app.util.async :as aa]
[app.util.time :as dt]
[clojure.core.async :as a]
[clojure.pprint :refer [pprint]]
[clojure.spec.alpha :as s]
[clojure.tools.logging :as log]
[mount.core :as mount :refer [defstate]]
[cuerdas.core :as str]
[integrant.core :as ig]
[promesa.exec :as px])
(:import
org.eclipse.jetty.util.thread.QueuedThreadPool
java.util.concurrent.ExecutorService
java.util.concurrent.Executors
java.time.Instant))
java.util.concurrent.Executor
java.time.Duration
java.time.Instant
java.util.Date))
(declare start-scheduler-worker!)
(declare start-worker!)
(declare thread-pool)
(declare stop!)
(s/def ::executor #(instance? Executor %))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Entry Point (state initialization)
;; Executor
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private tasks
{"delete-profile" #'app.tasks.delete-profile/handler
"delete-object" #'app.tasks.delete-object/handler
"remove-media" #'app.tasks.remove-media/handler
"sendmail" #'app.tasks.sendmail/handler})
(s/def ::name ::us/string)
(s/def ::min-threads ::us/integer)
(s/def ::max-threads ::us/integer)
(s/def ::idle-timeout ::us/integer)
(def ^:private schedule
[{:id "remove-deleted-media"
:cron #app/cron "0 0 0 */1 * ? *" ;; daily
:fn #'app.tasks.remove-media/trim-media-storage}
(defmethod ig/pre-init-spec ::executor [_]
(s/keys :opt-un [::min-threads ::max-threads ::idle-timeout ::name]))
{:id "file-media-gc"
:cron #app/cron "0 0 0 */1 * ? *" ;; daily
:fn #'app.tasks.file-media-gc/handler}
(defmethod ig/prep-key ::executor
[_ cfg]
(merge {:min-threads 0
:max-threads 256
:idle-timeout 60000
:name "worker"}
cfg))
{:id "file-xlog-gc"
:cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn #'app.tasks.file-xlog-gc/handler}
(defmethod ig/init-key ::executor
[_ {:keys [min-threads max-threads idle-timeout name]}]
(doto (QueuedThreadPool. (int max-threads)
(int min-threads)
(int idle-timeout))
(.setStopTimeout 500)
(.setName name)
(.start)))
{:id "clean-tasks-table"
:cron #app/cron "0 0 0 */1 * ?" ;; daily
:fn #'app.tasks.clean-tasks-table/handler}
])
(defstate executor
:start (thread-pool {:min-threads 0
:max-threads 256})
:stop (stop! executor))
(defstate worker
:start (start-worker!
{:tasks tasks
:name "worker1"
:batch-size 1
:executor executor})
:stop (stop! worker))
(defstate scheduler-worker
:start (start-scheduler-worker! {:schedule schedule
:executor executor})
:stop (stop! scheduler-worker))
(defmethod ig/halt-key! ::executor
[_ instance]
(.stop ^QueuedThreadPool instance))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tasks Worker Impl
;; Worker
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare event-loop-fn)
(s/def ::queue ::us/string)
(s/def ::parallelism ::us/integer)
(s/def ::batch-size ::us/integer)
(s/def ::tasks (s/map-of string? ::us/fn))
(s/def ::poll-interval ::dt/duration)
(defmethod ig/pre-init-spec ::worker [_]
(s/keys :req-un [::executor
::db/pool
::batch-size
::name
::poll-interval
::queue
::tasks]))
(defmethod ig/prep-key ::worker
[_ cfg]
(merge {:batch-size 2
:name "worker"
:poll-interval (dt/duration {:seconds 5})
:queue "default"}
cfg))
(defmethod ig/init-key ::worker
[_ {:keys [pool poll-interval name queue] :as cfg}]
(log/infof "Starting worker '%s' on queue '%s'." name queue)
(let [cch (a/chan 1)
poll-ms (inst-ms poll-interval)]
(a/go-loop []
(let [[val port] (a/alts! [cch (event-loop-fn cfg)] :priority true)]
(cond
;; Terminate the loop if close channel is closed or
;; event-loop-fn returns nil.
(or (= port cch) (nil? val))
(log/infof "Stop condition found. Shutdown worker: '%s'" name)
(db/pool-closed? pool)
(do
(log/info "Worker eventloop is aborted because pool is closed.")
(a/close! cch))
(and (instance? java.sql.SQLException val)
(contains? #{"08003" "08006" "08001" "08004"} (.getSQLState ^java.sql.SQLException val)))
(do
(log/error "Connection error, trying resume in some instants.")
(a/<! (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
sql:mark-as-retry
"update task
set scheduled_at = clock_timestamp() + '10 seconds'::interval,
set scheduled_at = clock_timestamp() + ?::interval,
modified_at = clock_timestamp(),
error = ?,
status = 'retry',
retry_num = retry_num + ?
where id = ?")
(def default-delay
(dt/duration {:seconds 10}))
(defn- mark-as-retry
[conn {:keys [task error inc-by]
:or {inc-by 1}}]
[conn {:keys [task error inc-by delay]
:or {inc-by 1 delay default-delay}}]
(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)
nil))
@ -118,7 +187,7 @@
nil))
(defn- mark-as-completed
[conn {:keys [task] :as opts}]
[conn {:keys [task] :as cfg}]
(let [now (dt/now)]
(db/update! conn :task
{:completed-at now
@ -138,40 +207,45 @@
(let [task-fn (get tasks name)]
(if task-fn
(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
(log/warn "no task handler found for" (pr-str name))
nil))))
(log/errorf error
(str "Unhandled exception.\n"
"=> task: " (:name item) "\n"
"=> retry: " (:retry-num item) "\n"
"=> props: \n"
(with-out-str
(pprint (:props item)))))
(if (>= (:retry-num item) (:max-retries item))
{:status :failed :task item :error error}
{:status :retry :task item :error error})))))
(defn- run-task
[{:keys [tasks]} item]
[{:keys [tasks conn]} item]
(try
(log/debugf "Started task '%s/%s/%s'." (:name item) (:id item) (:retry-num item))
(handle-task tasks item)
{:status :completed :task item}
(catch Exception e
(let [data (ex-data e)]
(cond
(and (= ::retry (:type data))
(= ::noop (:strategy data)))
{:status :retry :task item :error e :inc-by 0}
(and (< (:retry-num item)
(:max-retries item))
(= ::retry (:type data)))
{:status :retry :task item :error e}
:else
(do
(log/errorf e "Unhandled exception on task '%s' (retry: %s)\nProps: %s"
(:name item) (:retry-num item) (pr-str (:props item)))
(if (>= (:retry-num item) (:max-retries item))
{:status :failed :task item :error e}
{:status :retry :task item :error e})))))
(handle-exception e item))
(finally
(log/debugf "Finished task '%s/%s/%s'." (:name item) (:id item) (:retry-num item)))))
(def ^:private
sql:select-next-tasks
(def sql:select-next-tasks
"select * from task as t
where t.scheduled_at <= now()
and t.queue = ?
@ -181,103 +255,69 @@
for update skip locked")
(defn- event-loop-fn*
[{:keys [executor batch-size] :as opts}]
(db/with-atomic [conn db/pool]
(let [queue (:queue opts "default")
[{:keys [tasks pool executor batch-size] :as cfg}]
(db/with-atomic [conn pool]
(let [queue (:queue cfg)
items (->> (db/exec! conn [sql:select-next-tasks queue batch-size])
(map decode-task-row)
(seq))
opts (assoc opts :conn conn)]
cfg (assoc cfg :conn conn)]
(if (nil? items)
::empty
(let [results (->> items
(map #(partial run-task opts %))
(map #(px/submit! executor %)))]
(doseq [res results]
(let [res (deref res)]
(case (:status res)
:retry (mark-as-retry conn res)
:failed (mark-as-failed conn res)
:completed (mark-as-completed conn res))))
(let [proc-xf (comp (map #(partial run-task cfg %))
(map #(px/submit! executor %)))]
(->> (into [] proc-xf items)
(map deref)
(run! (fn [res]
(case (:status res)
:retry (mark-as-retry conn res)
:failed (mark-as-failed conn res)
:completed (mark-as-completed conn res)))))
::handled)))))
(defn- event-loop-fn
[{:keys [executor] :as opts}]
(aa/thread-call executor #(event-loop-fn* opts)))
[{:keys [executor] :as cfg}]
(aa/thread-call executor #(event-loop-fn* cfg)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Scheduler
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare schedule-task)
(declare synchronize-schedule)
(s/def ::batch-size ::us/integer)
(s/def ::poll-interval ::us/integer)
(s/def ::fn (s/or :var var? :fn fn?))
(s/def ::tasks (s/map-of string? ::fn))
(s/def ::id ::us/string)
(s/def ::cron dt/cron?)
(s/def ::props (s/nilable map?))
(s/def ::start-worker-params
(s/keys :req-un [::tasks ::aa/executor ::batch-size]
:opt-un [::poll-interval]))
(s/def ::scheduled-task
(s/keys :req-un [::id ::cron ::fn]
:opt-un [::props]))
(defn start-worker!
[{:keys [poll-interval]
:or {poll-interval 5000}
:as opts}]
(us/assert ::start-worker-params opts)
(log/infof "Starting worker '%s' on queue '%s'."
(:name opts "anonymous")
(:queue opts "default"))
(let [cch (a/chan 1)]
(a/go-loop []
(let [[val port] (a/alts! [cch (event-loop-fn opts)] :priority true)]
(cond
;; Terminate the loop if close channel is closed or
;; event-loop-fn returns nil.
(or (= port cch) (nil? val))
(log/infof "Stop condition found. Shutdown worker: '%s'"
(:name opts "anonymous"))
(s/def ::schedule (s/coll-of ::scheduled-task))
(db/pool-closed? db/pool)
(do
(log/info "Worker eventloop is aborted because pool is closed.")
(a/close! cch))
(and (instance? java.sql.SQLException val)
(contains? #{"08003" "08006" "08001" "08004"} (.getSQLState val)))
(do
(log/error "Connection error, trying resume in some instants.")
(a/<! (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/pre-init-spec ::scheduler [_]
(s/keys :req-un [::executor ::db/pool ::schedule]))
(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
java.lang.AutoCloseable
(close [_]
(a/close! cch)))))
(.shutdownNow ^ExecutorService scheduler)))))
(defmethod ig/halt-key! ::scheduler
[_ instance]
(.close ^java.lang.AutoCloseable instance))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Scheduled Tasks (cron based) IMPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private
sql:upsert-scheduled-task
(def sql:upsert-scheduled-task
"insert into scheduled_task (id, cron_expr)
values (?, ?)
on conflict (id)
@ -286,18 +326,18 @@
(defn- synchronize-schedule-item
[conn {:keys [id 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])))
(defn- synchronize-schedule!
[schedule]
(db/with-atomic [conn db/pool]
(defn- synchronize-schedule
[{:keys [pool schedule]}]
(db/with-atomic [conn pool]
(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")
(declare schedule-task!)
(declare schedule-task)
(defn exception->string
[error]
@ -305,7 +345,7 @@
(.printStackTrace ^Throwable error (java.io.PrintWriter. *out*))))
(defn- execute-scheduled-task
[{:keys [executor] :as opts} {:keys [id] :as task}]
[{:keys [executor pool] :as cfg} {:keys [id] :as task}]
(letfn [(run-task [conn]
(try
(when (db/exec-one! conn [sql:lock-scheduled-task id])
@ -318,7 +358,7 @@
(let [result (run-task conn)]
(if (instance? Throwable result)
(do
(log/warnf result "Unhandled exception on scheduled task '%s'." id)
(log/warnf result "unhandled exception on scheduled task '%s'" id)
(db/insert! conn :scheduled-task-history
{:id (uuid/next)
:task-id id
@ -328,75 +368,22 @@
{:id (uuid/next)
:task-id id}))))
(handle-task []
(db/with-atomic [conn db/pool]
(db/with-atomic [conn pool]
(handle-task* conn)))]
(try
(px/run! executor handle-task)
(finally
(schedule-task! opts task)))))
(schedule-task cfg task)))))
(defn ms-until-valid
(defn- ms-until-valid
[cron]
(s/assert dt/cron? cron)
(let [^Instant now (dt/now)
^Instant next (dt/next-valid-instant-from cron now)]
(let [now (dt/now)
next (dt/next-valid-instant-from cron now)]
(inst-ms (dt/duration-between now next))))
(defn- schedule-task!
[{:keys [scheduler] :as opts} {:keys [cron] :as task}]
(defn- schedule-task
[{:keys [scheduler] :as cfg} {:keys [cron] :as task}]
(let [ms (ms-until-valid cron)]
(px/schedule! scheduler ms (partial execute-scheduled-task opts task))))
(s/def ::fn (s/or :var var? :fn fn?))
(s/def ::id string?)
(s/def ::cron dt/cron?)
(s/def ::props (s/nilable map?))
(s/def ::scheduled-task
(s/keys :req-un [::id ::cron ::fn]
:opt-un [::props]))
(s/def ::schedule (s/coll-of ::scheduled-task))
(s/def ::start-scheduler-worker-params
(s/keys :req-un [::schedule]))
(defn start-scheduler-worker!
[{:keys [schedule] :as opts}]
(us/assert ::start-scheduler-worker-params opts)
(let [scheduler (Executors/newScheduledThreadPool (int 1))
opts (assoc opts :scheduler scheduler)]
(synchronize-schedule! schedule)
(run! (partial schedule-task! opts) schedule)
(reify
java.lang.AutoCloseable
(close [_]
(.shutdownNow ^ExecutorService scheduler)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Thread Pool
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn thread-pool
([] (thread-pool {}))
([{:keys [min-threads max-threads name]
:or {min-threads 0 max-threads 256}}]
(let [executor (QueuedThreadPool. max-threads min-threads)]
(.setName executor (or name "default-tp"))
(.start executor)
executor)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn stop!
[o]
(cond
(instance? java.lang.AutoCloseable o)
(.close ^java.lang.AutoCloseable o)
(instance? org.eclipse.jetty.util.component.ContainerLifeCycle o)
(.stop ^org.eclipse.jetty.util.component.ContainerLifeCycle o)
:else
(ex/raise :type :not-implemented)))
(px/schedule! scheduler ms (partial execute-scheduled-task cfg task))))

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

@ -9,58 +9,54 @@
(ns app.tests.helpers
(:require
[expound.alpha :as expound]
[app.common.pages :as cp]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.main :as main]
[app.media-storage]
[app.media]
[app.migrations]
[app.rpc.mutations.files :as files]
[app.rpc.mutations.profile :as profile]
[app.rpc.mutations.projects :as projects]
[app.rpc.mutations.teams :as teams]
[app.util.blob :as blob]
[app.util.storage :as ust]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[promesa.core :as p]
[datoteka.core :as fs]
[cuerdas.core :as str]
[mount.core :as mount]
[datoteka.core :as fs]
[environ.core :refer [env]]
[app.common.pages :as cp]
[app.services]
[app.services.mutations.profile :as profile]
[app.services.mutations.projects :as projects]
[app.services.mutations.teams :as teams]
[app.services.mutations.files :as files]
[app.migrations]
[app.media]
[app.media-storage]
[app.db :as db]
[app.util.blob :as blob]
[app.common.uuid :as uuid]
[app.util.storage :as ust]
[app.config :as cfg])
[integrant.core :as ig]
[promesa.core :as p])
(:import org.postgresql.ds.PGSimpleDataSource))
(defn testing-datasource
[]
(doto (PGSimpleDataSource.)
(.setServerName "postgres")
(.setDatabaseName "penpot_test")
(.setUser "penpot")
(.setPassword "penpot")))
(def ^:dynamic *system* nil)
(def ^:dynamic *pool* nil)
(defn state-init
[next]
(let [config (cfg/read-test-config env)]
(let [config (-> (main/build-system-config @cfg/test-config)
(dissoc :app.srepl/server
:app.http/server
:app.http/router
:app.notifications/handler
:app.http.auth/google
:app.http.auth/gitlab
:app.worker/scheduler
:app.worker/executor
:app.worker/worker))
_ (ig/load-namespaces config)
system (-> (ig/prep config)
(ig/init))]
(try
(let [pool (testing-datasource)]
(-> (mount/only #{#'app.config/config
#'app.db/pool
#'app.redis/client
#'app.redis/conn
#'app.media/semaphore
#'app.services/query-services
#'app.services/mutation-services
#'app.migrations/migrations
#'app.media-storage/assets-storage
#'app.media-storage/media-storage})
(mount/swap {#'app.config/config config
#'app.db/pool pool})
(mount/start)))
(next)
(binding [*system* system
*pool* (:app.db/pool system)]
(next))
(finally
(mount/stop)))))
(ig/halt! system)))))
(defn database-reset
[next]
@ -68,7 +64,7 @@
" FROM information_schema.tables "
" WHERE table_schema = 'public' "
" AND table_name != 'migrations';")]
(db/with-atomic [conn db/pool]
(db/with-atomic [conn *pool*]
(let [result (->> (db/exec! conn [sql])
(map :table-name))]
(db/exec! conn [(str "TRUNCATE "
@ -77,14 +73,12 @@
(try
(next)
(finally
(ust/clear! app.media-storage/media-storage)
(ust/clear! app.media-storage/assets-storage))))
(ust/clear! (:app.media-storage/storage *system*)))))
(defn mk-uuid
[prefix & args]
(uuid/namespaced uuid/zero (apply str prefix args)))
;; --- Profile creation
(defn create-profile
[conn i]
@ -157,12 +151,27 @@
{:error (handle-error e#)
:result nil})))
(defn mutation!
[{:keys [::type] :as data}]
(let [method-fn (get-in *system* [:app.rpc/rpc :methods :mutation type])]
(try-on!
(method-fn (dissoc data ::type)))))
(defn query!
[{:keys [::type] :as data}]
(let [method-fn (get-in *system* [:app.rpc/rpc :methods :query type])]
(try-on!
(method-fn (dissoc data ::type)))))
;; --- Utils
(defn print-error!
[error]
(let [data (ex-data error)]
(cond
(= :spec-validation (:code data))
(println (:explain data))
(expound/printer (:data data))
(= :service-error (:type data))
(print-error! (.getCause ^Throwable error))

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

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

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

@ -15,11 +15,12 @@
[app.common.pages :refer [make-minimal-shape]]
[clojure.test :as t]))
(def default-path [{:command :move-to :params {:x 0 :y 0}}
{:command :line-to :params {:x 20 :y 20}}
{:command :line-to :params {:x 30 :y 30}}
{:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
{:command :close-path}])
(def default-path
[{:command :move-to :params {:x 0 :y 0}}
{:command :line-to :params {:x 20 :y 20}}
{:command :line-to :params {:x 30 :y 30}}
{:command :curve-to :params {:x 40 :y 40 :c1x 35 :c1y 35 :c2x 45 :c2y 45}}
{:command :close-path}])
(defn add-path-data [shape]
(let [content (:content shape default-path)
@ -56,7 +57,6 @@
:rect :path))
(t/testing "Transform shape with translation modifiers"
(t/are [type]
(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 :reply-to))
(t/is (vector? (:body result)))))
;; (t/deftest email-sending-and-sendmail-job
;; (let [res @(emails/send! emails/register {:to "example@app.io" :name "foo"})]
;; (t/is (nil? res)))
;; (with-mock mock
;; {:target 'app.jobs.sendmail/impl-sendmail
;; :return (p/resolved nil)}
;; (let [res @(app.jobs.sendmail/send-emails {})]
;; (t/is (= 1 res))
;; (t/is (:called? @mock))
;; (t/is (= 1 (:call-count @mock))))
;; (let [res @(app.jobs.sendmail/send-emails {})]
;; (t/is (= 0 res))
;; (t/is (:called? @mock))
;; (t/is (= 1 (:call-count @mock))))))

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

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

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

@ -13,8 +13,6 @@
[datoteka.core :as fs]
[app.common.uuid :as uuid]
[app.db :as db]
[app.services.mutations :as sm]
[app.services.queries :as sq]
[app.tests.helpers :as th]
[app.util.storage :as ust]))
@ -22,22 +20,22 @@
(t/use-fixtures :each th/database-reset)
(t/deftest media-crud
(let [prof (th/create-profile db/pool 1)
(let [prof (th/create-profile th/*pool* 1)
team-id (:default-team-id prof)
proj (th/create-project db/pool (:id prof) team-id 1)
file (th/create-file db/pool (:id prof) (:id proj) false 1)
proj (th/create-project th/*pool* (:id prof) team-id 1)
file (th/create-file th/*pool* (:id prof) (:id proj) false 1)
object-id-1 (uuid/next)
object-id-2 (uuid/next)]
(t/testing "create media object from url to file"
(let [url "https://raw.githubusercontent.com/uxbox/uxbox/develop/sample_media/images/unsplash/anna-pelzer.jpg"
data {::sm/type :add-media-object-from-url
data {::th/type :add-media-object-from-url
:id object-id-1
:profile-id (:id prof)
:file-id (:id file)
:is-local true
:url url}
out (th/try-on! (sm/handle data))]
out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@ -57,14 +55,14 @@
:tempfile (th/tempfile "app/tests/_files/sample.jpg")
:content-type "image/jpeg"
:size 312043}
data {::sm/type :upload-media-object
data {::th/type :upload-media-object
:id object-id-2
:profile-id (:id prof)
:file-id (:id file)
:is-local true
:name "testfile"
:content content}
out (th/try-on! (sm/handle data))]
out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
@ -78,71 +76,4 @@
(t/is (string? (get-in out [:result :path])))
(t/is (string? (get-in out [:result :thumb-path])))))
#_(t/testing "list media objects by file"
(let [data {::sq/type :media-objects
:profile-id (:id prof)
:file-id (:id file)
:is-local true}
out (th/try-on! (sq/handle data))]
(th/print-result! out)
;; Result is ordered by creation date descendent
(t/is (= object-id-2 (get-in out [:result 0 :id])))
(t/is (= "testfile" (get-in out [:result 0 :name])))
(t/is (= "image/jpeg" (get-in out [:result 0 :mtype])))
(t/is (= 800 (get-in out [:result 0 :width])))
(t/is (= 800 (get-in out [:result 0 :height])))
(t/is (string? (get-in out [:result 0 :path])))
(t/is (string? (get-in out [:result 0 :thumb-path])))))
#_(t/testing "single media object"
(let [data {::sq/type :media-object
:profile-id (:id prof)
:id object-id-2}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(t/is (= object-id-2 (get-in out [:result :id])))
(t/is (= "testfile" (get-in out [:result :name])))
(t/is (= "image/jpeg" (get-in out [:result :mtype])))
(t/is (= 800 (get-in out [:result :width])))
(t/is (= 800 (get-in out [:result :height])))
(t/is (string? (get-in out [:result :path])))))
#_(t/testing "delete media objects"
(let [data {::sm/type :delete-media-object
:profile-id (:id prof)
:id object-id-1}
out (th/try-on! (sm/handle data))]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
#_(t/testing "query media object after delete"
(let [data {::sq/type :media-object
:profile-id (:id prof)
:id object-id-1}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(let [error (:error out)]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :service-error)))
(let [error (ex-cause (:error out))]
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found)))))
#_(t/testing "query media objects after delete"
(let [data {::sq/type :media-objects
:profile-id (:id prof)
:file-id (:id file)
:is-local true}
out (th/try-on! (sq/handle data))]
;; (th/print-result! out)
(let [result (:result out)]
(t/is (= 1 (count result))))))
))

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

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

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

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

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

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

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

@ -210,6 +210,13 @@
(assoc m key v)
m)))
(defn domap
"A side effect map version."
([f]
(map (fn [x] (f x) x)))
([f coll]
(map (fn [x] (f x) x) coll)))
(defn merge
"A faster merge."
[& maps]

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

@ -46,13 +46,13 @@
(defn send-query!
[id params]
(let [uri (str cfg/public-uri "/api/w/query/" (name id))]
(let [uri (str cfg/public-uri "/api/rpc/query/" (name id))]
(->> (http/send! {:method :get :uri uri :query params})
(rx/mapcat handle-response))))
(defn send-mutation!
[id params]
(let [uri (str cfg/public-uri "/api/w/mutation/" (name id))]
(let [uri (str cfg/public-uri "/api/rpc/mutation/" (name id))]
(->> (http/send! {:method :post :uri uri :body params})
(rx/mapcat handle-response))))

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

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

0
frontend/test.cljs Normal file
View file