Merge pull request #2793 from penpot/niwinz-access-tokens

🎉 ♻️ Refactor & Access Tokens (part 1)

backend/resources/rlimit.edn

@@ -3,8 +3,8 @@
 {:default
  [[:default :window "200000/h"]]
 
- #{:query/teams}
+ #{:command/get-teams}
  [[:burst :bucket "5/1/5s"]]
 
- #{:query/profile}
- [[:burst :bucket "100/60/1m"]]}
+ #{:command/get-profile}
+ [[:burst :bucket "60/60/1m"]]}

backend/scripts/repl

@@ -2,7 +2,21 @@
 
 export PENPOT_HOST=devenv
 export PENPOT_TENANT=dev
-export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp enable-webhooks"
+export PENPOT_FLAGS="\
+       $PENPOT_FLAGS \
+       enable-backend-asserts \
+       enable-audit-log \
+       enable-transit-readable-response \
+       enable-demo-users \
+       disable-secure-session-cookies \
+       enable-smtp \
+       enable-prepl-server \
+       enable-urepl-server \
+       enable-rpc-climit \
+       enable-rpc-rlimit \
+       enable-soft-rpc-rlimit \
+       enable-webhooks \
+       enable-access-tokens";
 
 # export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
 # export PENPOT_DATABASE_USERNAME="penpot"
@@ -31,11 +45,12 @@ export PENPOT_STORAGE_ASSETS_S3_BUCKET=penpot
 export OPTIONS="
        -A:jmx-remote -A:dev \
        -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-       -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
-       -J-XX:+UseG1GC \
-       -J-XX:-OmitStackTraceInFastThrow \
-       -J-Xms50m -J-Xmx1024m \
        -J-Djdk.attach.allowAttachSelf \
+       -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
+       -J-Xms50m \
+       -J-Xmx1024m \
+       -J-XX:+UseZGC \
+       -J-XX:-OmitStackTraceInFastThrow \
        -J-XX:+UnlockDiagnosticVMOptions \
        -J-XX:+DebugNonSafepoints";
 

backend/src/app/auth/oidc.clj

@@ -21,7 +21,7 @@
    [app.http.session :as session]
    [app.loggers.audit :as audit]
    [app.main :as-alias main]
-   [app.rpc.queries.profile :as profile]
+   [app.rpc.commands.profile :as profile]
    [app.tokens :as tokens]
    [app.util.json :as json]
    [app.util.time :as dt]
@@ -349,7 +349,7 @@
                    ::fullname
                    ::props]))
 
-(defn retrieve-info
+(defn get-info
   [{:keys [provider] :as cfg} {:keys [params] :as request}]
   (letfn [(validate-oidc [info]
             ;; If the provider is OIDC, we can proceed to check
@@ -396,14 +396,12 @@
           (p/then' validate-oidc)
           (p/then' (partial post-process state))))))
 
-(defn- retrieve-profile
+(defn- get-profile
   [{:keys [::db/pool ::wrk/executor] :as cfg} info]
   (px/with-dispatch executor
     (with-open [conn (db/open pool)]
       (some->> (:email info)
-               (profile/retrieve-profile-data-by-email conn)
-               (profile/populate-additional-data conn)
-               (profile/decode-profile-row)))))
+               (profile/get-profile-by-email conn)))))
 
 (defn- redirect-response
   [uri]
@@ -417,9 +415,9 @@
     (redirect-response uri)))
 
 (defn- generate-redirect
-  [{:keys [::session/session] :as cfg} request info profile]
+  [cfg request info profile]
   (if profile
-    (let [sxf    (session/create-fn session (:id profile))
+    (let [sxf    (session/create-fn cfg (:id profile))
           token  (or (:invitation-token info)
                      (tokens/generate (::main/props cfg)
                                       {:iss :auth
@@ -436,7 +434,7 @@
 
       (when-let [collector (::audit/collector cfg)]
         (audit/submit! collector {:type "command"
-                                  :name "login"
+                                  :name "login-with-password"
                                   :profile-id (:id profile)
                                   :ip-addr (audit/parse-client-ip request)
                                   :props (audit/profile->props profile)}))
@@ -471,8 +469,8 @@
 (defn- callback-handler
   [cfg request]
   (letfn [(process-request []
-            (p/let [info    (retrieve-info cfg request)
-                    profile (retrieve-profile cfg info)]
+            (p/let [info    (get-info cfg request)
+                    profile (get-profile cfg info)]
               (generate-redirect cfg request info profile)))
 
           (handle-error [cause]
@@ -524,23 +522,24 @@
 
 (s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider)))
 
+(s/def ::routes vector?)
+
 (defmethod ig/pre-init-spec ::routes
   [_]
-  (s/keys :req [::http/client
+  (s/keys :req [::session/manager
+                ::http/client
                 ::wrk/executor
                 ::main/props
                 ::db/pool
-                ::providers
-                ::session/session]))
+                ::providers]))
 
 (defmethod ig/init-key ::routes
-  [_ {:keys [::wrk/executor ::session/session] :as cfg}]
+  [_ {:keys [::wrk/executor] :as cfg}]
   (let [cfg (update cfg :provider d/without-nils)]
-    ["" {:middleware [[(:middleware session)]
+    ["" {:middleware [[session/authz cfg]
                       [hmw/with-dispatch executor]
                       [hmw/with-config cfg]
-                      [provider-lookup]
-                      ]}
+                      [provider-lookup]]}
      ["/auth/oauth"
       ["/:provider"
        {:handler auth-handler
@@ -548,4 +547,3 @@
       ["/:provider/callback"
        {:handler callback-handler
         :allowed-methods #{:get}}]]]))
-

backend/src/app/cli/manage.clj

@@ -10,9 +10,8 @@
    [app.common.logging :as l]
    [app.db :as db]
    [app.main :as main]
-   [app.rpc.commands.auth :as cmd.auth]
-   [app.rpc.mutations.profile :as profile]
-   [app.rpc.queries.profile :refer [retrieve-profile-data-by-email]]
+   [app.rpc.commands.auth :as auth]
+   [app.rpc.commands.profile :as profile]
    [clojure.string :as str]
    [clojure.tools.cli :refer [parse-opts]]
    [integrant.core :as ig])
@@ -55,16 +54,17 @@
                                          :type :password}))]
     (try
       (db/with-atomic [conn (:app.db/pool system)]
-        (->> (cmd.auth/create-profile conn
-                                     {:fullname fullname
-                                      :email email
-                                      :password password
-                                      :is-active true
-                                      :is-demo false})
-             (cmd.auth/create-profile-relations conn)))
+        (->> (auth/create-profile! conn
+                                  {:fullname fullname
+                                   :email email
+                                   :password password
+                                   :is-active true
+                                   :is-demo false})
+             (auth/create-profile-rels! conn)))
 
       (when (pos? (:verbosity options))
         (println "User created successfully."))
+
       (System/exit 0)
 
       (catch Exception _e
@@ -79,7 +79,7 @@
       (db/with-atomic [conn (:app.db/pool system)]
         (let [email    (or (:email options)
                            (read-from-console {:label "Email:"}))
-              profile  (retrieve-profile-data-by-email conn email)]
+              profile  (profile/get-profile-by-email conn email)]
           (when-not profile
             (when (pos? (:verbosity options))
               (println "Profile does not exists."))

backend/src/app/config.clj

@@ -64,8 +64,6 @@
    :tenant "default"
 
    :redis-uri "redis://redis/0"
-   :srepl-host "127.0.0.1"
-   :srepl-port 6062
 
    :assets-storage-backend :assets-fs
    :storage-assets-fs-directory "assets"
@@ -128,6 +126,7 @@
 (s/def ::database-max-pool-size ::us/integer)
 
 (s/def ::quotes-teams-per-profile ::us/integer)
+(s/def ::quotes-access-tokens-per-profile ::us/integer)
 (s/def ::quotes-projects-per-team ::us/integer)
 (s/def ::quotes-invitations-per-team ::us/integer)
 (s/def ::quotes-profiles-per-team ::us/integer)
@@ -196,8 +195,10 @@
 (s/def ::smtp-ssl ::us/boolean)
 (s/def ::smtp-tls ::us/boolean)
 (s/def ::smtp-username (s/nilable ::us/string))
-(s/def ::srepl-host ::us/string)
-(s/def ::srepl-port ::us/integer)
+(s/def ::urepl-host ::us/string)
+(s/def ::urepl-port ::us/integer)
+(s/def ::prepl-host ::us/string)
+(s/def ::prepl-port ::us/integer)
 (s/def ::assets-storage-backend ::us/keyword)
 (s/def ::storage-assets-fs-directory ::us/string)
 (s/def ::storage-assets-s3-bucket ::us/string)
@@ -281,6 +282,7 @@
                    ::public-uri
 
                    ::quotes-teams-per-profile
+                   ::quotes-access-tokens-per-profile
                    ::quotes-projects-per-team
                    ::quotes-invitations-per-team
                    ::quotes-profiles-per-team
@@ -308,8 +310,10 @@
                    ::smtp-tls
                    ::smtp-username
 
-                   ::srepl-host
-                   ::srepl-port
+                   ::urepl-host
+                   ::urepl-port
+                   ::prepl-host
+                   ::prepl-port
 
                    ::assets-storage-backend
                    ::storage-assets-fs-directory

backend/src/app/db.clj

@@ -233,44 +233,46 @@
   [pool]
   (jdbc/get-connection pool))
 
+(def ^:private default-opts
+  {:builder-fn sql/as-kebab-maps})
+
 (defn exec!
   ([ds sv]
-   (exec! ds sv {}))
+   (jdbc/execute! ds sv default-opts))
   ([ds sv opts]
-   (jdbc/execute! ds sv (assoc opts :builder-fn sql/as-kebab-maps))))
+   (jdbc/execute! ds sv (merge default-opts opts))))
 
 (defn exec-one!
-  ([ds sv] (exec-one! ds sv {}))
+  ([ds sv]
+   (jdbc/execute-one! ds sv default-opts))
   ([ds sv opts]
-   (jdbc/execute-one! ds sv (assoc opts :builder-fn sql/as-kebab-maps))))
+   (jdbc/execute-one! ds sv
+                      (-> (merge default-opts opts)
+                          (assoc :return-keys (::return-keys? opts false))))))
 
 (defn insert!
-  ([ds table params] (insert! ds table params nil))
-  ([ds table params opts]
-   (exec-one! ds
-              (sql/insert table params opts)
-              (merge {:return-keys true} opts))))
+  [ds table params & {:as opts}]
+  (exec-one! ds
+             (sql/insert table params opts)
+             (merge {::return-keys? true} opts)))
 
 (defn insert-multi!
-  ([ds table cols rows] (insert-multi! ds table cols rows nil))
-  ([ds table cols rows opts]
-   (exec! ds
-          (sql/insert-multi table cols rows opts)
-          (merge {:return-keys true} opts))))
+  [ds table cols rows & {:as opts}]
+  (exec! ds
+         (sql/insert-multi table cols rows opts)
+         (merge {::return-keys? true} opts)))
 
 (defn update!
-  ([ds table params where] (update! ds table params where nil))
-  ([ds table params where opts]
-   (exec-one! ds
-              (sql/update table params where opts)
-              (merge {:return-keys true} opts))))
+  [ds table params where & {:as opts}]
+  (exec-one! ds
+             (sql/update table params where opts)
+             (merge {::return-keys? true} opts)))
 
 (defn delete!
-  ([ds table params] (delete! ds table params nil))
-  ([ds table params opts]
-   (exec-one! ds
-              (sql/delete table params opts)
-              (assoc opts :return-keys true))))
+  [ds table params & {:as opts}]
+  (exec-one! ds
+             (sql/delete table params opts)
+             (merge {::return-keys? true} opts)))
 
 (defn is-row-deleted?
   [{:keys [deleted-at]}]
@@ -279,56 +281,34 @@
           (inst-ms (dt/now)))))
 
 (defn get*
-  "Internal function for retrieve a single row from database that
-  matches a simple filters."
-  ([ds table params]
-   (get* ds table params nil))
-  ([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}]
-   (let [rows (exec! ds (sql/select table params opts))
-         rows (cond->> rows
-                check-deleted?
-                (remove is-row-deleted?))]
-     (first rows))))
+  "Retrieve a single row from database that matches a simple filters. Do
+  not raises exceptions."
+  [ds table params & {:as opts}]
+  (let [rows (exec! ds (sql/select table params opts))
+        rows (cond->> rows
+               (::remove-deleted? opts true)
+               (remove is-row-deleted?))]
+    (first rows)))
 
 (defn get
-  ([ds table params]
-   (get ds table params nil))
-  ([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}]
-   (let [row (get* ds table params opts)]
-     (when (and (not row) check-deleted?)
-       (ex/raise :type :not-found
-                 :code :object-not-found
-                 :table table
-                 :hint "database object not found"))
-     row)))
-
-(defn get-by-params
-  "DEPRECATED"
-  ([ds table params]
-   (get-by-params ds table params nil))
-  ([ds table params {:keys [check-not-found] :or {check-not-found true} :as opts}]
-   (let [row (get* ds table params (assoc opts :check-deleted? check-not-found))]
-     (when (and (not row) check-not-found)
-       (ex/raise :type :not-found
-                 :code :object-not-found
-                 :table table
-                 :hint "database object not found"))
-     row)))
+  "Retrieve a single row from database that matches a simple
+  filters. Raises :not-found exception if no object is found."
+  [ds table params & {:as opts}]
+  (let [row (get* ds table params opts)]
+    (when (and (not row) (::check-deleted? opts true))
+      (ex/raise :type :not-found
+                :code :object-not-found
+                :table table
+                :hint "database object not found"))
+    row))
 
 (defn get-by-id
-  ([ds table id]
-   (get ds table {:id id} nil))
-  ([ds table id opts]
-   (let [opts (cond-> opts
-                (contains? opts :check-not-found)
-                (assoc :check-deleted? (:check-not-found opts)))]
-     (get ds table {:id id} opts))))
+  [ds table id & {:as opts}]
+  (get ds table {:id id} opts))
 
 (defn query
-  ([ds table params]
-   (query ds table params nil))
-  ([ds table params opts]
-   (exec! ds (sql/select table params opts))))
+  [ds table params & {:as opts}]
+  (exec! ds (sql/select table params opts)))
 
 (defn pgobject?
   ([v]

backend/src/app/db/sql.clj

@@ -7,6 +7,7 @@
 (ns app.db.sql
   (:refer-clojure :exclude [update])
   (:require
+   [app.db :as-alias db]
    [clojure.string :as str]
    [next.jdbc.optional :as jdbc-opt]
    [next.jdbc.sql.builder :as sql]))
@@ -43,8 +44,10 @@
   ([table where-params opts]
    (let [opts (merge default-opts opts)
          opts (cond-> opts
-                (:for-update opts)    (assoc :suffix "FOR UPDATE")
-                (:for-key-share opts) (assoc :suffix "FOR KEY SHARE"))]
+                (::db/for-update? opts) (assoc :suffix "FOR UPDATE")
+                (::db/for-share? opts)  (assoc :suffix "FOR KEY SHARE")
+                (:for-update opts)      (assoc :suffix "FOR UPDATE")
+                (:for-key-share opts)   (assoc :suffix "FOR KEY SHARE"))]
      (sql/for-query table where-params opts))))
 
 (defn update

backend/src/app/http.clj

@@ -6,13 +6,22 @@
 
 (ns app.http
   (:require
+   [app.auth.oidc :as-alias oidc]
    [app.common.data :as d]
    [app.common.logging :as l]
    [app.common.transit :as t]
+   [app.db :as-alias db]
+   [app.http.access-token :as actoken]
+   [app.http.assets :as-alias assets]
+   [app.http.awsns :as-alias awsns]
+   [app.http.debug :as-alias debug]
    [app.http.errors :as errors]
    [app.http.middleware :as mw]
    [app.http.session :as session]
+   [app.http.websocket :as-alias ws]
    [app.metrics :as mtx]
+   [app.rpc :as-alias rpc]
+   [app.rpc.doc :as-alias rpc.doc]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
@@ -64,7 +73,6 @@
                  :http/max-body-size (:max-body-size cfg)
                  :http/max-multipart-body-size (:max-multipart-body-size cfg)
                  :xnio/io-threads (:io-threads cfg)
-                 :xnio/worker-threads (:worker-threads cfg)
                  :xnio/dispatch (:executor cfg)
                  :ring/async true}
 
@@ -113,64 +121,41 @@
 ;; HTTP ROUTER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::assets map?)
-(s/def ::awsns-handler fn?)
-(s/def ::debug-routes (s/nilable vector?))
-(s/def ::doc-routes (s/nilable vector?))
-(s/def ::feedback fn?)
-(s/def ::oauth map?)
-(s/def ::oidc-routes (s/nilable vector?))
-(s/def ::rpc-routes (s/nilable vector?))
-(s/def ::session ::session/session)
-(s/def ::storage map?)
-(s/def ::ws fn?)
-
 (defmethod ig/pre-init-spec ::router [_]
-  (s/keys :req-un [::mtx/metrics
-                   ::ws
-                   ::storage
-                   ::assets
-                   ::session
-                   ::feedback
-                   ::awsns-handler
-                   ::debug-routes
-                   ::oidc-routes
-                   ::rpc-routes
-                   ::doc-routes]))
+  (s/keys :req [::session/manager
+                ::actoken/manager
+                ::ws/routes
+                ::rpc/routes
+                ::rpc.doc/routes
+                ::oidc/routes
+                ::assets/routes
+                ::debug/routes
+                ::db/pool
+                ::mtx/routes
+                ::awsns/routes]))
 
 (defmethod ig/init-key ::router
-  [_ {:keys [ws session metrics assets feedback] :as cfg}]
+  [_ cfg]
   (rr/router
    [["" {:middleware [[mw/server-timing]
                       [mw/format-response]
                       [mw/params]
                       [mw/parse-request]
-                      [session/middleware-1 session]
+                      [session/soft-auth cfg]
+                      [actoken/soft-auth cfg]
                       [mw/errors errors/handle]
                       [mw/restrict-methods]]}
 
-     ["/metrics" {:handler (::mtx/handler metrics)
-                  :allowed-methods #{:get}}]
-
-     ["/assets" {:middleware [[session/middleware-2 session]]}
-      ["/by-id/:id" {:handler (:objects-handler assets)}]
-      ["/by-file-media-id/:id" {:handler (:file-objects-handler assets)}]
-      ["/by-file-media-id/:id/thumbnail" {:handler (:file-thumbnails-handler assets)}]]
-
-     (:debug-routes cfg)
+     (::mtx/routes cfg)
+     (::assets/routes cfg)
+     (::debug/routes cfg)
 
      ["/webhooks"
-      ["/sns" {:handler (:awsns-handler cfg)
-               :allowed-methods #{:post}}]]
+      (::awsns/routes cfg)]
 
-     ["/ws/notifications" {:middleware [[session/middleware-2 session]]
-                           :handler ws
-                           :allowed-methods #{:get}}]
+     (::ws/routes cfg)
 
-     ["/api" {:middleware [[mw/cors]
-                           [session/middleware-2 session]]}
-      ["/feedback" {:handler feedback
-                    :allowed-methods #{:post}}]
-      (:doc-routes cfg)
-      (:oidc-routes cfg)
-      (:rpc-routes cfg)]]]))
+     ["/api" {:middleware [[mw/cors]]}
+      (::oidc/routes cfg)
+      (::rpc.doc/routes cfg)
+      (::rpc/routes cfg)]]]))

backend/src/app/http/access_token.clj

@@ -0,0 +1,96 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.http.access-token
+  (:require
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.main :as-alias main]
+   [app.tokens :as tokens]
+   [app.worker :as-alias wrk]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [yetti.request :as yrq]))
+
+
+(s/def ::manager
+  (s/keys :req [::db/pool ::wrk/executor ::main/props]))
+
+(defmethod ig/pre-init-spec ::manager [_] ::manager)
+(defmethod ig/init-key ::manager [_ cfg] cfg)
+(defmethod ig/halt-key! ::manager [_ _])
+
+(def header-re #"^Token\s+(.*)")
+
+(defn- get-token
+  [request]
+  (some->> (yrq/get-header request "authorization")
+           (re-matches header-re)
+           (second)))
+
+(defn- decode-token
+  [props token]
+  (when token
+    (tokens/verify props {:token token :iss "access-token"})))
+
+(defn- get-token-perms
+  [pool token-id]
+  (when-not (db/read-only? pool)
+    (when-let [token (db/get* pool :access-token {:id token-id} {:columns [:perms]})]
+      (some-> (:perms token)
+              (db/decode-pgarray #{})))))
+
+(defn- wrap-soft-auth
+  [handler {:keys [::manager]}]
+  (us/assert! ::manager manager)
+
+  (let [{:keys [::wrk/executor ::main/props]} manager]
+    (fn [request respond raise]
+      (let [token (get-token request)]
+        (->> (px/submit! executor (partial decode-token props token))
+             (p/fnly (fn [claims cause]
+                       (when cause
+                         (l/trace :hint "exception on decoding malformed token" :cause cause))
+                       (let [request (cond-> request
+                                       (map? claims)
+                                       (assoc ::id (:tid claims)))]
+                         (handler request respond raise)))))))))
+
+(defn- wrap-authz
+  [handler {:keys [::manager]}]
+  (us/assert! ::manager manager)
+  (let [{:keys [::wrk/executor ::db/pool]} manager]
+    (fn [request respond raise]
+      (if-let [token-id (::id request)]
+        (->> (px/submit! executor (partial get-token-perms pool token-id))
+             (p/fnly (fn [perms cause]
+                       (cond
+                         (some? cause)
+                         (raise cause)
+
+                         (nil? perms)
+                         (handler request respond raise)
+
+                         :else
+                         (let [request (assoc request ::perms perms)]
+                           (handler request respond raise))))))
+        (handler request respond raise)))))
+
+(def soft-auth
+  {:name ::soft-auth
+   :compile (fn [& _]
+              (when (contains? cf/flags :access-tokens)
+                wrap-soft-auth))})
+
+(def authz
+  {:name ::authz
+   :compile (fn [& _]
+              (when (contains? cf/flags :access-tokens)
+                wrap-authz))})

backend/src/app/http/assets.clj

@@ -115,7 +115,10 @@
 (s/def ::cache-max-age ::dt/duration)
 (s/def ::signature-max-age ::dt/duration)
 
-(defmethod ig/pre-init-spec ::handlers [_]
+(s/def ::routes vector?)
+
+;; FIXME: namespace qualified params
+(defmethod ig/pre-init-spec ::routes [_]
   (s/keys :req-un [::storage
                    ::wrk/executor
                    ::mtx/metrics
@@ -123,9 +126,9 @@
                    ::cache-max-age
                    ::signature-max-age]))
 
-(defmethod ig/init-key ::handlers
+(defmethod ig/init-key ::routes
   [_ cfg]
-  {:objects-handler (partial objects-handler cfg)
-   :file-objects-handler (partial file-objects-handler cfg)
-   :file-thumbnails-handler (partial file-thumbnails-handler cfg)})
-
+  ["/assets"
+   ["/by-id/:id" {:handler (partial objects-handler cfg)}]
+   ["/by-file-media-id/:id" {:handler (partial file-objects-handler cfg)}]
+   ["/by-file-media-id/:id/thumbnail" {:handler (partial file-thumbnails-handler cfg)}]])

backend/src/app/http/awsns.clj

@@ -28,18 +28,20 @@
 (declare parse-notification)
 (declare process-report)
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/pre-init-spec ::routes [_]
   (s/keys :req [::http/client
                 ::main/props
                 ::db/pool
                 ::wrk/executor]))
 
-(defmethod ig/init-key ::handler
+(defmethod ig/init-key ::routes
   [_ {:keys [::wrk/executor] :as cfg}]
-  (fn [request respond _]
-    (let [data (-> request yrq/body slurp)]
-      (px/run! executor #(handle-request cfg data)))
-    (respond (yrs/response 200))))
+  (letfn [(handler [request respond _]
+            (let [data (-> request yrq/body slurp)]
+              (px/run! executor #(handle-request cfg data)))
+            (respond (yrs/response 200)))]
+    ["/sns" {:handler handler
+             :allowed-methods #{:post}}]))
 
 (defn handle-request
   [cfg data]
@@ -105,8 +107,7 @@
   [cfg headers]
   (let [tdata (get headers "x-penpot-data")]
     (when-not (str/empty? tdata)
-      (let [sprops (::main/props cfg)
-            result (tokens/verify sprops {:token tdata :iss :profile-identity})]
+      (let [result (tokens/verify (::main/props cfg) {:token tdata :iss :profile-identity})]
         (:profile-id result)))))
 
 (defn- parse-notification

backend/src/app/http/debug.clj

@@ -16,8 +16,8 @@
    [app.http.middleware :as mw]
    [app.http.session :as session]
    [app.rpc.commands.binfile :as binf]
-   [app.rpc.commands.files.create :refer [create-file]]
-   [app.rpc.queries.profile :as profile]
+   [app.rpc.commands.files-create :refer [create-file]]
+   [app.rpc.commands.profile :as profile]
    [app.util.blob :as blob]
    [app.util.template :as tmpl]
    [app.util.time :as dt]
@@ -39,9 +39,9 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn authorized?
-  [pool {:keys [profile-id]}]
+  [pool {:keys [::session/profile-id]}]
   (or (= "devenv" (cf/get :host))
-      (let [profile (ex/ignoring (profile/retrieve-profile-data pool profile-id))
+      (let [profile (ex/ignoring (profile/get-profile pool profile-id))
             admins  (or (cf/get :admins) #{})]
         (contains? admins (:email profile)))))
 
@@ -61,7 +61,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn index-handler
-  [{:keys [pool]} request]
+  [{:keys [::db/pool]} request]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
@@ -81,7 +81,7 @@
   "select revn, changes, data from file_change where file_id=? and revn = ?")
 
 (defn- retrieve-file-data
-  [{:keys [pool]} {:keys [params profile-id] :as request}]
+  [{:keys [::db/pool]} {:keys [params ::session/profile-id] :as request}]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
@@ -107,8 +107,9 @@
         (prepare-download-response data filename)
 
         (contains? params :clone)
-        (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
-              data       (some-> data blob/decode)]
+        (let [profile    (profile/get-profile pool profile-id)
+              project-id (:default-project-id profile)
+              data       (blob/decode data)]
           (create-file pool {:id (uuid/next)
                              :name (str "Cloned file: " filename)
                              :project-id project-id
@@ -117,7 +118,7 @@
           (yrs/response 201 "OK CREATED"))
 
         :else
-        (prepare-response (some-> data blob/decode))))))
+        (prepare-response (blob/decode data))))))
 
 (defn- is-file-exists?
   [pool id]
@@ -125,8 +126,9 @@
     (-> (db/exec-one! pool [sql id]) :exists)))
 
 (defn- upload-file-data
-  [{:keys [pool]} {:keys [profile-id params] :as request}]
-  (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
+  [{:keys [::db/pool]} {:keys [::session/profile-id params] :as request}]
+  (let [profile    (profile/get-profile pool profile-id)
+        project-id (:default-project-id profile)
         data       (some-> params :file :path io/read-as-bytes blob/decode)]
 
     (if (and data project-id)
@@ -162,7 +164,7 @@
               :code :method-not-found)))
 
 (defn file-changes-handler
-  [{:keys [pool]} {:keys [params] :as request}]
+  [{:keys [::db/pool]} {:keys [params] :as request}]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
@@ -202,7 +204,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn error-handler
-  [{:keys [pool]} request]
+  [{:keys [::db/pool]} request]
   (letfn [(parse-id [request]
             (let [id (get-in request [:path-params :id])
                   id (parse-uuid id)]
@@ -251,7 +253,7 @@
     LIMIT 100")
 
 (defn error-list-handler
-  [{:keys [pool]} request]
+  [{:keys [::db/pool]} request]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
@@ -268,7 +270,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn export-handler
-  [{:keys [pool] :as cfg} {:keys [params profile-id] :as request}]
+  [{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]
 
   (let [file-ids (->> (:file-ids params)
                       (remove empty?)
@@ -287,7 +289,8 @@
                    (assoc ::binf/include-libraries? libs?)
                    (binf/export-to-tmpfile!))]
       (if clone?
-        (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)]
+        (let [profile    (profile/get-profile pool profile-id)
+              project-id (:default-project-id profile)]
           (binf/import!
            (assoc cfg
                   ::binf/input path
@@ -309,15 +312,16 @@
 
 
 (defn import-handler
-  [{:keys [pool] :as cfg} {:keys [params profile-id] :as request}]
+  [{:keys [::db/pool] :as cfg} {:keys [params ::session/profile-id] :as request}]
   (when-not (contains? params :file)
     (ex/raise :type :validation
               :code :missing-upload-file
               :hint "missing upload file"))
 
-  (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
+  (let [profile    (profile/get-profile pool profile-id)
+        project-id (:default-project-id profile)
         overwrite? (contains? params :overwrite)
-        migrate? (contains? params :migrate)
+        migrate?   (contains? params :migrate)
         ignore-index-errors? (contains? params :ignore-index-errors)]
 
     (when-not project-id
@@ -381,16 +385,17 @@
            (raise (ex/error :type :authentication
                             :code :only-admins-allowed))))))})
 
-
 (defmethod ig/pre-init-spec ::routes [_]
-  (s/keys :req-un [::db/pool ::wrk/executor ::session/session]))
+  (s/keys :req [::db/pool
+                ::wrk/executor
+                ::session/manager]))
 
 (defmethod ig/init-key ::routes
-  [_ {:keys [session pool executor] :as cfg}]
+  [_ {:keys [::db/pool ::wrk/executor] :as cfg}]
   [["/readyz" {:middleware [[mw/with-dispatch executor]
                             [mw/with-config cfg]]
                :handler health-handler}]
-   ["/dbg" {:middleware [[session/middleware-2 session]
+   ["/dbg" {:middleware [[session/authz cfg]
                          [with-authorization pool]
                          [mw/with-dispatch executor]
                          [mw/with-config cfg]]}

backend/src/app/http/errors.clj

@@ -11,6 +11,8 @@
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.http :as-alias http]
+   [app.http.access-token :as-alias actoken]
+   [app.http.session :as-alias session]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [yetti.request :as yrq]
@@ -26,7 +28,9 @@
 
 (defn get-context
   [request]
-  (let [claims (:session-token-claims request)]
+  (let [claims (-> {}
+                   (into (::session/token-claims request))
+                   (into (::actoken/token-claims request)))]
     (merge
      *context*
      {:path          (:path request)
@@ -49,6 +53,10 @@
   [err _]
   (yrs/response 401 (ex-data err)))
 
+(defmethod handle-exception :authorization
+  [err _]
+  (yrs/response 403 (ex-data err)))
+
 (defmethod handle-exception :restriction
   [err _]
   (yrs/response 400 (ex-data err)))

backend/src/app/http/feedback.clj

@@ -1,80 +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/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.http.feedback
-  "A general purpose feedback module."
-  (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.emails :as eml]
-   [app.rpc.queries.profile :as profile]
-   [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
-   [integrant.core :as ig]
-   [promesa.core :as p]
-   [promesa.exec :as px]
-   [yetti.request :as yrq]
-   [yetti.response :as yrs]))
-
-(declare ^:private send-feedback)
-(declare ^:private handler)
-
-(defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool ::wrk/executor]))
-
-(defmethod ig/init-key ::handler
-  [_ {:keys [executor] :as cfg}]
-  (let [enabled? (contains? cf/flags :user-feedback)]
-    (if enabled?
-      (fn [request respond raise]
-        (-> (px/submit! executor #(handler cfg request))
-            (p/then' respond)
-            (p/catch raise)))
-      (fn [_ _ raise]
-        (raise (ex/error :type :validation
-                         :code :feedback-disabled
-                         :hint "feedback module is disabled"))))))
-
-(defn- handler
-  [{:keys [pool] :as cfg} {:keys [profile-id] :as request}]
-  (let [ftoken (cf/get :feedback-token ::no-token)
-        token  (yrq/get-header request "x-feedback-token")
-        params (d/merge (:params request)
-                        (:body-params request))]
-    (cond
-      (uuid? profile-id)
-      (let [profile (profile/retrieve-profile-data pool profile-id)
-            params  (assoc params :from (:email profile))]
-        (send-feedback pool profile params))
-
-      (= token ftoken)
-      (send-feedback cfg nil params))
-
-    (yrs/response 204)))
-
-(s/def ::content ::us/string)
-(s/def ::from    ::us/email)
-(s/def ::subject ::us/string)
-(s/def ::feedback
-  (s/keys :req-un [::from ::subject ::content]))
-
-(defn- send-feedback
-  [pool profile params]
-  (let [params      (us/conform ::feedback params)
-        destination (cf/get :feedback-destination)]
-    (eml/send! {::eml/conn pool
-                ::eml/factory eml/feedback
-                :from     destination
-                :to       destination
-                :profile  profile
-                :reply-to (:from params)
-                :email    (:from params)
-                :subject  (:subject params)
-                :content  (:content params)})
-    nil))

backend/src/app/http/session.clj

@@ -9,14 +9,17 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
+   [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
+   [app.http.session.tasks :as-alias tasks]
    [app.main :as-alias main]
    [app.tokens :as tokens]
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.core :as p]
    [promesa.exec :as px]
@@ -45,55 +48,55 @@
 
 (defprotocol ISessionManager
   (read [_ key])
-  (decode [_ key])
   (write! [_ key data])
   (update! [_ data])
   (delete! [_ key]))
 
-(s/def ::session #(satisfies? ISessionManager %))
+(s/def ::manager #(satisfies? ISessionManager %))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; STORAGE IMPL
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(s/def ::session-params
+  (s/keys :req-un [::user-agent
+                   ::profile-id
+                   ::created-at]))
+
 (defn- prepare-session-params
-  [props data]
-  (let [profile-id (:profile-id data)
-        user-agent (:user-agent data)
-        created-at (or (:created-at data) (dt/now))
-        token      (tokens/generate props {:iss "authentication"
-                                           :iat created-at
-                                           :uid profile-id})]
-    {:user-agent user-agent
-     :profile-id profile-id
-     :created-at created-at
-     :updated-at created-at
-     :id token}))
+  [key params]
+  (us/assert! ::us/not-empty-string key)
+  (us/assert! ::session-params params)
+
+  {:user-agent (:user-agent params)
+   :profile-id (:profile-id params)
+   :created-at (:created-at params)
+   :updated-at (:created-at params)
+   :id key})
 
 (defn- database-manager
   [{:keys [::db/pool ::wrk/executor ::main/props]}]
+  ^{::wrk/executor executor
+    ::db/pool pool
+    ::main/props props}
   (reify ISessionManager
     (read [_ token]
       (px/with-dispatch executor
         (db/exec-one! pool (sql/select :http-session {:id token}))))
 
-    (decode [_ token]
+    (write! [_ key params]
       (px/with-dispatch executor
-        (tokens/verify props {:token token :iss "authentication"})))
-
-    (write! [_ _ data]
-      (px/with-dispatch executor
-        (let [params (prepare-session-params props data)]
+        (let [params (prepare-session-params key params)]
           (db/insert! pool :http-session params)
           params)))
 
-    (update! [_ data]
+    (update! [_ params]
       (let [updated-at (dt/now)]
         (px/with-dispatch executor
           (db/update! pool :http-session
                       {:updated-at updated-at}
-                      {:id (:id data)})
-          (assoc data :updated-at updated-at))))
+                      {:id (:id params)})
+          (assoc params :updated-at updated-at))))
 
     (delete! [_ token]
       (px/with-dispatch executor
@@ -101,27 +104,26 @@
         nil))))
 
 (defn inmemory-manager
-  [{:keys [::wrk/executor ::main/props]}]
+  [{:keys [::db/pool ::wrk/executor ::main/props]}]
   (let [cache (atom {})]
+    ^{::main/props props
+      ::wrk/executor executor
+      ::db/pool pool}
     (reify ISessionManager
       (read [_ token]
         (p/do (get @cache token)))
 
-      (decode [_ token]
-        (px/with-dispatch executor
-          (tokens/verify props {:token token :iss "authentication"})))
-
-      (write! [_ _ data]
+      (write! [_ key params]
         (p/do
-          (let [{:keys [token] :as params} (prepare-session-params props data)]
-            (swap! cache assoc token params)
+          (let [params (prepare-session-params key params)]
+            (swap! cache assoc key params)
             params)))
 
-      (update! [_ data]
+      (update! [_ params]
         (p/do
           (let [updated-at (dt/now)]
-            (swap! cache update (:id data) assoc :updated-at updated-at)
-            (assoc data :updated-at updated-at))))
+            (swap! cache update (:id params) assoc :updated-at updated-at)
+            (assoc params :updated-at updated-at))))
 
       (delete! [_ token]
         (p/do
@@ -144,25 +146,34 @@
 ;; MANAGER IMPL
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(declare assign-auth-token-cookie)
-(declare assign-authenticated-cookie)
-(declare clear-auth-token-cookie)
-(declare clear-authenticated-cookie)
+(declare ^:private assign-auth-token-cookie)
+(declare ^:private assign-authenticated-cookie)
+(declare ^:private clear-auth-token-cookie)
+(declare ^:private clear-authenticated-cookie)
+(declare ^:private gen-token)
 
 (defn create-fn
-  [manager profile-id]
-  (fn [request response]
-    (let [uagent  (yrq/get-header request "user-agent")
-          params  {:profile-id profile-id
-                   :user-agent uagent}]
-      (-> (write! manager nil params)
-          (p/then (fn [session]
-                    (l/trace :hint "create" :profile-id profile-id)
-                    (-> response
-                        (assign-auth-token-cookie session)
-                        (assign-authenticated-cookie session))))))))
+  [{:keys [::manager]} profile-id]
+  (us/assert! ::manager manager)
+  (us/assert! ::us/uuid profile-id)
+
+  (let [props (-> manager meta ::main/props)]
+    (fn [request response]
+      (let [uagent (yrq/get-header request "user-agent")
+            params {:profile-id profile-id
+                    :user-agent uagent
+                    :created-at (dt/now)}
+            token  (gen-token props params)]
+
+        (->> (write! manager token params)
+             (p/fmap (fn [session]
+                       (l/trace :hint "create" :profile-id profile-id)
+                       (-> response
+                           (assign-auth-token-cookie session)
+                           (assign-authenticated-cookie session)))))))))
 (defn delete-fn
-  [manager]
+  [{:keys [::manager]}]
+  (us/assert! ::manager manager)
   (letfn [(delete [{:keys [profile-id] :as request}]
             (let [cname   (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
                   cookie  (yrq/get-cookie request cname)]
@@ -177,68 +188,92 @@
             (clear-auth-token-cookie)
             (clear-authenticated-cookie))))))
 
-(def middleware-1
-  (letfn [(decode-cookie [manager cookie]
-            (if-let [value (:value cookie)]
-              (decode manager value)
-              (p/resolved nil)))
+(defn- gen-token
+  [props {:keys [profile-id created-at]}]
+  (tokens/generate props {:iss "authentication"
+                          :iat created-at
+                          :uid profile-id}))
+(defn- decode-token
+  [props token]
+  (when token
+    (tokens/verify props {:token token :iss "authentication"})))
 
-          (wrap-handler [manager handler request respond raise]
-            (let [cookie (some->> (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
-                                  (yrq/get-cookie request))]
-              (->> (decode-cookie manager cookie)
-                   (p/fnly (fn [claims _]
-                             (cond-> request
-                               (some? claims) (assoc :session-token-claims claims)
-                               :always        (handler respond raise)))))))]
-    {:name :session-1
-     :compile (fn [& _]
-                (fn [handler manager]
-                  (partial wrap-handler manager handler)))}))
+(defn- get-token
+  [request]
+  (let [cname  (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+        cookie (some-> (yrq/get-cookie request cname) :value)]
+    (when-not (str/empty? cookie)
+      cookie)))
 
-(def middleware-2
-  (letfn [(wrap-handler [manager handler request respond raise]
-            (-> (retrieve-session manager request)
-                (p/finally (fn [session cause]
-                             (cond
-                               (some? cause)
-                               (raise cause)
+(defn- get-session
+  [manager token]
+  (some->> token (read manager)))
 
-                               (nil? session)
-                               (handler request respond raise)
+(defn- renew-session?
+  [{:keys [updated-at] :as session}]
+  (and (dt/instant? updated-at)
+       (let [elapsed (dt/diff updated-at (dt/now))]
+         (neg? (compare default-renewal-max-age elapsed)))))
 
-                               :else
-                               (let [request (-> request
-                                                 (assoc :profile-id (:profile-id session))
-                                                 (assoc :session-id (:id session)))
-                                     respond (cond-> respond
-                                               (renew-session? session)
-                                               (wrap-respond manager session))]
-                                 (handler request respond raise)))))))
+(defn- wrap-reneval
+  [respond manager session]
+  (fn [response]
+    (p/let [session (update! manager session)]
+      (-> response
+          (assign-auth-token-cookie session)
+          (assign-authenticated-cookie session)
+          (respond)))))
 
-          (retrieve-session [manager request]
-            (let [cname  (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
-                  cookie (yrq/get-cookie request cname)]
-              (some->> (:value cookie) (read manager))))
+(defn- wrap-soft-auth
+  [handler {:keys [::manager]}]
+  (us/assert! ::manager manager)
 
-          (renew-session? [{:keys [updated-at] :as session}]
-            (and (dt/instant? updated-at)
-                 (let [elapsed (dt/diff updated-at (dt/now))]
-                   (neg? (compare default-renewal-max-age elapsed)))))
+  (let [{:keys [::wrk/executor ::main/props]} (meta manager)]
+    (fn [request respond raise]
+      (let [token (get-token request)]
+        (->> (px/submit! executor (partial decode-token props token))
+             (p/fnly (fn [claims cause]
+                       (when cause
+                         (l/trace :hint "exception on decoding malformed token" :cause cause))
 
-          ;; Wrap respond with session renewal code
-          (wrap-respond [respond manager session]
-            (fn [response]
-              (p/let [session (update! manager session)]
-                (-> response
-                    (assign-auth-token-cookie session)
-                    (assign-authenticated-cookie session)
-                    (respond)))))]
+                       (let [request (cond-> request
+                                       (map? claims)
+                                       (-> (assoc ::token-claims claims)
+                                           (assoc ::token token)))]
+                         (handler request respond raise)))))))))
 
-    {:name :session-2
-     :compile (fn [& _]
-                (fn [handler manager]
-                  (partial wrap-handler manager handler)))}))
+(defn- wrap-authz
+  [handler {:keys [::manager]}]
+  (us/assert! ::manager manager)
+  (fn [request respond raise]
+    (if-let [token (::token request)]
+      (->> (get-session manager token)
+           (p/fnly (fn [session cause]
+                     (cond
+                       (some? cause)
+                       (raise cause)
+
+                       (nil? session)
+                       (handler request respond raise)
+
+                       :else
+                       (let [request (-> request
+                                         (assoc ::profile-id (:profile-id session))
+                                         (assoc ::id (:id session)))
+                             respond (cond-> respond
+                                       (renew-session? session)
+                                       (wrap-reneval manager session))]
+                         (handler request respond raise))))))
+
+      (handler request respond raise))))
+
+(def soft-auth
+  {:name ::soft-auth
+   :compile (constantly wrap-soft-auth)})
+
+(def authz
+  {:name ::authz
+   :compile (constantly wrap-authz)})
 
 ;; --- IMPL
 
@@ -300,21 +335,26 @@
 ;; TASK: SESSION GC
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(declare sql:delete-expired)
+(s/def ::tasks/max-age ::dt/duration)
 
-(s/def ::max-age ::dt/duration)
+(defmethod ig/pre-init-spec ::tasks/gc [_]
+  (s/keys :req [::db/pool]
+          :opt [::tasks/max-age]))
 
-(defmethod ig/pre-init-spec ::gc-task [_]
-  (s/keys :req-un [::db/pool]
-          :opt-un [::max-age]))
-
-(defmethod ig/prep-key ::gc-task
+(defmethod ig/prep-key ::tasks/gc
   [_ cfg]
-  (merge {:max-age default-cookie-max-age}
-         (d/without-nils cfg)))
+  (let [max-age (cf/get :auth-token-cookie-max-age default-cookie-max-age)]
+    (merge {::tasks/max-age max-age} (d/without-nils cfg))))
 
-(defmethod ig/init-key ::gc-task
-  [_ {:keys [pool max-age] :as cfg}]
+(def ^:private
+  sql:delete-expired
+  "delete from http_session
+    where updated_at < now() - ?::interval
+       or (updated_at is null and
+           created_at < now() - ?::interval)")
+
+(defmethod ig/init-key ::tasks/gc
+  [_ {:keys [::db/pool ::tasks/max-age] :as cfg}]
   (l/debug :hint "initializing session gc task" :max-age max-age)
   (fn [_]
     (db/with-atomic [conn pool]
@@ -326,9 +366,3 @@
                  :deleted result)
         result))))
 
-(def ^:private
-  sql:delete-expired
-  "delete from http_session
-    where updated_at < now() - ?::interval
-       or (updated_at is null and
-           created_at < now() - ?::interval)")

backend/src/app/http/websocket.clj

@@ -12,6 +12,7 @@
    [app.common.pprint :as pp]
    [app.common.spec :as us]
    [app.db :as db]
+   [app.http.session :as session]
    [app.metrics :as mtx]
    [app.msgbus :as mbus]
    [app.util.time :as dt]
@@ -34,7 +35,7 @@
 (def state (atom {}))
 
 (defn- on-connect
-  [{:keys [metrics]} wsp]
+  [{:keys [::mtx/metrics]} wsp]
   (let [created-at (dt/now)]
     (swap! state assoc (::ws/id @wsp) wsp)
     (mtx/run! metrics
@@ -48,7 +49,7 @@
                 :val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)))))
 
 (defn- on-rcv-message
-  [{:keys [metrics]} _ message]
+  [{:keys [::mtx/metrics]} _ message]
   (mtx/run! metrics
             :id :websocket-messages-total
             :labels recv-labels
@@ -56,7 +57,7 @@
   message)
 
 (defn- on-snd-message
-  [{:keys [metrics]} _ message]
+  [{:keys [::mtx/metrics]} _ message]
   (mtx/run! metrics
             :id :websocket-messages-total
             :labels send-labels
@@ -95,7 +96,6 @@
      :user-agent       (::ws/user-agent @wsp)
      :ip-addr          (::ws/remote-addr @wsp)
      :last-activity-at (::ws/last-activity-at @wsp)
-     :http-session-id  (::ws/http-session-id @wsp)
      :subscribed-file  (-> wsp deref ::file-subscription :file-id)
      :subscribed-team  (-> wsp deref ::team-subscription :team-id)}))
 
@@ -120,7 +120,7 @@
 (defmethod handle-message :connect
   [cfg wsp _]
 
-  (let [msgbus     (:msgbus cfg)
+  (let [msgbus     (::mbus/msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -139,7 +139,7 @@
 
 (defmethod handle-message :disconnect
   [cfg wsp _]
-  (let [msgbus     (:msgbus cfg)
+  (let [msgbus     (::mbus/msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -173,7 +173,7 @@
 
 (defmethod handle-message :subscribe-team
   [cfg wsp {:keys [team-id] :as params}]
-  (let [msgbus     (:msgbus cfg)
+  (let [msgbus     (::mbus/msgbus cfg)
         conn-id    (::ws/id @wsp)
         session-id (::session-id @wsp)
         output-ch  (::ws/output-ch @wsp)
@@ -205,7 +205,7 @@
 
 (defmethod handle-message :subscribe-file
   [cfg wsp {:keys [file-id] :as params}]
-  (let [msgbus     (:msgbus cfg)
+  (let [msgbus     (::mbus/msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -258,7 +258,7 @@
 
 (defmethod handle-message :unsubscribe-file
   [cfg wsp {:keys [file-id] :as params}]
-  (let [msgbus     (:msgbus cfg)
+  (let [msgbus     (::mbus/msgbus cfg)
         conn-id    (::ws/id @wsp)
         session-id (::session-id @wsp)
         profile-id (::profile-id @wsp)
@@ -288,7 +288,7 @@
 
 (defmethod handle-message :pointer-update
   [cfg wsp {:keys [file-id] :as message}]
-  (let [msgbus     (:msgbus cfg)
+  (let [msgbus     (::mbus/msgbus cfg)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
         subs       (::file-subscription @wsp)
@@ -313,39 +313,47 @@
 ;; HTTP HANDLER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::msgbus ::mbus/msgbus)
 (s/def ::session-id ::us/uuid)
-
 (s/def ::handler-params
   (s/keys :req-un [::session-id]))
 
-(defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::msgbus ::db/pool ::mtx/metrics]))
+(defn- http-handler
+  [cfg {:keys [params ::session/profile-id] :as request} respond raise]
+  (let [{:keys [session-id]} (us/conform ::handler-params params)]
+    (cond
+      (not profile-id)
+      (raise (ex/error :type :authentication
+                       :hint "Authentication required."))
 
-(defmethod ig/init-key ::handler
+      (not (yws/upgrade-request? request))
+      (raise (ex/error :type :validation
+                       :code :websocket-request-expected
+                       :hint "this endpoint only accepts websocket connections"))
+
+      :else
+      (do
+        (l/trace :hint "websocket request" :profile-id profile-id :session-id session-id)
+
+        (->> (ws/handler
+              ::ws/on-rcv-message (partial on-rcv-message cfg)
+              ::ws/on-snd-message (partial on-snd-message cfg)
+              ::ws/on-connect (partial on-connect cfg)
+              ::ws/handler (partial handle-message cfg)
+              ::profile-id profile-id
+              ::session-id session-id)
+             (yws/upgrade request)
+             (respond))))))
+
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req [::mbus/msgbus
+                ::mtx/metrics
+                ::db/pool
+                ::session/manager]))
+
+(s/def ::routes vector?)
+
+(defmethod ig/init-key ::routes
   [_ cfg]
-  (fn [{:keys [profile-id params] :as req} respond raise]
-    (let [{:keys [session-id]} (us/conform ::handler-params params)]
-      (cond
-        (not profile-id)
-        (raise (ex/error :type :authentication
-                         :hint "Authentication required."))
-
-        (not (yws/upgrade-request? req))
-        (raise (ex/error :type :validation
-                         :code :websocket-request-expected
-                         :hint "this endpoint only accepts websocket connections"))
-
-        :else
-        (do
-          (l/trace :hint "websocket request" :profile-id profile-id :session-id session-id)
-
-          (->> (ws/handler
-                ::ws/on-rcv-message (partial on-rcv-message cfg)
-                ::ws/on-snd-message (partial on-snd-message cfg)
-                ::ws/on-connect (partial on-connect cfg)
-                ::ws/handler (partial handle-message cfg)
-                ::profile-id profile-id
-                ::session-id session-id)
-               (yws/upgrade req)
-               (respond)))))))
+  ["/ws/notifications" {:middleware [[session/authz cfg]]
+                        :handler (partial http-handler cfg)
+                        :allowed-methods #{:get}}])

backend/src/app/loggers/audit.clj

@@ -159,7 +159,7 @@
       ;; this case we just retry the operation.
       (rtry/with-retry {::rtry/when rtry/conflict-exception?
                         ::rtry/max-retries 6
-                        ::rtry/label "persist-audit-log-event"}
+                        ::rtry/label "persist-audit-log"}
         (let [now (dt/now)]
           (db/insert! pool :audit-log
                       (-> params

backend/src/app/loggers/webhooks.clj

@@ -111,7 +111,7 @@
                               " where id=?")
                          err
                          (:id whook)]
-                    res (db/exec-one! pool sql {:return-keys true})]
+                    res (db/exec-one! pool sql {::db/return-keys? true})]
                 (when (>= (:error-count res) max-errors)
                   (db/update! pool :webhook {:is-active false} {:id (:id whook)})))
 

backend/src/app/main.clj

@@ -12,15 +12,25 @@
    [app.common.logging :as l]
    [app.config :as cf]
    [app.db :as-alias db]
+   [app.http.access-token :as-alias actoken]
+   [app.http.assets :as-alias http.assets]
+   [app.http.awsns :as http.awsns]
    [app.http.client :as-alias http.client]
-   [app.http.session :as-alias http.session]
+   [app.http.debug :as-alias http.debug]
+   [app.http.session :as-alias session]
+   [app.http.session.tasks :as-alias session.tasks]
+   [app.http.websocket :as http.ws]
    [app.loggers.audit :as-alias audit]
    [app.loggers.audit.tasks :as-alias audit.tasks]
    [app.loggers.webhooks :as-alias webhooks]
    [app.loggers.zmq :as-alias lzmq]
    [app.metrics :as-alias mtx]
    [app.metrics.definition :as-alias mdef]
+   [app.msgbus :as-alias mbus]
    [app.redis :as-alias rds]
+   [app.rpc :as-alias rpc]
+   [app.rpc.doc :as-alias rpc.doc]
+   [app.srepl :as-alias srepl]
    [app.storage :as-alias sto]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
@@ -180,6 +190,9 @@
    ::mtx/metrics
    {:default default-metrics}
 
+   ::mtx/routes
+   {::mtx/metrics (ig/ref ::mtx/metrics)}
+
    :app.migrations/all
    {:main (ig/ref :app.migrations/migrations)}
 
@@ -187,7 +200,7 @@
    {::rds/uri     (cf/get :redis-uri)
     ::mtx/metrics (ig/ref ::mtx/metrics)}
 
-   :app.msgbus/msgbus
+   ::mbus/msgbus
    {:backend   (cf/get :msgbus-backend :redis)
     :executor  (ig/ref ::wrk/executor)
     :redis     (ig/ref ::rds/redis)}
@@ -207,16 +220,20 @@
    ::http.client/client
    {::wrk/executor (ig/ref ::wrk/executor)}
 
-   :app.http.session/manager
+   ::session/manager
    {::db/pool      (ig/ref ::db/pool)
     ::wrk/executor (ig/ref ::wrk/executor)
     ::props        (ig/ref :app.setup/props)}
 
-   :app.http.session/gc-task
-   {:pool        (ig/ref ::db/pool)
-    :max-age     (cf/get :auth-token-cookie-max-age)}
+   ::actoken/manager
+   {::db/pool      (ig/ref ::db/pool)
+    ::wrk/executor (ig/ref ::wrk/executor)
+    ::props        (ig/ref :app.setup/props)}
 
-   :app.http.awsns/handler
+   ::session.tasks/gc
+   {::db/pool (ig/ref ::db/pool)}
+
+   ::http.awsns/routes
    {::props              (ig/ref :app.setup/props)
     ::db/pool            (ig/ref ::db/pool)
     ::http.client/client (ig/ref ::http.client/client)
@@ -259,50 +276,44 @@
    {::http.client/client (ig/ref ::http.client/client)}
 
    ::oidc/routes
-   {::http.client/client   (ig/ref ::http.client/client)
-    ::db/pool              (ig/ref ::db/pool)
-    ::props                (ig/ref :app.setup/props)
-    ::wrk/executor         (ig/ref ::wrk/executor)
-    ::oidc/providers       {:google (ig/ref ::oidc.providers/google)
-                            :github (ig/ref ::oidc.providers/github)
-                            :gitlab (ig/ref ::oidc.providers/gitlab)
-                            :oidc   (ig/ref ::oidc.providers/generic)}
-    ::audit/collector      (ig/ref ::audit/collector)
-    ::http.session/session (ig/ref :app.http.session/manager)}
+   {::http.client/client (ig/ref ::http.client/client)
+    ::db/pool            (ig/ref ::db/pool)
+    ::props              (ig/ref :app.setup/props)
+    ::wrk/executor       (ig/ref ::wrk/executor)
+    ::oidc/providers     {:google (ig/ref ::oidc.providers/google)
+                          :github (ig/ref ::oidc.providers/github)
+                          :gitlab (ig/ref ::oidc.providers/gitlab)
+                          :oidc   (ig/ref ::oidc.providers/generic)}
+    ::audit/collector    (ig/ref ::audit/collector)
+    ::session/manager    (ig/ref ::session/manager)}
 
-
-   ;; TODO: revisit the dependencies of this service, looks they are too much unused of them
    :app.http/router
-   {:assets        (ig/ref :app.http.assets/handlers)
-    :feedback      (ig/ref :app.http.feedback/handler)
-    :session       (ig/ref :app.http.session/manager)
-    :awsns-handler (ig/ref :app.http.awsns/handler)
-    :debug-routes  (ig/ref :app.http.debug/routes)
-    :oidc-routes   (ig/ref ::oidc/routes)
-    :ws            (ig/ref :app.http.websocket/handler)
-    :metrics       (ig/ref ::mtx/metrics)
-    :public-uri    (cf/get :public-uri)
-    :storage       (ig/ref ::sto/storage)
-    :rpc-routes    (ig/ref :app.rpc/routes)
-    :doc-routes    (ig/ref :app.rpc.doc/routes)
-    :executor      (ig/ref ::wrk/executor)}
+   {::session/manager    (ig/ref ::session/manager)
+    ::actoken/manager    (ig/ref ::actoken/manager)
+    ::wrk/executor       (ig/ref ::wrk/executor)
+    ::db/pool            (ig/ref ::db/pool)
+    ::rpc/routes         (ig/ref ::rpc/routes)
+    ::rpc.doc/routes     (ig/ref ::rpc.doc/routes)
+    ::props              (ig/ref :app.setup/props)
+    ::mtx/routes         (ig/ref ::mtx/routes)
+    ::oidc/routes        (ig/ref ::oidc/routes)
+    ::http.debug/routes  (ig/ref ::http.debug/routes)
+    ::http.assets/routes (ig/ref ::http.assets/routes)
+    ::http.ws/routes     (ig/ref ::http.ws/routes)
+    ::http.awsns/routes  (ig/ref ::http.awsns/routes)}
 
    :app.http.debug/routes
-   {:pool     (ig/ref ::db/pool)
-    :executor (ig/ref ::wrk/executor)
-    :storage  (ig/ref ::sto/storage)
-    :session  (ig/ref :app.http.session/manager)
+   {::db/pool         (ig/ref ::db/pool)
+    ::wrk/executor    (ig/ref ::wrk/executor)
+    ::session/manager (ig/ref ::session/manager)}
 
-    ::db/pool      (ig/ref ::db/pool)
-    ::wrk/executor (ig/ref ::wrk/executor)
-    ::sto/storage  (ig/ref ::sto/storage)}
+   :app.http.websocket/routes
+   {::db/pool         (ig/ref ::db/pool)
+    ::mtx/metrics     (ig/ref ::mtx/metrics)
+    ::mbus/msgbus     (ig/ref :app.msgbus/msgbus)
+    ::session/manager (ig/ref ::session/manager)}
 
-   :app.http.websocket/handler
-   {:pool     (ig/ref ::db/pool)
-    :metrics  (ig/ref ::mtx/metrics)
-    :msgbus   (ig/ref :app.msgbus/msgbus)}
-
-   :app.http.assets/handlers
+   :app.http.assets/routes
    {:metrics           (ig/ref ::mtx/metrics)
     :assets-path       (cf/get :assets-path)
     :storage           (ig/ref ::sto/storage)
@@ -310,37 +321,32 @@
     :cache-max-age     (dt/duration {:hours 24})
     :signature-max-age (dt/duration {:hours 24 :minutes 5})}
 
-   :app.http.feedback/handler
-   {:pool     (ig/ref ::db/pool)
-    :executor (ig/ref ::wrk/executor)}
-
    :app.rpc/climit
-   {:metrics  (ig/ref ::mtx/metrics)
-    :executor (ig/ref ::wrk/executor)}
+   {::mtx/metrics  (ig/ref ::mtx/metrics)
+    ::wrk/executor (ig/ref ::wrk/executor)}
 
    :app.rpc/rlimit
-   {:executor  (ig/ref ::wrk/executor)
-    :scheduled-executor (ig/ref ::wrk/scheduled-executor)}
+   {::wrk/executor           (ig/ref ::wrk/executor)
+    ::wrk/scheduled-executor (ig/ref ::wrk/scheduled-executor)}
 
    :app.rpc/methods
    {::audit/collector    (ig/ref ::audit/collector)
     ::http.client/client (ig/ref ::http.client/client)
     ::db/pool            (ig/ref ::db/pool)
     ::wrk/executor       (ig/ref ::wrk/executor)
-    ::props              (ig/ref :app.setup/props)
+    ::session/manager    (ig/ref ::session/manager)
     ::ldap/provider      (ig/ref ::ldap/provider)
+    ::sto/storage        (ig/ref ::sto/storage)
+    ::mtx/metrics        (ig/ref ::mtx/metrics)
+    ::mbus/msgbus        (ig/ref ::mbus/msgbus)
+    ::rds/redis          (ig/ref ::rds/redis)
+
+    ::rpc/climit         (ig/ref ::rpc/climit)
+    ::rpc/rlimit         (ig/ref ::rpc/rlimit)
+
+    ::props              (ig/ref :app.setup/props)
+
     :pool                (ig/ref ::db/pool)
-    :session             (ig/ref :app.http.session/manager)
-    :sprops              (ig/ref :app.setup/props)
-    :metrics             (ig/ref ::mtx/metrics)
-    :storage             (ig/ref ::sto/storage)
-    :msgbus              (ig/ref :app.msgbus/msgbus)
-    :public-uri          (cf/get :public-uri)
-    :redis               (ig/ref ::rds/redis)
-    :http-client         (ig/ref ::http.client/client)
-    :climit              (ig/ref :app.rpc/climit)
-    :rlimit              (ig/ref :app.rpc/rlimit)
-    :executor            (ig/ref ::wrk/executor)
     :templates           (ig/ref :app.setup/builtin-templates)
     }
 
@@ -348,7 +354,12 @@
    {:methods (ig/ref :app.rpc/methods)}
 
    :app.rpc/routes
-   {:methods (ig/ref :app.rpc/methods)}
+   {::rpc/methods     (ig/ref :app.rpc/methods)
+    ::db/pool         (ig/ref ::db/pool)
+    ::wrk/executor    (ig/ref ::wrk/executor)
+    ::session/manager (ig/ref ::session/manager)
+    ::actoken/manager (ig/ref ::actoken/manager)
+    ::props           (ig/ref :app.setup/props)}
 
    ::wrk/registry
    {:metrics (ig/ref ::mtx/metrics)
@@ -361,7 +372,7 @@
      :storage-gc-touched (ig/ref ::sto/gc-touched-task)
      :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
      :telemetry          (ig/ref :app.tasks.telemetry/handler)
-     :session-gc         (ig/ref :app.http.session/gc-task)
+     :session-gc         (ig/ref ::session.tasks/gc)
      :audit-log-archive  (ig/ref ::audit.tasks/archive)
      :audit-log-gc       (ig/ref ::audit.tasks/gc)
 
@@ -404,9 +415,13 @@
     ::http.client/client (ig/ref ::http.client/client)
     ::props              (ig/ref :app.setup/props)}
 
-   :app.srepl/server
-   {:port (cf/get :srepl-port)
-    :host (cf/get :srepl-host)}
+   [::srepl/urepl ::srepl/server]
+   {:port (cf/get :urepl-port 6062)
+    :host (cf/get :urepl-host "localhost")}
+
+   [::srepl/prepl ::srepl/server]
+   {:port (cf/get :prepl-port 6063)
+    :host (cf/get :prepl-host "localhost")}
 
    :app.setup/builtin-templates
    {::http.client/client (ig/ref ::http.client/client)}

backend/src/app/metrics.clj

@@ -87,6 +87,7 @@
      ::definitions definitions
      ::registry registry}))
 
+
 (defn- handler
   [registry _ respond _]
   (let [samples  (.metricFamilySamples ^CollectorRegistry registry)
@@ -95,6 +96,18 @@
     (respond {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
               :body (.toString writer)})))
 
+
+
+(s/def ::routes vector?)
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req [::metrics]))
+
+(defmethod ig/init-key ::routes
+  [_ {:keys [::metrics]}]
+  (let [registry (::registry metrics)]
+    ["/metrics" {:handler (partial handler registry)
+                 :allowed-methods #{:get}}]))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/app/migrations.clj

@@ -302,6 +302,12 @@
    {:name "0098-add-quotes-table"
     :fn (mg/resource "app/migrations/sql/0098-add-quotes-table.sql")}
 
+   {:name "0099-add-access-token-table"
+    :fn (mg/resource "app/migrations/sql/0099-add-access-token-table.sql")}
+
+   {:name "0100-mod-profile-indexes"
+    :fn (mg/resource "app/migrations/sql/0100-mod-profile-indexes.sql")}
+
   ])
 
 

backend/src/app/migrations/sql/0099-add-access-token-table.sql

@@ -0,0 +1,19 @@
+DROP TABLE IF EXISTS access_token;
+CREATE TABLE access_token (
+  id uuid NOT NULL DEFAULT uuid_generate_v4() PRIMARY KEY,
+  profile_id uuid NOT NULL REFERENCES profile(id) ON DELETE CASCADE DEFERRABLE,
+
+  created_at timestamptz NOT NULL DEFAULT now(),
+  updated_at timestamptz NOT NULL DEFAULT now(),
+
+  name text NOT NULL,
+  token text NOT NULL,
+  perms text[] NULL
+);
+
+ALTER TABLE access_token
+  ALTER COLUMN name SET STORAGE external,
+  ALTER COLUMN token SET STORAGE external,
+  ALTER COLUMN perms SET STORAGE external;
+
+CREATE INDEX access_token__profile_id__idx ON access_token(profile_id);

backend/src/app/migrations/sql/0100-mod-profile-indexes.sql

@@ -0,0 +1,34 @@
+DROP INDEX profile__email__idx;
+CREATE INDEX profile__email__idx ON profile(email);
+
+ALTER TABLE profile
+  ADD COLUMN default_project_id uuid NULL REFERENCES project(id) ON DELETE SET NULL DEFERRABLE,
+  ADD COLUMN default_team_id uuid NULL REFERENCES team(id) ON DELETE SET NULL DEFERRABLE;
+
+CREATE INDEX profile__default_project__idx ON profile(default_project_id);
+CREATE INDEX profile__default_team__idx ON profile(default_team_id);
+
+with profiles as (
+  select p.id,
+         tpr.team_id as default_team_id,
+         ppr.project_id as default_project_id
+    from profile as p
+    join team_profile_rel as tpr
+      on (tpr.profile_id = p.id and
+          tpr.is_owner is true)
+    join project_profile_rel as ppr
+      on (ppr.profile_id = p.id and
+          ppr.is_owner is true)
+    join project as pj
+      on (pj.id = ppr.project_id)
+    join team as tm
+      on (tm.id = tpr.team_id)
+   where pj.is_default is true
+     and tm.is_default is true
+     and pj.team_id = tm.id
+)
+update profile
+   set default_team_id = p.default_team_id,
+       default_project_id = p.default_project_id
+  from profiles as p
+ where profile.id = p.id;

backend/src/app/redis.clj

@@ -193,6 +193,7 @@
 
 (defn get-or-connect
   [{:keys [::cache] :as state} key options]
+  (us/assert! ::redis state)
   (-> state
       (assoc ::connection
              (or (get @cache key)
@@ -205,7 +206,6 @@
 
 (defn add-listener!
   [{:keys [::connection] :as conn} listener]
-  (us/assert! ::connection-holder conn)
   (us/assert! ::pubsub-connection connection)
   (us/assert! ::pubsub-listener listener)
   (.addListener ^StatefulRedisPubSubConnection @connection
@@ -213,10 +213,9 @@
   conn)
 
 (defn publish!
-  [{:keys [::connection] :as conn} topic message]
+  [{:keys [::connection]} topic message]
   (us/assert! ::us/string topic)
   (us/assert! ::us/bytes message)
-  (us/assert! ::connection-holder conn)
   (us/assert! ::default-connection connection)
 
   (let [pcomm (.async ^StatefulRedisConnection @connection)]
@@ -224,8 +223,7 @@
 
 (defn subscribe!
   "Blocking operation, intended to be used on a thread/agent thread."
-  [{:keys [::connection] :as conn} & topics]
-  (us/assert! ::connection-holder conn)
+  [{:keys [::connection]} & topics]
   (us/assert! ::pubsub-connection connection)
   (try
     (let [topics (into-array String (map str topics))
@@ -236,8 +234,7 @@
 
 (defn unsubscribe!
   "Blocking operation, intended to be used on a thread/agent thread."
-  [{:keys [::connection] :as conn} & topics]
-  (us/assert! ::connection-holder conn)
+  [{:keys [::connection]} & topics]
   (us/assert! ::pubsub-connection connection)
   (try
     (let [topics (into-array String (map str topics))
@@ -247,8 +244,8 @@
       (throw (InterruptedException. (ex-message cause))))))
 
 (defn rpush!
-  [{:keys [::connection] :as conn} key payload]
-  (us/assert! ::connection-holder conn)
+  [{:keys [::connection]} key payload]
+  (us/assert! ::default-connection connection)
   (us/assert! (or (and (vector? payload)
                        (every? bytes? payload))
                   (bytes? payload)))
@@ -270,8 +267,8 @@
       (throw (InterruptedException. (ex-message cause))))))
 
 (defn blpop!
-  [{:keys [::connection] :as conn} timeout & keys]
-  (us/assert! ::connection-holder conn)
+  [{:keys [::connection]} timeout & keys]
+  (us/assert! ::default-connection connection)
   (try
     (let [keys    (into-array Object (map str keys))
           cmd     (.sync ^StatefulRedisConnection @connection)
@@ -286,8 +283,7 @@
       (throw (InterruptedException. (ex-message cause))))))
 
 (defn open?
-  [{:keys [::connection] :as conn}]
-  (us/assert! ::connection-holder conn)
+  [{:keys [::connection]}]
   (us/assert! ::pubsub-connection connection)
   (.isOpen ^StatefulConnection @connection))
 
@@ -335,7 +331,7 @@
 (defn eval!
   [{:keys [::mtx/metrics ::connection] :as state} script]
   (us/assert! ::redis state)
-  (us/assert! ::connection-holder state)
+  (us/assert! ::default-connection connection)
   (us/assert! ::rscript/script script)
 
   (let [cmd   (.async ^StatefulRedisConnection @connection)

backend/src/app/rpc.clj

@@ -12,12 +12,15 @@
    [app.common.logging :as l]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
    [app.http :as-alias http]
+   [app.http.access-token :as-alias actoken]
    [app.http.client :as-alias http.client]
-   [app.http.session :as-alias http.session]
+   [app.http.session :as-alias session]
    [app.loggers.audit :as audit]
    [app.loggers.webhooks :as-alias webhooks]
+   [app.main :as-alias main]
    [app.metrics :as mtx]
    [app.msgbus :as-alias mbus]
    [app.rpc.climit :as climit]
@@ -71,71 +74,78 @@
 (defn- rpc-query-handler
   "Ring handler that dispatches query requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [profile-id session-id path-params params] :as request} respond raise]
-  (let [type   (keyword (:type path-params))
-        data   (-> params
-                   (assoc ::request-at (dt/now))
-                   (assoc ::http/request request))
-        data   (if profile-id
-                 (-> data
-                     (assoc :profile-id profile-id)
-                     (assoc ::profile-id profile-id)
-                     (assoc ::session-id session-id))
-                 (dissoc data :profile-id ::profile-id))
-        method (get methods type default-handler)]
+  [methods {:keys [params path-params] :as request} respond raise]
+  (let [type       (keyword (:type path-params))
+        profile-id (or (::session/profile-id request)
+                       (::actoken/profile-id request))
 
-    (-> (method data)
-        (p/then (partial handle-response request))
-        (p/then respond)
-        (p/catch (fn [cause]
-                   (let [context {:profile-id profile-id}]
-                     (raise (ex/wrap-with-context cause context))))))))
+        data       (-> params
+                       (assoc ::request-at (dt/now))
+                       (assoc ::http/request request))
+        data       (if profile-id
+                     (-> data
+                         (assoc :profile-id profile-id)
+                         (assoc ::profile-id profile-id))
+                     (dissoc data :profile-id ::profile-id))
+        method     (get methods type default-handler)]
+
+    (->> (method data)
+         (p/mcat (partial handle-response request))
+         (p/fnly (fn [response cause]
+                   (if cause
+                     (raise (ex/wrap-with-context cause {:profile-id profile-id}))
+                     (respond response)))))))
 
 (defn- rpc-mutation-handler
   "Ring handler that dispatches mutation requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [profile-id session-id path-params params] :as request} respond raise]
-  (let [type   (keyword (:type path-params))
-        data   (-> params
-                   (assoc ::request-at (dt/now))
-                   (assoc ::http/request request))
-        data   (if profile-id
-                 (-> data
-                     (assoc :profile-id profile-id)
-                     (assoc ::profile-id profile-id)
-                     (assoc ::session-id session-id))
-                 (dissoc data :profile-id ::profile-id))
-        method (get methods type default-handler)]
-    (-> (method data)
-        (p/then (partial handle-response request))
-        (p/then respond)
-        (p/catch (fn [cause]
-                   (let [context {:profile-id profile-id}]
-                     (raise (ex/wrap-with-context cause context))))))))
+  [methods {:keys [params path-params] :as request} respond raise]
+  (let [type       (keyword (:type path-params))
+        profile-id (or (::session/profile-id request)
+                       (::actoken/profile-id request))
+        data       (-> params
+                       (assoc ::request-at (dt/now))
+                       (assoc ::http/request request))
+        data       (if profile-id
+                     (-> data
+                         (assoc :profile-id profile-id)
+                         (assoc ::profile-id profile-id))
+                     (dissoc data :profile-id))
+        method     (get methods type default-handler)]
+
+    (->> (method data)
+         (p/mcat (partial handle-response request))
+         (p/fnly (fn [response cause]
+                   (if cause
+                     (raise (ex/wrap-with-context cause {:profile-id profile-id}))
+                     (respond response)))))))
 
 (defn- rpc-command-handler
   "Ring handler that dispatches cmd requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [profile-id session-id path-params params] :as request} respond raise]
-  (let [cmd    (keyword (:type path-params))
-        etag   (yrq/get-header request "if-none-match")
+  [methods {:keys [params path-params] :as request} respond raise]
+  (let [type       (keyword (:type path-params))
+        etag       (yrq/get-header request "if-none-match")
+        profile-id (or (::session/profile-id request)
+                       (::actoken/profile-id request))
 
-        data   (-> params
-                   (assoc ::request-at (dt/now))
-                   (assoc ::http/request request)
-                   (assoc ::cond/key etag)
-                   (cond-> (uuid? profile-id)
-                     (-> (assoc ::profile-id profile-id)
-                         (assoc ::session-id session-id))))
+        data       (-> params
+                       (assoc ::request-at (dt/now))
+                       (assoc ::session/id (::session/id request))
+                       (assoc ::http/request request)
+                       (assoc ::cond/key etag)
+                       (cond-> (uuid? profile-id)
+                         (assoc ::profile-id profile-id)))
+
+        method    (get methods type default-handler)]
 
-        method (get methods cmd default-handler)]
     (binding [cond/*enabled* true]
-      (-> (method data)
-          (p/then (partial handle-response request))
-          (p/then respond)
-          (p/catch (fn [cause]
-                     (let [context {:profile-id profile-id}]
-                       (raise (ex/wrap-with-context cause context)))))))))
+      (->> (method data)
+           (p/mcat (partial handle-response request))
+           (p/fnly (fn [response cause]
+                     (if cause
+                       (raise (ex/wrap-with-context cause {:profile-id profile-id}))
+                       (respond response))))))))
 
 (defn- wrap-metrics
   "Wrap service method with metrics measurement."
@@ -143,18 +153,46 @@
   (let [labels (into-array String [(::sv/name mdata)])]
     (fn [cfg params]
       (let [tp (dt/tpoint)]
-        (p/finally
-          (f cfg params)
-          (fn [_ _]
-            (mtx/run! metrics
-                      :id metrics-id
-                      :val (inst-ms (tp))
-                      :labels labels)))))))
+        (->> (f cfg params)
+             (p/fnly (fn [_ _]
+                       (mtx/run! metrics
+                                 :id metrics-id
+                                 :val (inst-ms (tp))
+                                 :labels labels))))))))
+
+
+(defn- wrap-authentication
+  [_ f {:keys [::auth] :as mdata}]
+  (fn [cfg params]
+    (let [profile-id (::profile-id params)]
+      (if (and auth (not (uuid? profile-id)))
+        (p/rejected
+         (ex/error :type :authentication
+                   :code :authentication-required
+                   :hint "authentication required for this endpoint"))
+        (f cfg params)))))
+
+(defn- wrap-access-token
+  "Wraps service method with access token validation."
+  [_ f {:keys [::sv/name] :as mdata}]
+  (if (contains? cf/flags :access-tokens)
+    (fn [cfg params]
+      (let [request (::http/request params)]
+        (if (contains? request ::actoken/id)
+          (let [perms (::actoken/perms request #{})]
+            (if (contains? perms name)
+              (f cfg params)
+              (p/rejected
+               (ex/error :type :authorization
+                         :code :operation-not-allowed
+                         :allowed perms))))
+          (f cfg params))))
+    f))
 
 (defn- wrap-dispatch
   "Wraps service method into async flow, with the ability to dispatching
   it to a preconfigured executor service."
-  [{:keys [executor] :as cfg} f mdata]
+  [{:keys [::wrk/executor] :as cfg} f mdata]
   (with-meta
     (fn [cfg params]
       (->> (px/submit! executor (px/wrap-bindings #(f cfg params)))
@@ -222,37 +260,34 @@
         f))
     f))
 
+(defn- wrap-spec-conform
+  [_ f mdata]
+  (let [spec (or (::sv/spec mdata) (s/spec any?))]
+    (fn [cfg params]
+      (let [params (ex/try! (us/conform spec params))]
+        (if (ex/exception? params)
+          (p/rejected params)
+          (f cfg params))))))
+
+(defn- wrap-all
+  [cfg f mdata]
+  (as-> f $
+    (wrap-dispatch cfg $ mdata)
+    (wrap-metrics cfg $ mdata)
+    (cond/wrap cfg $ mdata)
+    (retry/wrap-retry cfg $ mdata)
+    (climit/wrap cfg $ mdata)
+    (rlimit/wrap cfg $ mdata)
+    (wrap-audit cfg $ mdata)
+    (wrap-spec-conform cfg $ mdata)
+    (wrap-authentication cfg $ mdata)
+    (wrap-access-token cfg $ mdata)))
+
 (defn- wrap
   [cfg f mdata]
-  (let [f     (as-> f $
-                (wrap-dispatch cfg $ mdata)
-                (cond/wrap cfg $ mdata)
-                (retry/wrap-retry cfg $ mdata)
-                (wrap-metrics cfg $ mdata)
-                (climit/wrap cfg $ mdata)
-                (rlimit/wrap cfg $ mdata)
-                (wrap-audit cfg $ mdata))
-
-        spec  (or (::sv/spec mdata) (s/spec any?))
-        auth? (::auth mdata true)]
-
-
-    (l/debug :hint "register method" :name (::sv/name mdata))
-    (with-meta
-      (fn [params]
-        ;; Raise authentication error when rpc method requires auth but
-        ;; no profile-id is found in the request.
-        (let [profile-id (if (= "command" (::type cfg))
-                           (::profile-id params)
-                           (:profile-id params))]
-          (p/do!
-           (if (and auth? (not (uuid? profile-id)))
-             (ex/raise :type :authentication
-                       :code :authentication-required
-                       :hint "authentication required for this endpoint")
-             (let [params (us/conform spec params)]
-               (f cfg params))))))
-      mdata)))
+  (l/debug :hint "register method" :name (::sv/name mdata))
+  (let [f (wrap-all cfg f mdata)]
+    (with-meta #(f cfg %) mdata)))
 
 (defn- process-method
   [cfg vfn]
@@ -263,74 +298,70 @@
 (defn- resolve-query-methods
   [cfg]
   (let [cfg (assoc cfg ::type "query" ::metrics-id :rpc-query-timing)]
-    (->> (sv/scan-ns 'app.rpc.queries.projects
-                     'app.rpc.queries.files
-                     'app.rpc.queries.teams
-                     'app.rpc.queries.profile
-                     'app.rpc.queries.viewer
-                     'app.rpc.queries.fonts)
+    (->> (sv/scan-ns
+          'app.rpc.queries.projects
+          'app.rpc.queries.profile
+          'app.rpc.queries.viewer
+          'app.rpc.queries.fonts)
          (map (partial process-method cfg))
          (into {}))))
 
 (defn- resolve-mutation-methods
   [cfg]
   (let [cfg (assoc cfg ::type "mutation" ::metrics-id :rpc-mutation-timing)]
-    (->> (sv/scan-ns 'app.rpc.mutations.media
-                     'app.rpc.mutations.profile
-                     'app.rpc.mutations.files
-                     'app.rpc.mutations.projects
-                     'app.rpc.mutations.teams
-                     'app.rpc.mutations.fonts
-                     'app.rpc.mutations.share-link)
+    (->> (sv/scan-ns
+          'app.rpc.mutations.media
+          'app.rpc.mutations.profile
+          'app.rpc.mutations.projects
+          'app.rpc.mutations.fonts
+          'app.rpc.mutations.share-link)
          (map (partial process-method cfg))
          (into {}))))
 
 (defn- resolve-command-methods
   [cfg]
   (let [cfg (assoc cfg ::type "command" ::metrics-id :rpc-command-timing)]
-    (->> (sv/scan-ns 'app.rpc.commands.binfile
-                     'app.rpc.commands.comments
-                     'app.rpc.commands.management
-                     'app.rpc.commands.verify-token
-                     'app.rpc.commands.search
-                     'app.rpc.commands.media
-                     'app.rpc.commands.teams
-                     'app.rpc.commands.auth
-                     'app.rpc.commands.ldap
-                     'app.rpc.commands.demo
-                     'app.rpc.commands.webhooks
-                     'app.rpc.commands.audit
-                     'app.rpc.commands.files
-                     'app.rpc.commands.files.update
-                     'app.rpc.commands.files.create
-                     'app.rpc.commands.files.temp)
+    (->> (sv/scan-ns
+          'app.rpc.commands.access-token
+          'app.rpc.commands.audit
+          'app.rpc.commands.auth
+          'app.rpc.commands.feedback
+          'app.rpc.commands.fonts
+          'app.rpc.commands.binfile
+          'app.rpc.commands.comments
+          'app.rpc.commands.demo
+          'app.rpc.commands.files
+          'app.rpc.commands.files-create
+          'app.rpc.commands.files-share
+          'app.rpc.commands.files-temp
+          'app.rpc.commands.files-update
+          'app.rpc.commands.ldap
+          'app.rpc.commands.management
+          'app.rpc.commands.media
+          'app.rpc.commands.profile
+          'app.rpc.commands.projects
+          'app.rpc.commands.search
+          'app.rpc.commands.teams
+          'app.rpc.commands.verify-token
+          'app.rpc.commands.viewer
+          'app.rpc.commands.webhooks)
          (map (partial process-method cfg))
          (into {}))))
 
-(s/def ::ldap (s/nilable map?))
-(s/def ::msgbus ::mbus/msgbus)
-(s/def ::climit (s/nilable ::climit/climit))
-(s/def ::rlimit (s/nilable ::rlimit/rlimit))
-
-(s/def ::public-uri ::us/not-empty-string)
-(s/def ::sprops map?)
-
 (defmethod ig/pre-init-spec ::methods [_]
   (s/keys :req [::audit/collector
+                ::session/manager
                 ::http.client/client
                 ::db/pool
+                ::mbus/msgbus
                 ::ldap/provider
+                ::sto/storage
+                ::mtx/metrics
+                ::main/props
                 ::wrk/executor]
-          :req-un [::sto/storage
-                   ::http.session/session
-                   ::sprops
-                   ::public-uri
-                   ::msgbus
-                   ::rlimit
-                   ::climit
-                   ::wrk/executor
-                   ::mtx/metrics
-                   ::db/pool]))
+          :opt [::climit
+                ::rlimit]
+          :req-un [::db/pool]))
 
 (defmethod ig/init-key ::methods
   [_ cfg]
@@ -352,12 +383,20 @@
                    ::queries
                    ::commands]))
 
+(s/def ::routes vector?)
+
 (defmethod ig/pre-init-spec ::routes [_]
-  (s/keys :req-un [::methods]))
+  (s/keys :req [::methods
+                ::db/pool
+                ::main/props
+                ::wrk/executor
+                ::session/manager
+                ::actoken/manager]))
 
 (defmethod ig/init-key ::routes
-  [_ {:keys [methods] :as cfg}]
-  [["/rpc"
+  [_ {:keys [::methods] :as cfg}]
+  [["/rpc" {:middleware [[session/authz cfg]
+                         [actoken/authz cfg]]}
     ["/command/:type" {:handler (partial rpc-command-handler (:commands methods))}]
     ["/query/:type" {:handler (partial rpc-query-handler (:queries methods))}]
     ["/mutation/:type" {:handler (partial rpc-mutation-handler (:mutations methods))

backend/src/app/rpc/climit.clj

@@ -46,7 +46,7 @@
                    (p/rejected
                     (ex/error :type :internal
                               :code :concurrency-limit-reached
-                              :queue (-> limiter meta :bkey name)
+                              :queue (-> limiter meta ::bkey name)
                               :cause cause))
 
                    (some? cause)
@@ -56,7 +56,7 @@
                    (p/resolved result))))))
 
 (defn- create-limiter
-  [{:keys [executor metrics concurrency queue-size bkey skey]}]
+  [{:keys [::wrk/executor ::mtx/metrics ::bkey ::skey concurrency queue-size]}]
   (let [labels   (into-array String [(name bkey)])
         on-queue (fn [instance]
                    (l/trace :hint "enqueued"
@@ -100,10 +100,10 @@
                   :on-run on-run}]
 
     (-> (pxb/create options)
-        (vary-meta assoc :bkey bkey :skey skey))))
+        (vary-meta assoc ::bkey bkey ::skey skey))))
 
 (defn- create-cache
-  [{:keys [executor] :as params} config]
+  [{:keys [::wrk/executor] :as params} config]
   (let [listener (reify RemovalListener
                    (onRemoval [_ key _val cause]
                      (l/trace :hint "cache: remove" :key key :reason (str cause))))
@@ -113,8 +113,8 @@
                      (let [[bkey skey] key]
                        (when-let [config (get config bkey)]
                          (-> (merge params config)
-                             (assoc :bkey bkey)
-                             (assoc :skey skey)
+                             (assoc ::bkey bkey)
+                             (assoc ::skey skey)
                              (create-limiter))))))]
 
   (.. (Caffeine/newBuilder)
@@ -134,14 +134,16 @@
 
 (defmethod ig/prep-key ::rpc/climit
   [_ cfg]
-  (merge {:path (cf/get :rpc-climit-config)}
+  (merge {::path (cf/get :rpc-climit-config)}
          (d/without-nils cfg)))
 
+(s/def ::path ::fs/path)
+
 (defmethod ig/pre-init-spec ::rpc/climit [_]
-  (s/keys :req-un [::wrk/executor ::mtx/metrics ::fs/path]))
+  (s/keys :req [::wrk/executor ::mtx/metrics ::path]))
 
 (defmethod ig/init-key ::rpc/climit
-  [_ {:keys [path] :as params}]
+  [_ {:keys [::path] :as params}]
   (when (contains? cf/flags :rpc-climit)
     (if-let [config (some->> path slurp edn/read-string)]
       (do
@@ -163,7 +165,8 @@
       (l/warn :hint "unable to load configuration" :config (str path)))))
 
 
-(s/def ::climit #(satisfies? IConcurrencyManager %))
+(s/def ::rpc/climit
+  (s/nilable #(satisfies? IConcurrencyManager %)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; PUBLIC API
@@ -176,7 +179,7 @@
      (p/wrap (do ~@body))))
 
 (defn wrap
-  [{:keys [climit]} f {:keys [::queue ::key-fn] :as mdata}]
+  [{:keys [::rpc/climit]} f {:keys [::queue ::key-fn] :as mdata}]
   (if (and (some? climit)
            (some? queue))
     (if-let [config (get @climit queue)]
@@ -192,7 +195,6 @@
             (let [key [queue (key-fn params)]
                   lim (get climit key)]
               (invoke! lim (partial f cfg params))))
-
           (let [lim (get climit queue)]
             (fn [cfg params]
               (invoke! lim (partial f cfg params))))))

backend/src/app/rpc/commands/access_token.clj

@@ -0,0 +1,87 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.commands.access-token
+  (:require
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.main :as-alias main]
+   [app.rpc :as-alias rpc]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.quotes :as quotes]
+   [app.tokens :as tokens]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]))
+
+(defn- decode-row
+  [{:keys [perms] :as row}]
+  (cond-> row
+    (db/pgarray? perms "text")
+    (assoc :perms (db/decode-pgarray perms #{}))))
+
+(defn- create-access-token
+  [{:keys [::conn ::main/props]} profile-id name perms]
+  (let [created-at (dt/now)
+        token-id   (uuid/next)
+        token      (tokens/generate props {:iss "access-token"
+                                           :tid token-id
+                                           :iat created-at})]
+    (db/insert! conn :access-token
+                {:id token-id
+                 :name name
+                 :token token
+                 :profile-id profile-id
+                 :created-at created-at
+                 :updated-at created-at
+                 :perms (db/create-array conn "text" perms)})))
+
+(defn repl-create-access-token
+  [{:keys [::db/pool] :as system} profile-id name perms]
+  (db/with-atomic [conn pool]
+    (let [props (:app.setup/props system)]
+      (create-access-token {::conn conn ::main/props props}
+                           profile-id
+                           name
+                           perms))))
+
+(s/def ::name ::us/not-empty-string)
+(s/def ::perms ::us/set-of-strings)
+
+(s/def ::create-access-token
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::name ::perms]))
+
+(sv/defmethod ::create-access-token
+  {::doc/added "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id name perms]}]
+  (db/with-atomic [conn pool]
+    (let [cfg (assoc cfg ::conn conn)]
+      (quotes/check-quote! conn
+                           {::quotes/id ::quotes/access-tokens-per-profile
+                            ::quotes/profile-id profile-id})
+      (-> (create-access-token cfg profile-id name perms)
+          (decode-row)))))
+
+(s/def ::delete-access-token
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::us/id]))
+
+(sv/defmethod ::delete-access-token
+  {::doc/added "1.18"}
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id id]}]
+  (db/delete! pool :access-token {:id id :profile-id profile-id})
+  nil)
+
+(s/def ::get-access-tokens
+  (s/keys :req [::rpc/profile-id]))
+
+(sv/defmethod ::get-access-tokens
+  {::doc/added "1.18"}
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
+  (->> (db/query pool :access-token {:profile-id profile-id})
+       (mapv decode-row)))

backend/src/app/rpc/commands/audit.clj

@@ -42,7 +42,7 @@
    :profile-id :ip-addr :props :context])
 
 (defn- handle-events
-  [{:keys [::db/pool]} {:keys [::rpc/profile-id events ::http/request] :as params}]
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id events ::http/request]}]
   (let [ip-addr (audit/parse-client-ip request)
         xform   (comp
                  (map #(assoc % :profile-id profile-id))

backend/src/app/rpc/commands/auth.clj

@@ -19,10 +19,10 @@
    [app.main :as-alias main]
    [app.rpc :as-alias rpc]
    [app.rpc.climit :as climit]
+   [app.rpc.commands.profile :as profile]
    [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.rpc.queries.profile :as profile]
    [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -52,24 +52,10 @@
                             (str/split #"@" 2))]
       (contains? domains candidate))))
 
-(def ^:private sql:profile-existence
-  "select exists (select * from profile
-                   where email = ?
-                     and deleted_at is null) as val")
-
-(defn check-profile-existence!
-  [conn {:keys [email] :as params}]
-  (let [email  (str/lower email)
-        result (db/exec-one! conn [sql:profile-existence email])]
-    (when (:val result)
-      (ex/raise :type :validation
-                :code :email-already-exists))
-    params))
-
 ;; ---- COMMAND: login with password
 
 (defn login-with-password
-  [{:keys [::db/pool session] :as cfg} {:keys [email password] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [email password] :as params}]
 
   (when-not (or (contains? cf/flags :login)
                 (contains? cf/flags :login-with-password))
@@ -105,11 +91,10 @@
             profile)]
 
     (db/with-atomic [conn pool]
-      (let [profile    (->> (profile/retrieve-profile-data-by-email conn email)
+      (let [profile    (->> (profile/get-profile-by-email conn email)
                             (validate-profile)
-                            (profile/strip-private-attrs)
-                            (profile/populate-additional-data conn)
-                            (profile/decode-profile-row))
+                            (profile/decode-row)
+                            (profile/strip-private-attrs))
 
             invitation (when-let [token (:invitation-token params)]
                          (tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))
@@ -122,14 +107,13 @@
                          (assoc profile :is-admin (let [admins (cf/get :admins)]
                                                     (contains? admins (:email profile)))))]
         (-> response
-            (rph/with-transform (session/create-fn session (:id profile)))
+            (rph/with-transform (session/create-fn cfg (:id profile)))
             (rph/with-meta {::audit/props (audit/profile->props profile)
                             ::audit/profile-id (:id profile)}))))))
 
-(s/def ::scope ::us/string)
 (s/def ::login-with-password
   (s/keys :req-un [::email ::password]
-          :opt-un [::invitation-token ::scope]))
+          :opt-un [::invitation-token]))
 
 (sv/defmethod ::login-with-password
   "Performs authentication using penpot password."
@@ -148,8 +132,8 @@
   "Clears the authentication cookie and logout the current session."
   {::rpc/auth false
    ::doc/added "1.15"}
-  [{:keys [session] :as cfg} _]
-  (rph/with-transform {} (session/delete-fn session)))
+  [cfg _]
+  (rph/with-transform {} (session/delete-fn cfg)))
 
 ;; ---- COMMAND: Recover Profile
 
@@ -226,7 +210,7 @@
 
   (validate-register-attempt! cfg params)
 
-  (let [profile (when-let [profile (profile/retrieve-profile-data-by-email pool (:email params))]
+  (let [profile (when-let [profile (profile/get-profile-by-email pool (:email params))]
                   (cond
                     (:is-blocked profile)
                     (ex/raise :type :restriction
@@ -267,10 +251,11 @@
 
 ;; ---- COMMAND: Register Profile
 
-(defn create-profile
+(defn create-profile!
   "Create the profile entry on the database with limited set of input
   attrs (all the other attrs are filled with default values)."
-  [conn params]
+  [conn {:keys [email] :as params}]
+  (us/assert! ::us/email email)
   (let [id        (or (:id params) (uuid/next))
         props     (-> (audit/extract-utm-params params)
                       (merge (:props params))
@@ -291,7 +276,7 @@
         is-demo   (:is-demo params false)
         is-muted  (:is-muted params false)
         is-active (:is-active params false)
-        email     (str/lower (:email params))
+        email     (str/lower email)
 
         params    {:id id
                    :fullname (:fullname params)
@@ -306,7 +291,7 @@
                    :is-demo is-demo}]
     (try
       (-> (db/insert! conn :profile params)
-          (profile/decode-profile-row))
+          (profile/decode-row))
       (catch org.postgresql.util.PSQLException e
         (let [state (.getSQLState e)]
           (if (not= state "23505")
@@ -315,15 +300,17 @@
                       :code :email-already-exists
                       :cause e)))))))
 
-(defn create-profile-relations
-  [conn profile]
-  (let [team (teams/create-team conn {:profile-id (:id profile)
+(defn create-profile-rels!
+  [conn {:keys [id] :as profile}]
+  (let [team (teams/create-team conn {:profile-id id
                                       :name "Default"
                                       :is-default true})]
-    (-> profile
-        (profile/strip-private-attrs)
-        (assoc :default-team-id (:id team))
-        (assoc :default-project-id (:default-project-id team)))))
+    (-> (db/update! conn :profile
+                    {:default-team-id (:id team)
+                     :default-project-id  (:default-project-id team)}
+                    {:id id})
+        (profile/decode-row))))
+
 
 (defn send-email-verification!
   [conn props profile]
@@ -347,22 +334,18 @@
                 :extra-data ptoken})))
 
 (defn register-profile
-  [{:keys [conn session] :as cfg} {:keys [token] :as params}]
+  [{:keys [conn] :as cfg} {:keys [token] :as params}]
   (let [claims     (tokens/verify (::main/props cfg) {:token token :iss :prepared-register})
         params     (merge params claims)
 
         is-active  (or (:is-active params)
-                       (not (contains? cf/flags :email-verification))
-
-                       ;; DEPRECATED: v1.15
-                       (contains? cf/flags :insecure-register))
+                       (not (contains? cf/flags :email-verification)))
 
         profile    (if-let [profile-id (:profile-id claims)]
-                     (profile/retrieve-profile conn profile-id)
-                     (->> (assoc params :is-active is-active)
-                          (create-profile conn)
-                          (create-profile-relations conn)
-                          (profile/decode-profile-row)))
+                     (profile/get-profile conn profile-id)
+                     (->> (create-profile! conn (assoc params :is-active is-active))
+                          (create-profile-rels! conn)))
+
         invitation (when-let [token (:invitation-token params)]
                      (tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))]
 
@@ -389,7 +372,7 @@
             token  (tokens/generate (::main/props cfg) claims)
             resp   {:invitation-token token}]
         (-> resp
-            (rph/with-transform (session/create-fn session (:id profile)))
+            (rph/with-transform (session/create-fn cfg (:id profile)))
             (rph/with-meta {::audit/replace-props (audit/profile->props profile)
                             ::audit/profile-id (:id profile)})))
 
@@ -398,7 +381,7 @@
       ;; we need to mark this session as logged.
       (not= "penpot" (:auth-backend profile))
       (-> (profile/strip-private-attrs profile)
-          (rph/with-transform (session/create-fn session (:id profile)))
+          (rph/with-transform (session/create-fn cfg (:id profile)))
           (rph/with-meta {::audit/replace-props (audit/profile->props profile)
                           ::audit/profile-id (:id profile)}))
 
@@ -406,7 +389,7 @@
       ;; to sign in the user directly, without email verification.
       (true? is-active)
       (-> (profile/strip-private-attrs profile)
-          (rph/with-transform (session/create-fn session (:id profile)))
+          (rph/with-transform (session/create-fn cfg (:id profile)))
           (rph/with-meta {::audit/replace-props (audit/profile->props profile)
                           ::audit/profile-id (:id profile)}))
 
@@ -448,7 +431,7 @@
                                            :exp (dt/in-future {:days 30})})]
               (eml/send! {::eml/conn conn
                           ::eml/factory eml/password-recovery
-                          :public-uri (:public-uri cfg)
+                          :public-uri (cf/get :public-uri)
                           :to (:email profile)
                           :token (:token profile)
                           :name (:fullname profile)
@@ -456,7 +439,7 @@
               nil))]
 
     (db/with-atomic [conn pool]
-      (when-let [profile (profile/retrieve-profile-data-by-email conn email)]
+      (when-let [profile (profile/get-profile-by-email conn email)]
         (when-not (eml/allow-send-emails? conn profile)
           (ex/raise :type :validation
                     :code :profile-is-muted

backend/src/app/rpc/commands/binfile.clj

@@ -9,6 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.files.features :as ffeat]
    [app.common.logging :as l]
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
@@ -20,14 +21,15 @@
    [app.media :as media]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
+   [app.rpc.commands.projects :as projects]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.rpc.queries.projects :as projects]
    [app.storage :as sto]
    [app.storage.tmp :as tmp]
    [app.tasks.file-gc]
    [app.util.blob :as blob]
    [app.util.fressian :as fres]
+   [app.util.objects-map :as omap]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -436,9 +438,8 @@
 (s/def ::embed-assets? (s/nilable ::us/boolean))
 
 (s/def ::write-export-options
-  (s/keys :req-un [::db/pool ::sto/storage]
-          :req    [::output ::file-ids]
-          :opt    [::include-libraries? ::embed-assets?]))
+  (s/keys :req [::db/pool ::sto/storage ::output ::file-ids]
+          :opt [::include-libraries? ::embed-assets?]))
 
 (defn write-export!
   "Do the exportation of a specified file in custom penpot binary
@@ -475,7 +476,7 @@
               [:v1/metadata :v1/files :v1/rels :v1/sobjects])))))
 
 (defmethod write-section :v1/metadata
-  [{:keys [pool ::output ::file-ids ::include-libraries?]}]
+  [{:keys [::db/pool ::output ::file-ids ::include-libraries?]}]
   (let [libs  (when include-libraries?
                 (retrieve-libraries pool file-ids))
         files (into file-ids libs)]
@@ -483,7 +484,7 @@
     (vswap! *state* assoc :files files)))
 
 (defmethod write-section :v1/files
-  [{:keys [pool ::output ::embed-assets?]}]
+  [{:keys [::db/pool ::output ::embed-assets?]}]
 
   ;; Initialize SIDS with empty vector
   (vswap! *state* assoc :sids [])
@@ -507,7 +508,7 @@
       (vswap! *state* update :sids into storage-object-id-xf media))))
 
 (defmethod write-section :v1/rels
-  [{:keys [pool  ::output ::include-libraries?]}]
+  [{:keys [::db/pool ::output ::include-libraries?]}]
   (let [rels  (when include-libraries?
                 (retrieve-library-relations pool (-> *state* deref :files)))]
     (l/debug :hint "found rels" :total (count rels) ::l/async false)
@@ -555,9 +556,8 @@
 (s/def ::ignore-index-errors? (s/nilable ::us/boolean))
 
 (s/def ::read-import-options
-  (s/keys :req-un [::db/pool ::sto/storage]
-          :req    [::project-id ::input]
-          :opt    [::overwrite? ::migrate? ::ignore-index-errors?]))
+  (s/keys :req [::db/pool ::sto/storage ::project-id ::input]
+          :opt [::overwrite? ::migrate? ::ignore-index-errors?]))
 
 (defn read-import!
   "Do the importation of the specified resource in penpot custom binary
@@ -580,7 +580,7 @@
     (read-import (assoc options ::version version ::timestamp timestamp))))
 
 (defmethod read-import :v1
-  [{:keys [pool ::input] :as options}]
+  [{:keys [::db/pool ::input] :as options}]
   (with-open [input (zstd-input-stream input)]
     (with-open [input (io/data-input-stream input)]
       (db/with-atomic [conn pool]
@@ -609,12 +609,23 @@
     (vswap! *state* update :index update-index files)
     (vswap! *state* assoc :version version :files files)))
 
+(defn- postprocess-file
+  [data]
+  (let [omap-wrap ffeat/*wrap-with-objects-map-fn*
+        pmap-wrap ffeat/*wrap-with-pointer-map-fn*]
+    (-> data
+        (update :pages-index update-vals #(update % :objects omap-wrap))
+        (update :pages-index update-vals pmap-wrap)
+        (update :components update-vals #(update % :objects omap-wrap))
+        (update :components pmap-wrap))))
+
 (defmethod read-section :v1/files
   [{:keys [conn ::input ::migrate? ::project-id ::timestamp ::overwrite?]}]
   (doseq [expected-file-id (-> *state* deref :files)]
-    (let [file    (read-obj! input)
-          media'  (read-obj! input)
-          file-id (:id file)]
+    (let [file     (read-obj! input)
+          media'   (read-obj! input)
+          file-id  (:id file)
+          features files/default-features]
 
       (when (not= file-id expected-file-id)
         (ex/raise :type :validation
@@ -629,33 +640,42 @@
       (l/debug :hint "update media references" ::l/async false)
       (vswap! *state* update :media into (map #(update % :id lookup-index)) media')
 
-      (l/debug :hint "processing file" :file-id file-id ::l/async false)
+      (l/debug :hint "processing file" :file-id file-id ::features features ::l/async false)
 
-      (let [file-id' (lookup-index file-id)
-            data     (-> (:data file)
-                         (assoc :id file-id')
-                         (cond-> migrate? (pmg/migrate-data))
-                         (update :pages-index relink-shapes)
-                         (update :components relink-shapes)
-                         (update :media relink-media))
+      (binding [ffeat/*current* features
+                ffeat/*wrap-with-objects-map-fn* (if (features "storage/objects-map") omap/wrap identity)
+                ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)
+                pmap/*tracked* (atom {})]
 
-            params  {:id file-id'
-                     :project-id project-id
-                     :name (:name file)
-                     :revn (:revn file)
-                     :is-shared (:is-shared file)
-                     :data (blob/encode data)
-                     :created-at timestamp
-                     :modified-at timestamp}]
+        (let [file-id' (lookup-index file-id)
+              data     (-> (:data file)
+                           (assoc :id file-id')
+                           (cond-> migrate? (pmg/migrate-data))
+                           (update :pages-index relink-shapes)
+                           (update :components relink-shapes)
+                           (update :media relink-media)
+                           (postprocess-file))
 
-        (l/debug :hint "create file" :id file-id' ::l/async false)
+              params  {:id file-id'
+                       :project-id project-id
+                       :features (db/create-array conn "text" features)
+                       :name (:name file)
+                       :revn (:revn file)
+                       :is-shared (:is-shared file)
+                       :data (blob/encode data)
+                       :created-at timestamp
+                       :modified-at timestamp}]
 
-        (if overwrite?
-          (create-or-update-file conn params)
-          (db/insert! conn :file params))
+          (l/debug :hint "create file" :id file-id' ::l/async false)
 
-        (when overwrite?
-          (db/delete! conn :file-thumbnail {:file-id file-id'}))))))
+          (if overwrite?
+            (create-or-update-file conn params)
+            (db/insert! conn :file params))
+
+          (files/persist-pointers! conn file-id')
+
+          (when overwrite?
+            (db/delete! conn :file-thumbnail {:file-id file-id'})))))))
 
 (defmethod read-section :v1/rels
   [{:keys [conn ::input ::timestamp]}]
@@ -673,7 +693,7 @@
         (db/insert! conn :file-library-rel rel)))))
 
 (defmethod read-section :v1/sobjects
-  [{:keys [storage conn ::input ::overwrite?]}]
+  [{:keys [::sto/storage conn ::input ::overwrite?]}]
   (let [storage (media/configure-assets-storage storage)
         ids     (read-obj! input)]
 
@@ -871,13 +891,14 @@
 (s/def ::embed-assets? ::us/boolean)
 
 (s/def ::export-binfile
-  (s/keys :req [::rpc/profile-id] :req-un [::file-id ::include-libraries? ::embed-assets?]))
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::file-id ::include-libraries? ::embed-assets?]))
 
 (sv/defmethod ::export-binfile
   "Export a penpot file in a binary format."
   {::doc/added "1.15"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id include-libraries? embed-assets?] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id include-libraries? embed-assets?] :as params}]
   (files/check-read-permissions! pool profile-id file-id)
   (let [body (reify yrs/StreamableResponseBody
                (-write-body-to-stream [_ _ output-stream]
@@ -892,13 +913,14 @@
 
 (s/def ::file ::media/upload)
 (s/def ::import-binfile
-  (s/keys :req [::rpc/profile-id] :req-un [::project-id ::file]))
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::project-id ::file]))
 
 (sv/defmethod ::import-binfile
   "Import a penpot file in a binary format."
   {::doc/added "1.15"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id file] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id file] :as params}]
   (db/with-atomic [conn pool]
     (projects/check-read-permissions! conn profile-id project-id)
     (let [ids (import! (assoc cfg

backend/src/app/rpc/commands/comments.clj

@@ -54,8 +54,8 @@
                 :hint "file not found"))))
 
 (defn- get-comment-thread
-  [conn thread-id & {:keys [for-update?]}]
-  (-> (db/get-by-id conn :comment-thread thread-id {:for-update for-update?})
+  [conn thread-id & {:as opts}]
+  (-> (db/get-by-id conn :comment-thread thread-id opts)
       (decode-row)))
 
 (defn- get-comment
@@ -100,7 +100,7 @@
 
 (sv/defmethod ::get-comment-threads
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id share-id] :as params}]
   (with-open [conn (db/open pool)]
     (files/check-comment-permissions! conn profile-id file-id share-id)
     (get-comment-threads conn profile-id file-id)))
@@ -143,7 +143,7 @@
 
 (sv/defmethod ::get-unread-comment-threads
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
   (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
     (get-unread-comment-threads conn profile-id team-id)))
@@ -190,7 +190,7 @@
 
 (sv/defmethod ::get-comment-thread
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id id share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id id share-id] :as params}]
   (with-open [conn (db/open pool)]
     (files/check-comment-permissions! conn profile-id file-id share-id)
     (let [sql (str "with threads as (" sql:comment-threads ")"
@@ -210,7 +210,7 @@
 
 (sv/defmethod ::get-comments
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id thread-id share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id thread-id share-id] :as params}]
   (with-open [conn (db/open pool)]
     (let [{:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
       (files/check-comment-permissions! conn profile-id file-id share-id)
@@ -262,7 +262,7 @@
   participants on comment threads of the file."
   {::doc/added "1.15"
    ::doc/changes ["1.15" "Imported from queries and renamed."]}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id share-id]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id share-id]}]
   (with-open [conn (db/open pool)]
     (files/check-comment-permissions! conn profile-id file-id share-id)
     (get-file-comments-users conn file-id profile-id)))
@@ -372,9 +372,9 @@
 
 (sv/defmethod ::update-comment-thread-status
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)]
+    (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
       (files/check-comment-permissions! conn profile-id file-id share-id)
       (upsert-comment-thread-status! conn profile-id id))))
 
@@ -389,9 +389,9 @@
 
 (sv/defmethod ::update-comment-thread
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id is-resolved share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id is-resolved share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)]
+    (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
       (files/check-comment-permissions! conn profile-id file-id share-id)
       (db/update! conn :comment-thread
                   {:is-resolved is-resolved}
@@ -412,9 +412,9 @@
 (sv/defmethod ::create-comment
   {::doc/added "1.15"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id :for-update? true)
+    (let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id ::db/for-update? true)
           {:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
 
       (files/check-comment-permissions! conn profile-id (:id file) share-id)
@@ -465,10 +465,10 @@
 
 (sv/defmethod ::update-comment
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id share-id content] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id share-id content] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [thread-id] :as comment} (get-comment conn id :for-update? true)
-          {:keys [file-id page-id owner-id] :as thread} (get-comment-thread conn thread-id :for-update? true)]
+    (let [{:keys [thread-id] :as comment} (get-comment conn id ::db/for-update? true)
+          {:keys [file-id page-id owner-id] :as thread} (get-comment-thread conn thread-id ::db/for-update? true)]
 
       (files/check-comment-permissions! conn profile-id file-id share-id)
 
@@ -498,9 +498,9 @@
 
 (sv/defmethod ::delete-comment-thread
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id :for-update? true)]
+    (let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
       (files/check-comment-permissions! conn profile-id file-id share-id)
       (when-not (= owner-id profile-id)
         (ex/raise :type :validation
@@ -518,9 +518,9 @@
 
 (sv/defmethod ::delete-comment
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [owner-id thread-id] :as comment} (get-comment conn id :for-update? true)
+    (let [{:keys [owner-id thread-id] :as comment} (get-comment conn id ::db/for-update? true)
           {:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
       (files/check-comment-permissions! conn profile-id file-id share-id)
       (when-not (= owner-id profile-id)
@@ -538,9 +538,9 @@
 
 (sv/defmethod ::update-comment-thread-position
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id position frame-id share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id position frame-id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)]
+    (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
       (files/check-comment-permissions! conn profile-id file-id share-id)
       (db/update! conn :comment-thread
                   {:modified-at (::rpc/request-at params)
@@ -558,9 +558,9 @@
 
 (sv/defmethod ::update-comment-thread-frame
   {::doc/added "1.15"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id frame-id share-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id frame-id share-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)]
+    (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::db/for-update? true)]
       (files/check-comment-permissions! conn profile-id file-id share-id)
       (db/update! conn :comment-thread
                   {:modified-at (::rpc/request-at params)

backend/src/app/rpc/commands/demo.clj

@@ -8,12 +8,11 @@
   "A demo specific mutations."
   (:require
    [app.common.exceptions :as ex]
-   [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.loggers.audit :as audit]
    [app.rpc :as-alias rpc]
-   [app.rpc.commands.auth :as cmd.auth]
+   [app.rpc.commands.auth :as auth]
    [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -30,32 +29,31 @@
   {::rpc/auth false
    ::doc/added "1.15"
    ::doc/changes ["1.15" "This method is migrated from mutations to commands."]}
-  [{:keys [pool] :as cfg} _]
-  (let [id       (uuid/next)
-        sem      (System/currentTimeMillis)
+  [{:keys [::db/pool] :as cfg} _]
+
+  (when-not (contains? cf/flags :demo-users)
+    (ex/raise :type :validation
+              :code :demo-users-not-allowed
+              :hint "Demo users are disabled by config."))
+
+  (let [sem      (System/currentTimeMillis)
         email    (str "demo-" sem ".demo@example.com")
         fullname (str "Demo User " sem)
+
         password (-> (bn/random-bytes 16)
                      (bc/bytes->b64u)
                      (bc/bytes->str))
-        params   {:id id
-                  :email email
+
+        params   {:email email
                   :fullname fullname
                   :is-active true
                   :deleted-at (dt/in-future cf/deletion-delay)
                   :password password
-                  :props {}
-                  }]
-
-    (when-not (contains? cf/flags :demo-users)
-      (ex/raise :type :validation
-                :code :demo-users-not-allowed
-                :hint "Demo users are disabled by config."))
+                  :props {}}]
 
     (db/with-atomic [conn pool]
-      (->> (cmd.auth/create-profile conn params)
-           (cmd.auth/create-profile-relations conn))
-
-      (with-meta {:email email
-                  :password password}
-        {::audit/profile-id id}))))
+      (let [profile (->> (auth/create-profile! conn params)
+                         (auth/create-profile-rels! conn))]
+        (with-meta {:email email
+                    :password password}
+          {::audit/profile-id (:id profile)})))))

backend/src/app/rpc/commands/feedback.clj

@@ -0,0 +1,56 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.commands.feedback
+  "A general purpose feedback module."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.emails :as eml]
+   [app.rpc :as-alias rpc]
+   [app.rpc.commands.profile :as profile]
+   [app.rpc.doc :as-alias doc]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+(declare ^:private send-feedback!)
+
+(s/def ::content ::us/string)
+(s/def ::from    ::us/email)
+(s/def ::subject ::us/string)
+
+(s/def ::send-user-feedback
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::subject
+                   ::content]))
+
+(sv/defmethod ::send-user-feedback
+  {::doc/added "1.18"}
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id] :as params}]
+  (when-not (contains? cf/flags :user-feedback)
+    (ex/raise :type :restriction
+              :code :feedback-disabled
+              :hint "feedback not enabled"))
+
+  (let [profile (profile/get-profile pool profile-id)]
+    (send-feedback! pool profile params)
+    nil))
+
+(defn- send-feedback!
+  [pool profile params]
+  (let [dest (cf/get :feedback-destination)]
+    (eml/send! {::eml/conn pool
+                ::eml/factory eml/feedback
+                :from     dest
+                :to       dest
+                :profile  profile
+                :reply-to (:email profile)
+                :email    (:email profile)
+                :subject  (:subject params)
+                :content  (:content params)})
+    nil))

backend/src/app/rpc/commands/files.clj

@@ -15,19 +15,19 @@
    [app.common.spec :as us]
    [app.common.types.file :as ctf]
    [app.common.types.shape-tree :as ctt]
+   [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files.thumbnails :as-alias thumbs]
+   [app.rpc.commands.projects :as projects]
    [app.rpc.commands.teams :as teams]
    [app.rpc.cond :as-alias cond]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
    [app.rpc.permissions :as perms]
-   [app.rpc.queries.projects :as projects]
-   [app.rpc.queries.share-link :refer [retrieve-share-link]]
    [app.util.blob :as blob]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
@@ -43,7 +43,13 @@
     "storage/pointer-map"
     "components/v2"})
 
-(def default-features #{})
+(def default-features
+  (cond-> #{}
+    (contains? cf/flags :feature-storage-pointer-map)
+    (conj "storage/pointer-map")
+
+    (contains? cf/flags :feature-storage-objects-map)
+    (conj "storage/objects-map")))
 
 ;; --- SPECS
 
@@ -121,7 +127,9 @@
 
   ([conn profile-id file-id share-id]
    (let [perms  (get-permissions conn profile-id file-id)
-         ldata  (retrieve-share-link conn file-id share-id)]
+         ldata  (some-> (db/get* conn :share-link {:id share-id :file-id file-id})
+                        (dissoc :flags)
+                        (update :pages db/decode-pgarray #{}))]
 
      ;; NOTE: in a future when share-link becomes more powerful and
      ;; will allow us specify which parts of the app is available, we
@@ -189,7 +197,7 @@
   (let [row (db/get conn :file-data-fragment
                     {:id id :file-id file-id}
                     {:columns [:content]
-                     :check-deleted? false})]
+                     ::db/check-deleted? false})]
     (blob/decode (:content row))))
 
 (defn persist-pointers!
@@ -251,7 +259,7 @@
         (handle-file-features client-features))))
 
 (defn get-minimal-file
-  [{:keys [pool] :as cfg} id]
+  [{:keys [::db/pool] :as cfg} id]
   (db/get pool :file {:id id} {:columns [:id :modified-at :revn]}))
 
 (defn get-file-etag
@@ -268,7 +276,7 @@
   {::doc/added "1.17"
    ::cond/get-object #(get-minimal-file %1 (:id %2))
    ::cond/key-fn get-file-etag}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id features]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id features]}]
   (with-open [conn (db/open pool)]
     (let [perms (get-permissions conn profile-id id)]
       (check-read-permissions! perms)
@@ -296,7 +304,7 @@
   "Retrieve a file by its ID. Only authenticated users."
   {::doc/added "1.17"
    ::rpc/:auth false}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] }]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] }]
   (with-open [conn (db/open pool)]
     (let [perms (get-permissions conn profile-id file-id share-id)]
       (check-read-permissions! perms)
@@ -332,7 +340,7 @@
    ::cond/get-object #(get-minimal-file %1 (:file-id %2))
    ::cond/reuse-key? true
    ::cond/key-fn get-file-etag}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-object-thumbnails conn file-id)))
@@ -363,7 +371,7 @@
 (sv/defmethod ::get-project-files
   "Get all files for the specified project."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id]}]
   (with-open [conn (db/open pool)]
     (projects/check-read-permissions! conn profile-id project-id)
     (get-project-files conn project-id)))
@@ -382,7 +390,7 @@
 (sv/defmethod ::has-file-libraries
   "Checks if the file has libraries. Returns a boolean"
   {::doc/added "1.15.1"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! pool profile-id file-id)
     (get-has-file-libraries conn file-id)))
@@ -449,7 +457,7 @@
 
   Mainly used for rendering purposes."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-page conn params)))
@@ -501,7 +509,7 @@
 (sv/defmethod ::get-team-shared-files
   "Get all file (libraries) for the specified team."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
   (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
     (get-team-shared-files conn team-id)))
@@ -555,7 +563,7 @@
 (sv/defmethod ::get-file-libraries
   "Get libraries used by the specified file."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id features]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id features]}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-file-libraries conn file-id features)))
@@ -581,7 +589,7 @@
 (sv/defmethod ::get-library-file-references
   "Returns all the file references that use specified file (library) id."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-library-file-references conn file-id)))
@@ -618,7 +626,7 @@
 
 (sv/defmethod ::get-team-recent-files
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
   (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
     (get-team-recent-files conn team-id)))
@@ -652,7 +660,7 @@
 
 (sv/defmethod ::get-file-thumbnail
   {::doc/added "1.17"}
-  [{:keys [pool]} {:keys [::rpc/profile-id file-id revn]}]
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id file-id revn]}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (-> (get-file-thumbnail conn file-id revn)
@@ -748,7 +756,7 @@
   "Retrieves the data for generate the thumbnail of the file. Used
   mainly for render thumbnails on dashboard."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as props}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as props}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     ;; NOTE: we force here the "storage/pointer-map" feature, because
@@ -780,7 +788,7 @@
 (sv/defmethod ::rename-file
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
     (let [file (rename-file conn params)]
@@ -811,7 +819,7 @@
       (let [ldata (-> library decode-row pmg/migrate-file :data)]
         (->> (db/query conn :file-library-rel {:library-file-id id})
              (map :file-id)
-             (keep #(db/get-by-id conn :file % {:check-deleted? false}))
+             (keep #(db/get-by-id conn :file % ::db/check-deleted? false))
              (map decode-row)
              (map pmg/migrate-file)
              (run! (fn [{:keys [id data revn] :as file}]
@@ -829,7 +837,7 @@
 (sv/defmethod ::set-file-shared
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id is-shared] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id is-shared] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
     (when-not is-shared
@@ -858,7 +866,7 @@
 (sv/defmethod ::delete-file
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
     (absorb-library conn params)
@@ -888,7 +896,7 @@
 (sv/defmethod ::link-file-to-library
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id library-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id library-id] :as params}]
   (when (= file-id library-id)
     (ex/raise :type :validation
               :code :invalid-library
@@ -913,7 +921,7 @@
 (sv/defmethod ::unlink-file-from-library
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (unlink-file-from-library conn params)))
@@ -937,7 +945,7 @@
 (sv/defmethod ::update-file-library-sync-status
   "Update the synchronization statos of a file->library link"
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (update-sync conn params)))
@@ -959,7 +967,7 @@
 (sv/defmethod ::ignore-file-library-sync-status
   "Ignore updates in linked files"
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (->  (ignore-sync conn params)
@@ -989,7 +997,7 @@
 
 (sv/defmethod ::upsert-file-object-thumbnail
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (upsert-file-object-thumbnail! conn params)
@@ -1019,7 +1027,7 @@
   "Creates or updates the file thumbnail. Mainly used for paint the
   grid thumbnails."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (upsert-file-thumbnail conn params)

backend/src/app/rpc/commands/files_create.clj

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.rpc.commands.files.create
+(ns app.rpc.commands.files-create
   (:require
    [app.common.data :as d]
    [app.common.files.features :as ffeat]
@@ -15,9 +15,9 @@
    [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
+   [app.rpc.commands.projects :as projects]
    [app.rpc.doc :as-alias doc]
    [app.rpc.permissions :as perms]
-   [app.rpc.queries.projects :as proj]
    [app.rpc.quotes :as quotes]
    [app.util.blob :as blob]
    [app.util.objects-map :as omap]
@@ -80,9 +80,9 @@
 (sv/defmethod ::create-file
   {::doc/added "1.17"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
   (db/with-atomic [conn pool]
-    (proj/check-edition-permissions! conn profile-id project-id)
+    (projects/check-edition-permissions! conn profile-id project-id)
     (let [team-id (files/get-team-id conn project-id)
           params  (assoc params :profile-id profile-id)]
 

backend/src/app/rpc/commands/files_share.clj

@@ -0,0 +1,71 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.commands.files-share
+  "Share link related rpc mutation methods."
+  (:require
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.rpc :as-alias rpc]
+   [app.rpc.commands.files :as files]
+   [app.rpc.doc :as-alias doc]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+;; --- Helpers & Specs
+
+(s/def ::file-id ::us/uuid)
+(s/def ::who-comment ::us/string)
+(s/def ::who-inspect ::us/string)
+(s/def ::pages (s/every ::us/uuid :kind set?))
+
+;; --- MUTATION: Create Share Link
+
+(declare create-share-link)
+
+(s/def ::create-share-link
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::file-id ::who-comment ::who-inspect ::pages]))
+
+(sv/defmethod ::create-share-link
+  "Creates a share-link object.
+
+  Share links are resources that allows external users access to specific
+  pages of a file with specific permissions (who-comment and who-inspect)."
+  {::doc/added "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (files/check-edition-permissions! conn profile-id file-id)
+    (create-share-link conn (assoc params :profile-id profile-id))))
+
+(defn create-share-link
+  [conn {:keys [profile-id file-id pages who-comment who-inspect]}]
+  (let [pages (db/create-array conn "uuid" pages)
+        slink (db/insert! conn :share-link
+                          {:id (uuid/next)
+                           :file-id file-id
+                           :who-comment who-comment
+                           :who-inspect who-inspect
+                           :pages pages
+                           :owner-id profile-id})]
+
+    (update slink :pages db/decode-pgarray #{})))
+
+;; --- MUTATION: Delete Share Link
+
+(s/def ::delete-share-link
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::us/id]))
+
+(sv/defmethod ::delete-share-link
+  {::doc/added "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [slink (db/get-by-id conn :share-link id)]
+      (files/check-edition-permissions! conn profile-id (:file-id slink))
+      (db/delete! conn :share-link {:id id})
+      nil)))

backend/src/app/rpc/commands/files_temp.clj

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.rpc.commands.files.temp
+(ns app.rpc.commands.files-temp
   (:require
    [app.common.exceptions :as ex]
    [app.common.pages :as cp]
@@ -13,10 +13,10 @@
    [app.db :as db]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.files.create :as files.create]
-   [app.rpc.commands.files.update :as files.update]
+   [app.rpc.commands.files-create :refer [create-file]]
+   [app.rpc.commands.files-update :as-alias files.update]
+   [app.rpc.commands.projects :as projects]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.queries.projects :as proj]
    [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -37,15 +37,15 @@
 
 (sv/defmethod ::create-temp-file
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
   (db/with-atomic [conn pool]
-    (proj/check-edition-permissions! conn profile-id project-id)
-    (files.create/create-file conn (assoc params :profile-id profile-id :deleted-at (dt/in-future {:days 1})))))
+    (projects/check-edition-permissions! conn profile-id project-id)
+    (create-file conn (assoc params :profile-id profile-id :deleted-at (dt/in-future {:days 1})))))
 
 ;; --- MUTATION COMMAND: update-temp-file
 
 (defn update-temp-file
-  [conn {:keys [::rpc/profile-id session-id id revn changes] :as params}]
+  [conn {:keys [profile-id session-id id revn changes] :as params}]
   (db/insert! conn :file-change
               {:id (uuid/next)
                :session-id session-id
@@ -57,16 +57,17 @@
                :changes (blob/encode changes)}))
 
 (s/def ::update-temp-file
-  (s/keys :req-un [::files.update/changes
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::files.update/changes
                    ::files.update/revn
                    ::files.update/session-id
                    ::files/id]))
 
 (sv/defmethod ::update-temp-file
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} params]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (update-temp-file conn params)
+    (update-temp-file conn (assoc params :profile-id profile-id))
     nil))
 
 ;; --- MUTATION COMMAND: persist-temp-file
@@ -101,7 +102,7 @@
 
 (sv/defmethod ::persist-temp-file
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
     (persist-temp-file conn params)))

backend/src/app/rpc/commands/files_update.clj

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.rpc.commands.files.update
+(ns app.rpc.commands.files-update
   (:require
    [app.common.exceptions :as ex]
    [app.common.files.features :as ffeat]
@@ -132,7 +132,7 @@
    ::webhooks/batch-timeout (dt/duration "2m")
    ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
    ::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
     (db/xact-lock! conn id)
@@ -145,7 +145,7 @@
                              (l/trace :hint "update-file" :time (dt/format-duration elapsed))))))))
 
 (defn update-file
-  [{:keys [conn metrics] :as cfg} {:keys [profile-id id changes changes-with-metadata] :as params}]
+  [{:keys [conn ::mtx/metrics] :as cfg} {:keys [profile-id id changes changes-with-metadata] :as params}]
   (let [file     (get-file conn id)
         features (->> (concat (:features file)
                               (:features params))
@@ -275,7 +275,7 @@
 (defn- send-notifications!
   [{:keys [conn] :as cfg} {:keys [file changes session-id] :as params}]
   (let [lchanges (filter library-change? changes)
-        msgbus   (:msgbus cfg)]
+        msgbus   (::mbus/msgbus cfg)]
 
     ;; Asynchronously publish message to the msgbus
     (mbus/pub! msgbus

backend/src/app/rpc/commands/fonts.clj

@@ -0,0 +1,237 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.commands.fonts
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.loggers.audit :as-alias audit]
+   [app.loggers.webhooks :as-alias webhooks]
+   [app.media :as media]
+   [app.rpc :as-alias rpc]
+   [app.rpc.climit :as-alias climit]
+   [app.rpc.commands.files :as files]
+   [app.rpc.commands.projects :as projects]
+   [app.rpc.commands.teams :as teams]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.helpers :as rph]
+   [app.rpc.quotes :as quotes]
+   [app.storage :as sto]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [app.worker :as-alias wrk]
+   [clojure.spec.alpha :as s]
+   [promesa.core :as p]
+   [promesa.exec :as px]))
+
+(def valid-weight #{100 200 300 400 500 600 700 800 900 950})
+(def valid-style #{"normal" "italic"})
+
+(s/def ::data (s/map-of ::us/string any?))
+(s/def ::file-id ::us/uuid)
+(s/def ::font-id ::us/uuid)
+(s/def ::id ::us/uuid)
+(s/def ::name ::us/not-empty-string)
+(s/def ::project-id ::us/uuid)
+(s/def ::style valid-style)
+(s/def ::team-id ::us/uuid)
+(s/def ::team-id ::us/uuid)
+(s/def ::weight valid-weight)
+
+;; --- QUERY: Get font variants
+
+(s/def ::get-font-variants
+  (s/and
+   (s/keys :req [::rpc/profile-id]
+           :opt-un [::team-id
+                    ::file-id
+                    ::project-id])
+   (fn [o]
+     (or (contains? o :team-id)
+         (contains? o :file-id)
+         (contains? o :project-id)))))
+
+(sv/defmethod ::get-font-variants
+  {::doc/added "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id project-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (cond
+      (uuid? team-id)
+      (do
+        (teams/check-read-permissions! conn profile-id team-id)
+        (db/query conn :team-font-variant
+                  {:team-id team-id
+                   :deleted-at nil}))
+
+      (uuid? project-id)
+      (let [project (db/get-by-id conn :project project-id {:columns [:id :team-id]})]
+        (projects/check-read-permissions! conn profile-id project-id)
+        (db/query conn :team-font-variant
+                  {:team-id (:team-id project)
+                   :deleted-at nil}))
+
+      (uuid? file-id)
+      (let [file    (db/get-by-id conn :file file-id {:columns [:id :project-id]})
+            project (db/get-by-id conn :project (:project-id file) {:columns [:id :team-id]})]
+        (files/check-read-permissions! conn profile-id file-id)
+        (db/query conn :team-font-variant
+                  {:team-id (:team-id project)
+                   :deleted-at nil})))))
+
+
+(declare create-font-variant)
+
+(s/def ::create-font-variant
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::team-id
+                   ::data
+                   ::font-id
+                   ::font-family
+                   ::font-weight
+                   ::font-style]))
+
+(sv/defmethod ::create-font-variant
+  {::doc/added "1.18"
+   ::webhooks/event? true}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
+    (teams/check-edition-permissions! pool profile-id team-id)
+    (quotes/check-quote! pool {::quotes/id ::quotes/font-variants-per-team
+                               ::quotes/profile-id profile-id
+                               ::quotes/team-id team-id})
+    (create-font-variant cfg (assoc params :profile-id profile-id))))
+
+(defn create-font-variant
+  [{:keys [::sto/storage ::db/pool ::wrk/executor ::rpc/climit]} {:keys [data] :as params}]
+  (letfn [(generate-fonts [data]
+            (climit/with-dispatch (:process-font climit)
+              (media/run {:cmd :generate-fonts :input data})))
+
+          ;; Function responsible of calculating cryptographyc hash of
+          ;; the provided data.
+          (calculate-hash [data]
+            (px/with-dispatch executor
+              (sto/calculate-hash data)))
+
+          (validate-data [data]
+            (when (and (not (contains? data "font/otf"))
+                       (not (contains? data "font/ttf"))
+                       (not (contains? data "font/woff"))
+                       (not (contains? data "font/woff2")))
+              (ex/raise :type :validation
+                        :code :invalid-font-upload))
+            data)
+
+          (persist-font-object [data mtype]
+            (when-let [resource (get data mtype)]
+              (p/let [hash    (calculate-hash resource)
+                      content (-> (sto/content resource)
+                                  (sto/wrap-with-hash hash))]
+                (sto/put-object! storage {::sto/content content
+                                          ::sto/touched-at (dt/now)
+                                          ::sto/deduplicate? true
+                                          :content-type mtype
+                                          :bucket "team-font-variant"}))))
+
+          (persist-fonts [data]
+            (p/let [otf   (persist-font-object data "font/otf")
+                    ttf   (persist-font-object data "font/ttf")
+                    woff1 (persist-font-object data "font/woff")
+                    woff2 (persist-font-object data "font/woff2")]
+
+              (d/without-nils
+               {:otf otf
+                :ttf ttf
+                :woff1 woff1
+                :woff2 woff2})))
+
+          (insert-into-db [{:keys [woff1 woff2 otf ttf]}]
+            (db/insert! pool :team-font-variant
+                        {:id (uuid/next)
+                         :team-id (:team-id params)
+                         :font-id (:font-id params)
+                         :font-family (:font-family params)
+                         :font-weight (:font-weight params)
+                         :font-style (:font-style params)
+                         :woff1-file-id (:id woff1)
+                         :woff2-file-id (:id woff2)
+                         :otf-file-id (:id otf)
+                         :ttf-file-id (:id ttf)}))
+          ]
+
+    (->> (generate-fonts data)
+         (p/fmap validate-data)
+         (p/mcat executor persist-fonts)
+         (p/fmap executor insert-into-db)
+         (p/fmap (fn [result]
+                   (let [params (update params :data (comp vec keys))]
+                     (rph/with-meta result {::audit/replace-props params})))))))
+
+;; --- UPDATE FONT FAMILY
+
+(s/def ::update-font
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::team-id ::id ::name]))
+
+(sv/defmethod ::update-font
+  {::doc/added "1.18"
+   ::webhooks/event? true}
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id team-id id name]}]
+  (db/with-atomic [conn pool]
+    (teams/check-edition-permissions! conn profile-id team-id)
+    (rph/with-meta
+      (db/update! conn :team-font-variant
+                  {:font-family name}
+                  {:font-id id
+                   :team-id team-id})
+      {::audit/replace-props {:id id
+                              :name name
+                              :team-id team-id
+                              :profile-id profile-id}})))
+
+;; --- DELETE FONT
+
+(s/def ::delete-font
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::team-id ::id]))
+
+(sv/defmethod ::delete-font
+  {::doc/added "1.18"
+   ::webhooks/event? true}
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id id team-id]}]
+  (db/with-atomic [conn pool]
+    (teams/check-edition-permissions! conn profile-id team-id)
+    (let [font (db/update! conn :team-font-variant
+                           {:deleted-at (dt/now)}
+                           {:font-id id :team-id team-id})]
+      (rph/with-meta (rph/wrap)
+        {::audit/props {:id id
+                        :team-id team-id
+                        :name (:font-family font)
+                        :profile-id profile-id}}))))
+
+;; --- DELETE FONT VARIANT
+
+(s/def ::delete-font-variant
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::team-id ::id]))
+
+(sv/defmethod ::delete-font-variant
+  {::doc/added "1.18"
+   ::webhooks/event? true}
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id id team-id]}]
+  (db/with-atomic [conn pool]
+    (teams/check-edition-permissions! conn profile-id team-id)
+    (let [variant (db/update! conn :team-font-variant
+                              {:deleted-at (dt/now)}
+                              {:id id :team-id team-id})]
+      (rph/with-meta (rph/wrap)
+        {::audit/props {:font-family (:font-family variant)
+                        :font-id (:font-id variant)}}))))
+

backend/src/app/rpc/commands/ldap.clj

@@ -14,10 +14,10 @@
    [app.loggers.audit :as-alias audit]
    [app.main :as-alias main]
    [app.rpc :as-alias rpc]
-   [app.rpc.commands.auth :as cmd.auth]
+   [app.rpc.commands.auth :as auth]
+   [app.rpc.commands.profile :as profile]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.rpc.queries.profile :as profile]
    [app.tokens :as tokens]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
@@ -39,7 +39,7 @@
   is properly configured and enabled with `login-with-ldap` flag."
   {::rpc/auth false
    ::doc/added "1.15"}
-  [{:keys [::main/props ::ldap/provider session] :as cfg} params]
+  [{:keys [::main/props ::ldap/provider] :as cfg} params]
   (when-not provider
     (ex/raise :type :restriction
               :code :ldap-not-initialized
@@ -67,24 +67,23 @@
                             :member-email (:email profile))
               token  (tokens/generate props claims)]
           (-> {:invitation-token token}
-              (rph/with-transform (session/create-fn session (:id profile)))
+              (rph/with-transform (session/create-fn cfg (:id profile)))
               (rph/with-meta {::audit/props (:props profile)
                               ::audit/profile-id (:id profile)})))
 
         (-> profile
-            (rph/with-transform (session/create-fn session (:id profile)))
+            (rph/with-transform (session/create-fn cfg (:id profile)))
             (rph/with-meta {::audit/props (:props profile)
                             ::audit/profile-id (:id profile)}))))))
 
 (defn- login-or-register
-  [{:keys [pool] :as cfg} info]
+  [{:keys [::db/pool] :as cfg} info]
   (db/with-atomic [conn pool]
     (or (some->> (:email info)
-                 (profile/retrieve-profile-data-by-email conn)
-                 (profile/populate-additional-data conn)
-                 (profile/decode-profile-row))
+                 (profile/get-profile-by-email conn)
+                 (profile/decode-row))
         (->> (assoc info :is-active true :is-demo false)
-             (cmd.auth/create-profile conn)
-             (cmd.auth/create-profile-relations conn)
+             (auth/create-profile! conn)
+             (auth/create-profile-rels! conn)
              (profile/strip-private-attrs)))))
 

backend/src/app/rpc/commands/management.clj

@@ -17,9 +17,9 @@
    [app.rpc :as-alias rpc]
    [app.rpc.commands.binfile :as binfile]
    [app.rpc.commands.files :as files]
+   [app.rpc.commands.projects :as proj]
    [app.rpc.commands.teams :as teams :refer [create-project-role create-project]]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.queries.projects :as proj]
    [app.util.blob :as blob]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
@@ -46,7 +46,7 @@
   "Duplicate a single file in the same team."
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
     (duplicate-file conn (assoc params :profile-id profile-id))))
 
@@ -221,7 +221,7 @@
   "Duplicate an entire project with all the files"
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} params]
+  [{:keys [::db/pool] :as cfg} params]
   (db/with-atomic [conn pool]
     (duplicate-project conn (assoc params :profile-id (::rpc/profile-id params)))))
 
@@ -329,7 +329,7 @@
   "Move a set of files from one project to other."
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
     (move-files conn (assoc params :profile-id profile-id))))
 
@@ -369,7 +369,7 @@
   "Move projects between teams."
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
     (move-project conn (assoc params :profile-id profile-id))))
 
@@ -386,7 +386,7 @@
   "Clone into the specified project the template by its id."
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
     (-> (assoc cfg :conn conn)
         (clone-template (assoc params :profile-id profile-id)))))

backend/src/app/rpc/commands/media.clj

@@ -23,6 +23,7 @@
    [app.storage.tmp :as tmp]
    [app.util.services :as sv]
    [app.util.time :as dt]
+   [app.worker :as-alias wrk]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.io :as io]
@@ -66,8 +67,8 @@
 
 (sv/defmethod ::upload-file-media-object
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
-  (let [cfg (update cfg :storage media/configure-assets-storage)]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
     (files/check-edition-permissions! pool profile-id file-id)
     (media/validate-media-type! content)
     (validate-content-size! content)
@@ -110,7 +111,7 @@
 ;; inverse, soft referential integrity).
 
 (defn create-file-media-object
-  [{:keys [storage pool climit executor]}
+  [{:keys [::sto/storage ::db/pool climit ::wrk/executor]}
    {:keys [id file-id is-local name content]}]
   (letfn [;; Function responsible to retrieve the file information, as
           ;; it is synchronous operation it should be wrapped into
@@ -186,8 +187,8 @@
 
 (sv/defmethod ::create-file-media-object-from-url
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
-  (let [cfg (update cfg :storage media/configure-assets-storage)]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
     (files/check-edition-permissions! pool profile-id file-id)
     (create-file-media-object-from-url cfg params)))
 
@@ -253,7 +254,7 @@
 
 (sv/defmethod ::clone-file-media-object
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (-> (assoc cfg :conn conn)

backend/src/app/rpc/commands/profile.clj

@@ -0,0 +1,424 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.commands.profile
+  (:require
+   [app.auth :as auth]
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.emails :as eml]
+   [app.http.session :as session]
+   [app.loggers.audit :as audit]
+   [app.main :as-alias main]
+   [app.media :as media]
+   [app.rpc :as-alias rpc]
+   [app.rpc.climit :as climit]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.helpers :as rph]
+   [app.storage :as sto]
+   [app.tokens :as tokens]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [app.worker :as-alias wrk]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [promesa.core :as p]
+   [promesa.exec :as px]))
+
+(declare decode-row)
+(declare get-profile)
+(declare strip-private-attrs)
+(declare filter-props)
+(declare check-profile-existence!)
+
+;; --- QUERY: Get profile (own)
+
+(s/def ::get-profile
+  (s/keys :opt [::rpc/profile-id]))
+
+(sv/defmethod ::get-profile
+  {::rpc/auth false
+   ::doc/added "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id]}]
+  ;; We need to return the anonymous profile object in two cases, when
+  ;; no profile-id is in session, and when db call raises not found. In all other
+  ;; cases we need to reraise the exception.
+  (try
+    (-> (get-profile pool profile-id)
+        (strip-private-attrs)
+        (update :props filter-props))
+    (catch Throwable _
+      {:id uuid/zero :fullname "Anonymous User"})))
+
+(defn get-profile
+  "Get profile by id. Throws not-found exception if no profile found."
+  [conn id & {:as attrs}]
+  (-> (db/get-by-id conn :profile id attrs)
+      (decode-row)))
+
+
+;; --- MUTATION: Update Profile (own)
+
+(s/def ::email ::us/email)
+(s/def ::fullname ::us/not-empty-string)
+(s/def ::lang ::us/string)
+(s/def ::theme ::us/string)
+
+(s/def ::update-profile
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::fullname]
+          :opt-un [::lang ::theme]))
+
+(sv/defmethod ::update-profile
+  {::doc/added "1.0"}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id fullname lang theme] :as params}]
+  (db/with-atomic [conn pool]
+    ;; NOTE: we need to retrieve the profile independently if we use
+    ;; it or not for explicit locking and avoid concurrent updates of
+    ;; the same row/object.
+    (let [profile (-> (db/get-by-id conn :profile profile-id ::db/for-update? true)
+                      (decode-row))
+
+          ;; Update the profile map with direct params
+          profile (-> profile
+                      (assoc :fullname fullname)
+                      (assoc :lang lang)
+                      (assoc :theme theme))
+          ]
+
+      (db/update! conn :profile
+                  {:fullname fullname
+                   :lang lang
+                   :theme theme
+                   :props (db/tjson (:props profile))}
+                  {:id profile-id})
+
+      (-> profile
+          (strip-private-attrs)
+          (d/without-nils)
+          (rph/with-meta {::audit/props (audit/profile->props profile)})))))
+
+
+;; --- MUTATION: Update Password
+
+(declare validate-password!)
+(declare update-profile-password!)
+(declare invalidate-profile-session!)
+
+(s/def ::password ::us/not-empty-string)
+(s/def ::old-password ::us/not-empty-string)
+
+(s/def ::update-profile-password
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::password ::old-password]))
+
+(sv/defmethod ::update-profile-password
+  {::climit/queue :auth}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id password] :as params}]
+  (db/with-atomic [conn pool]
+    (let [profile    (validate-password! conn (assoc params :profile-id profile-id))
+          session-id (::session/id params)]
+
+      (when (= (str/lower (:email profile))
+               (str/lower (:password params)))
+        (ex/raise :type :validation
+                  :code :email-as-password
+                  :hint "you can't use your email as password"))
+
+      (update-profile-password! conn (assoc profile :password password))
+      (invalidate-profile-session! conn profile-id session-id)
+      nil)))
+
+(defn- invalidate-profile-session!
+  "Removes all sessions except the current one."
+  [conn profile-id session-id]
+  (let [sql "delete from http_session where profile_id = ? and id != ?"]
+    (:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id]))))
+
+(defn- validate-password!
+  [conn {:keys [profile-id old-password] :as params}]
+  (let [profile (db/get-by-id conn :profile profile-id ::db/for-update? true)]
+    (when-not (:valid (auth/verify-password old-password (:password profile)))
+      (ex/raise :type :validation
+                :code :old-password-not-match))
+    profile))
+
+(defn update-profile-password!
+  [conn {:keys [id password] :as profile}]
+  (db/update! conn :profile
+              {:password (auth/derive-password password)}
+              {:id id}))
+
+;; --- MUTATION: Update Photo
+
+(declare upload-photo)
+(declare update-profile-photo)
+
+(s/def ::file ::media/upload)
+(s/def ::update-profile-photo
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::file]))
+
+(sv/defmethod ::update-profile-photo
+  [cfg {:keys [::rpc/profile-id file] :as params}]
+  ;; Validate incoming mime type
+  (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
+    (update-profile-photo cfg (assoc params :profile-id profile-id))))
+
+;; TODO: reimplement it without p/let
+
+(defn update-profile-photo
+  [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id file] :as params}]
+  (letfn [(on-uploaded [photo]
+            (let [profile (db/get-by-id pool :profile profile-id ::db/for-update? true)]
+
+              ;; Schedule deletion of old photo
+              (when-let [id (:photo-id profile)]
+                (sto/touch-object! storage id))
+
+              ;; Save new photo
+              (db/update! pool :profile
+                          {:photo-id (:id photo)}
+                          {:id profile-id})
+
+              (-> (rph/wrap)
+                  (rph/with-meta {::audit/replace-props
+                                  {:file-name (:filename file)
+                                   :file-size (:size file)
+                                   :file-path (str (:path file))
+                                   :file-mtype (:mtype file)}}))))]
+    (->> (upload-photo cfg params)
+         (p/fmap executor on-uploaded))))
+
+(defn upload-photo
+  [{:keys [::sto/storage ::wrk/executor climit] :as cfg} {:keys [file]}]
+  (letfn [(get-info [content]
+            (climit/with-dispatch (:process-image climit)
+              (media/run {:cmd :info :input content})))
+
+          (generate-thumbnail [info]
+            (climit/with-dispatch (:process-image climit)
+              (media/run {:cmd :profile-thumbnail
+                          :format :jpeg
+                          :quality 85
+                          :width 256
+                          :height 256
+                          :input info})))
+
+          ;; Function responsible of calculating cryptographyc hash of
+          ;; the provided data.
+          (calculate-hash [data]
+            (px/with-dispatch executor
+              (sto/calculate-hash data)))]
+
+    (p/let [info    (get-info file)
+            thumb   (generate-thumbnail info)
+            hash    (calculate-hash (:data thumb))
+            content (-> (sto/content (:data thumb) (:size thumb))
+                        (sto/wrap-with-hash hash))]
+      (sto/put-object! storage {::sto/content content
+                                ::sto/deduplicate? true
+                                :bucket "profile"
+                                :content-type (:mtype thumb)}))))
+
+
+;; --- MUTATION: Request Email Change
+
+(declare ^:private request-email-change!)
+(declare ^:private change-email-immediately!)
+
+(s/def ::request-email-change
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::email]))
+
+(sv/defmethod ::request-email-change
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id email] :as params}]
+  (db/with-atomic [conn pool]
+    (let [profile (db/get-by-id conn :profile profile-id)
+          cfg     (assoc cfg ::conn conn)
+          params  (assoc params
+                         :profile profile
+                         :email (str/lower email))]
+      (if (contains? cf/flags :smtp)
+        (request-email-change! cfg params)
+        (change-email-immediately! cfg params)))))
+
+(defn- change-email-immediately!
+  [{:keys [::conn]} {:keys [profile email] :as params}]
+  (when (not= email (:email profile))
+    (check-profile-existence! conn params))
+
+  (db/update! conn :profile
+              {:email email}
+              {:id (:id profile)})
+
+  {:changed true})
+
+(defn- request-email-change!
+  [{:keys [::conn] :as cfg} {:keys [profile email] :as params}]
+  (let [token   (tokens/generate (::main/props cfg)
+                                 {:iss :change-email
+                                  :exp (dt/in-future "15m")
+                                  :profile-id (:id profile)
+                                  :email email})
+        ptoken  (tokens/generate (::main/props cfg)
+                                 {:iss :profile-identity
+                                  :profile-id (:id profile)
+                                  :exp (dt/in-future {:days 30})})]
+
+    (when (not= email (:email profile))
+      (check-profile-existence! conn params))
+
+    (when-not (eml/allow-send-emails? conn profile)
+      (ex/raise :type :validation
+                :code :profile-is-muted
+                :hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
+
+    (when (eml/has-bounce-reports? conn email)
+      (ex/raise :type :validation
+                :code :email-has-permanent-bounces
+                :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+
+    (eml/send! {::eml/conn conn
+                ::eml/factory eml/change-email
+                :public-uri (cf/get :public-uri)
+                :to (:email profile)
+                :name (:fullname profile)
+                :pending-email email
+                :token token
+                :extra-data ptoken})
+    nil))
+
+
+;; --- MUTATION: Update Profile Props
+
+(s/def ::props map?)
+(s/def ::update-profile-props
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::props]))
+
+(sv/defmethod ::update-profile-props
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id props]}]
+  (db/with-atomic [conn pool]
+    (let [profile (get-profile conn profile-id ::db/for-update? true)
+          props   (reduce-kv (fn [props k v]
+                               ;; We don't accept namespaced keys
+                               (if (simple-ident? k)
+                                 (if (nil? v)
+                                   (dissoc props k)
+                                   (assoc props k v))
+                                 props))
+                             (:props profile)
+                             props)]
+
+      (db/update! conn :profile
+                  {:props (db/tjson props)}
+                  {:id profile-id})
+
+      (filter-props props))))
+
+
+;; --- MUTATION: Delete Profile
+
+(declare ^:private get-owned-teams-with-participants)
+
+(s/def ::delete-profile
+  (s/keys :req [::rpc/profile-id]))
+
+(sv/defmethod ::delete-profile
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [teams      (get-owned-teams-with-participants conn profile-id)
+          deleted-at (dt/now)]
+
+      ;; If we found owned teams with participants, we don't allow
+      ;; delete profile until the user properly transfer ownership or
+      ;; explicitly removes all participants from the team
+      (when (some pos? (map :participants teams))
+        (ex/raise :type :validation
+                  :code :owner-teams-with-people
+                  :hint "The user need to transfer ownership of owned teams."
+                  :context {:teams (mapv :id teams)}))
+
+      (doseq [{:keys [id]} teams]
+        (db/update! conn :team
+                    {:deleted-at deleted-at}
+                    {:id id}))
+
+      (db/update! conn :profile
+                  {:deleted-at deleted-at}
+                  {:id profile-id})
+
+      (rph/with-transform {} (session/delete-fn cfg)))))
+
+
+;; --- HELPERS
+
+(def sql:owned-teams
+  "with owner_teams as (
+      select tpr.team_id as id
+        from team_profile_rel as tpr
+       where tpr.is_owner is true
+         and tpr.profile_id = ?
+   )
+   select tpr.team_id as id,
+          count(tpr.profile_id) - 1 as participants
+     from team_profile_rel as tpr
+    where tpr.team_id in (select id from owner_teams)
+      and tpr.profile_id != ?
+    group by 1")
+
+(defn- get-owned-teams-with-participants
+  [conn profile-id]
+  (db/exec! conn [sql:owned-teams profile-id profile-id]))
+
+(def ^:private sql:profile-existence
+  "select exists (select * from profile
+                   where email = ?
+                     and deleted_at is null) as val")
+
+(defn check-profile-existence!
+  [conn {:keys [email] :as params}]
+  (let [email  (str/lower email)
+        result (db/exec-one! conn [sql:profile-existence email])]
+    (when (:val result)
+      (ex/raise :type :validation
+                :code :email-already-exists))
+    params))
+
+(def ^:private sql:profile-by-email
+  "select p.* from profile as p
+    where p.email = ?
+      and (p.deleted_at is null or
+           p.deleted_at > now())")
+
+(defn get-profile-by-email
+  "Returns a profile looked up by email or `nil` if not match found."
+  [conn email]
+  (->> (db/exec! conn [sql:profile-by-email (str/lower email)])
+       (map decode-row)
+       (first)))
+
+(defn strip-private-attrs
+  "Only selects a publicly visible profile attrs."
+  [row]
+  (dissoc row :password :deleted-at))
+
+(defn filter-props
+  "Removes all namespace qualified props from `props` attr."
+  [props]
+  (into {} (filter (fn [[k _]] (simple-ident? k))) props))
+
+(defn decode-row
+  [{:keys [props] :as row}]
+  (cond-> row
+    (db/pgobject? props "jsonb")
+    (assoc :props (db/decode-transit-pgobject props))))

backend/src/app/rpc/commands/projects.clj

@@ -0,0 +1,268 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.commands.projects
+  (:require
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.loggers.audit :as-alias audit]
+   [app.loggers.webhooks :as webhooks]
+   [app.rpc :as-alias rpc]
+   [app.rpc.commands.teams :as teams]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.helpers :as rph]
+   [app.rpc.permissions :as perms]
+   [app.rpc.quotes :as quotes]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]))
+
+(s/def ::id ::us/uuid)
+(s/def ::name ::us/string)
+
+;; --- Check Project Permissions
+
+(def ^:private sql:project-permissions
+  "select tpr.is_owner,
+          tpr.is_admin,
+          tpr.can_edit
+     from team_profile_rel as tpr
+    inner join project as p on (p.team_id = tpr.team_id)
+    where p.id = ?
+      and tpr.profile_id = ?
+   union all
+   select ppr.is_owner,
+          ppr.is_admin,
+          ppr.can_edit
+     from project_profile_rel as ppr
+    where ppr.project_id = ?
+      and ppr.profile_id = ?")
+
+(defn- get-permissions
+  [conn profile-id project-id]
+  (let [rows     (db/exec! conn [sql:project-permissions
+                                 project-id profile-id
+                                 project-id profile-id])
+        is-owner (boolean (some :is-owner rows))
+        is-admin (boolean (some :is-admin rows))
+        can-edit (boolean (some :can-edit rows))]
+     (when (seq rows)
+       {:is-owner is-owner
+        :is-admin (or is-owner is-admin)
+        :can-edit (or is-owner is-admin can-edit)
+        :can-read true})))
+
+(def has-edit-permissions?
+  (perms/make-edition-predicate-fn get-permissions))
+
+(def has-read-permissions?
+  (perms/make-read-predicate-fn get-permissions))
+
+(def check-edition-permissions!
+  (perms/make-check-fn has-edit-permissions?))
+
+(def check-read-permissions!
+  (perms/make-check-fn has-read-permissions?))
+
+;; --- QUERY: Get projects
+
+(declare get-projects)
+
+(s/def ::team-id ::us/uuid)
+(s/def ::get-projects
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::team-id]))
+
+(sv/defmethod ::get-projects
+  {::doc/added "1.18"}
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id team-id]}]
+  (with-open [conn (db/open pool)]
+    (teams/check-read-permissions! conn profile-id team-id)
+    (get-projects conn profile-id team-id)))
+
+(def sql:projects
+  "select p.*,
+          coalesce(tpp.is_pinned, false) as is_pinned,
+          (select count(*) from file as f
+            where f.project_id = p.id
+              and deleted_at is null) as count
+     from project as p
+    inner join team as t on (t.id = p.team_id)
+     left join team_project_profile_rel as tpp
+            on (tpp.project_id = p.id and
+                tpp.team_id = p.team_id and
+                tpp.profile_id = ?)
+    where p.team_id = ?
+      and p.deleted_at is null
+      and t.deleted_at is null
+    order by p.modified_at desc")
+
+(defn get-projects
+  [conn profile-id team-id]
+  (db/exec! conn [sql:projects profile-id team-id]))
+
+;; --- QUERY: Get all projects
+
+(declare get-all-projects)
+
+(s/def ::get-all-projects
+  (s/keys :req [::rpc/profile-id]))
+
+(sv/defmethod ::get-all-projects
+  {::doc/added "1.18"}
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
+  (with-open [conn (db/open pool)]
+    (get-all-projects conn profile-id)))
+
+(def sql:all-projects
+  "select p1.*, t.name as team_name, t.is_default as is_default_team
+     from project as p1
+    inner join team as t on (t.id = p1.team_id)
+    where t.id in (select team_id
+                     from team_profile_rel as tpr
+                    where tpr.profile_id = ?
+                      and (tpr.can_edit = true or
+                           tpr.is_owner = true or
+                           tpr.is_admin = true))
+      and t.deleted_at is null
+      and p1.deleted_at is null
+   union
+   select p2.*, t.name as team_name, t.is_default as is_default_team
+     from project as p2
+    inner join team as t on (t.id = p2.team_id)
+    where p2.id in (select project_id
+                     from project_profile_rel as ppr
+                    where ppr.profile_id = ?
+                      and (ppr.can_edit = true or
+                           ppr.is_owner = true or
+                           ppr.is_admin = true))
+      and t.deleted_at is null
+      and p2.deleted_at is null
+    order by team_name, name;")
+
+(defn get-all-projects
+  [conn profile-id]
+  (db/exec! conn [sql:all-projects profile-id profile-id]))
+
+
+;; --- QUERY: Get project
+
+(s/def ::get-project
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::id]))
+
+(sv/defmethod ::get-project
+  {::doc/added "1.18"}
+  [{:keys [::db/pool]} {:keys [::rpc/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)))
+
+
+
+;; --- MUTATION: Create Project
+
+(s/def ::create-project
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::team-id ::name]
+          :opt-un [::id]))
+
+(sv/defmethod ::create-project
+  {::doc/added "1.18"
+   ::webhooks/event? true}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
+  (db/with-atomic [conn pool]
+    (teams/check-edition-permissions! conn profile-id team-id)
+    (quotes/check-quote! conn {::quotes/id ::quotes/projects-per-team
+                               ::quotes/profile-id profile-id
+                               ::quotes/team-id team-id})
+
+    (let [params  (assoc params :profile-id profile-id)
+          project (teams/create-project conn params)]
+      (teams/create-project-role conn profile-id (:id project) :owner)
+      (db/insert! conn :team-project-profile-rel
+                  {:project-id (:id project)
+                   :profile-id profile-id
+                   :team-id team-id
+                   :is-pinned true})
+      (assoc project :is-pinned true))))
+
+
+;; --- MUTATION: Toggle Project Pin
+
+(def ^:private
+  sql:update-project-pin
+  "insert into team_project_profile_rel (team_id, project_id, profile_id, is_pinned)
+   values (?, ?, ?, ?)
+       on conflict (team_id, project_id, profile_id)
+       do update set is_pinned=?")
+
+(s/def ::is-pinned ::us/boolean)
+(s/def ::project-id ::us/uuid)
+(s/def ::update-project-pin
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::id ::team-id ::is-pinned]))
+
+(sv/defmethod ::update-project-pin
+  {::doc/added "1.18"
+   ::webhooks/batch-timeout (dt/duration "5s")
+   ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
+   ::webhooks/event? true}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id team-id is-pinned] :as params}]
+  (db/with-atomic [conn pool]
+    (check-edition-permissions! conn profile-id id)
+    (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
+    nil))
+
+;; --- MUTATION: Rename Project
+
+(declare rename-project)
+
+(s/def ::rename-project
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::name ::id]))
+
+(sv/defmethod ::rename-project
+  {::doc/added "1.18"
+   ::webhooks/event? true}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
+  (db/with-atomic [conn pool]
+    (check-edition-permissions! conn profile-id id)
+    (let [project (db/get-by-id conn :project id ::db/for-update? true)]
+      (db/update! conn :project
+                  {:name name}
+                  {:id id})
+      (rph/with-meta (rph/wrap)
+        {::audit/props {:team-id (:team-id project)
+                        :prev-name (:name project)}}))))
+
+;; --- MUTATION: Delete Project
+
+(s/def ::delete-project
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::id]))
+
+;; TODO: right now, we just don't allow delete default projects, in a
+;; future we need to ensure raise a correct exception signaling that
+;; this is not allowed.
+
+(sv/defmethod ::delete-project
+  {::doc/added "1.18"
+   ::webhooks/event? true}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  (db/with-atomic [conn pool]
+    (check-edition-permissions! conn profile-id id)
+    (let [project (db/update! conn :project
+                              {:deleted-at (dt/now)}
+                              {:id id :is-default false})]
+      (rph/with-meta (rph/wrap)
+        {::audit/props {:team-id (:team-id project)
+                        :name (:name project)
+                        :created-at (:created-at project)
+                        :modified-at (:modified-at project)}}))))
+
+

backend/src/app/rpc/commands/search.clj

@@ -64,5 +64,5 @@
 
 (sv/defmethod ::search-files
   {::doc/added "1.17"}
-  [{:keys [pool]} {:keys [::rpc/profile-id team-id search-term]}]
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id team-id search-term]}]
   (some->> search-term (search-files pool profile-id team-id)))

backend/src/app/rpc/commands/teams.clj

@@ -18,16 +18,16 @@
    [app.main :as-alias main]
    [app.media :as media]
    [app.rpc :as-alias rpc]
-   [app.rpc.climit :as climit]
+   [app.rpc.commands.profile :as profile]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
    [app.rpc.permissions :as perms]
-   [app.rpc.queries.profile :as profile]
    [app.rpc.quotes :as quotes]
    [app.storage :as sto]
    [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
+   [app.worker :as-alias wrk]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [promesa.core :as p]
@@ -83,7 +83,7 @@
 
 (sv/defmethod ::get-teams
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (with-open [conn (db/open pool)]
     (retrieve-teams conn profile-id)))
 
@@ -114,8 +114,8 @@
 
 (defn retrieve-teams
   [conn profile-id]
-  (let [defaults (profile/retrieve-additional-data conn profile-id)]
-    (->> (db/exec! conn [sql:teams (:default-team-id defaults) profile-id])
+  (let [profile (profile/get-profile conn profile-id)]
+    (->> (db/exec! conn [sql:teams (:default-team-id profile) profile-id])
          (mapv process-permissions))))
 
 ;; --- Query: Team (by ID)
@@ -128,20 +128,21 @@
 
 (sv/defmethod ::get-team
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}]
   (with-open [conn (db/open pool)]
     (retrieve-team conn profile-id id)))
 
 (defn retrieve-team
   [conn profile-id team-id]
-  (let [defaults (profile/retrieve-additional-data conn profile-id)
-        sql      (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")
-        result   (db/exec-one! conn [sql (:default-team-id defaults) profile-id team-id])]
+  (let [profile (profile/get-profile conn profile-id)
+        sql     (str "WITH teams AS (" sql:teams ") SELECT * FROM teams WHERE id=?")
+        result  (db/exec-one! conn [sql (:default-team-id profile) profile-id team-id])]
+
     (when-not result
       (ex/raise :type :not-found
                 :code :team-does-not-exist))
-    (process-permissions result)))
 
+    (process-permissions result)))
 
 ;; --- Query: Team Members
 
@@ -439,7 +440,7 @@
 
 (sv/defmethod ::leave-team
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
     (leave-team conn (assoc params :profile-id profile-id))))
 
@@ -455,7 +456,7 @@
 
 (sv/defmethod ::delete-team
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (let [perms (get-permissions conn profile-id id)]
       (when-not (:is-owner perms)
@@ -551,7 +552,7 @@
 
 (sv/defmethod ::delete-team-member
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
   (db/with-atomic [conn pool]
     (let [perms (get-permissions conn profile-id team-id)]
       (when-not (or (:is-owner perms)
@@ -570,7 +571,7 @@
 
 ;; --- Mutation: Update Team Photo
 
-(declare ^:private upload-photo)
+(declare upload-photo)
 (declare ^:private update-team-photo)
 
 (s/def ::file ::media/upload)
@@ -583,14 +584,14 @@
   [cfg {:keys [::rpc/profile-id file] :as params}]
   ;; Validate incoming mime type
   (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
-  (let [cfg (update cfg :storage media/configure-assets-storage)]
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
     (update-team-photo cfg (assoc params :profile-id profile-id))))
 
 (defn update-team-photo
-  [{:keys [pool storage executor] :as cfg} {:keys [profile-id team-id] :as params}]
+  [{:keys [::db/pool ::sto/storage ::wrk/executor] :as cfg} {:keys [profile-id team-id] :as params}]
   (p/let [team  (px/with-dispatch executor
                   (retrieve-team pool profile-id team-id))
-          photo (upload-photo cfg params)]
+          photo (profile/upload-photo cfg params)]
 
     ;; Mark object as touched for make it ellegible for tentative
     ;; garbage collection.
@@ -604,36 +605,6 @@
 
     (assoc team :photo-id (:id photo))))
 
-(defn upload-photo
-  [{:keys [storage executor climit] :as cfg} {:keys [file]}]
-  (letfn [(get-info [content]
-            (climit/with-dispatch (:process-image climit)
-              (media/run {:cmd :info :input content})))
-
-          (generate-thumbnail [info]
-            (climit/with-dispatch (:process-image climit)
-              (media/run {:cmd :profile-thumbnail
-                          :format :jpeg
-                          :quality 85
-                          :width 256
-                          :height 256
-                          :input info})))
-
-          ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data.
-          (calculate-hash [data]
-            (px/with-dispatch executor
-              (sto/calculate-hash data)))]
-
-    (p/let [info    (get-info file)
-            thumb   (generate-thumbnail info)
-            hash    (calculate-hash (:data thumb))
-            content (-> (sto/content (:data thumb) (:size thumb))
-                        (sto/wrap-with-hash hash))]
-      (sto/put-object! storage {::sto/content content
-                                ::sto/deduplicate? true
-                                :bucket "profile"
-                                :content-type (:mtype thumb)}))))
 
 ;; --- Mutation: Create Team Invitation
 
@@ -663,7 +634,7 @@
 
 (defn- create-invitation
   [{:keys [::conn] :as cfg} {:keys [team profile role email] :as params}]
-  (let [member (profile/retrieve-profile-data-by-email conn email)
+  (let [member (profile/get-profile-by-email conn email)
         expire (dt/in-future "168h") ;; 7 days
         itoken (create-invitation-token cfg {:profile-id (:id profile)
                                              :valid-until expire
@@ -735,7 +706,7 @@
   "A rpc call that allow to send a single or multiple invitations to
   join the team."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id email emails role] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email emails role] :as params}]
   (db/with-atomic [conn pool]
     (let [perms    (get-permissions conn profile-id team-id)
           profile  (db/get-by-id conn :profile profile-id)
@@ -784,7 +755,7 @@
 
 (sv/defmethod ::create-team-with-invitations
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id emails role] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id emails role] :as params}]
   (db/with-atomic [conn pool]
     (let [team     (create-team conn params)
           profile  (db/get-by-id conn :profile profile-id)
@@ -838,7 +809,7 @@
                           {:team-id team-id
                            :email-to (str/lower email)})
                   (update :role keyword))
-        member (profile/retrieve-profile-data-by-email pool (:email invit))
+        member (profile/get-profile-by-email pool (:email invit))
         token  (create-invitation-token cfg {:team-id (:team-id invit)
                                              :profile-id profile-id
                                              :valid-until (:valid-until invit)
@@ -855,7 +826,7 @@
 
 (sv/defmethod ::update-team-invitation-role
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id email role] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email role] :as params}]
   (db/with-atomic [conn pool]
     (let [perms    (get-permissions conn profile-id team-id)]
 
@@ -876,7 +847,7 @@
 
 (sv/defmethod ::delete-team-invitation
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
   (db/with-atomic [conn pool]
     (let [perms (get-permissions conn profile-id team-id)]
 

backend/src/app/rpc/commands/verify_token.clj

@@ -11,11 +11,12 @@
    [app.db :as db]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
+   [app.main :as-alias main]
    [app.rpc :as-alias rpc]
+   [app.rpc.commands.profile :as profile]
    [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.rpc.queries.profile :as profile]
    [app.rpc.quotes :as quotes]
    [app.tokens :as tokens]
    [app.tokens.spec.team-invitation :as-alias spec.team-invitation]
@@ -34,15 +35,15 @@
 (sv/defmethod ::verify-token
   {::rpc/auth false
    ::doc/added "1.15"}
-  [{:keys [pool sprops] :as cfg} {:keys [token] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [token] :as params}]
   (db/with-atomic [conn pool]
-    (let [claims (tokens/verify sprops {:token token})
+    (let [claims (tokens/verify (::main/props cfg) {:token token})
           cfg    (assoc cfg :conn conn)]
       (process-token cfg params claims))))
 
 (defmethod process-token :change-email
   [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
-  (when (profile/retrieve-profile-data-by-email conn email)
+  (when (profile/get-profile-by-email conn email)
     (ex/raise :type :validation
               :code :email-already-exists))
 
@@ -56,8 +57,8 @@
      ::audit/profile-id profile-id}))
 
 (defmethod process-token :verify-email
-  [{:keys [conn session] :as cfg} _ {:keys [profile-id] :as claims}]
-  (let [profile (profile/retrieve-profile conn profile-id)
+  [{:keys [conn] :as cfg} _ {:keys [profile-id] :as claims}]
+  (let [profile (profile/get-profile conn profile-id)
         claims  (assoc claims :profile profile)]
 
     (when-not (:is-active profile)
@@ -71,14 +72,14 @@
                   {:id (:id profile)}))
 
     (-> claims
-        (rph/with-transform (session/create-fn session profile-id))
+        (rph/with-transform (session/create-fn cfg profile-id))
         (rph/with-meta {::audit/name "verify-profile-email"
                         ::audit/props (audit/profile->props profile)
                         ::audit/profile-id (:id profile)}))))
 
 (defmethod process-token :auth
   [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
-  (let [profile (profile/retrieve-profile conn profile-id)]
+  (let [profile (profile/get-profile conn profile-id)]
     (assoc claims :profile profile)))
 
 ;; --- Team Invitation
@@ -133,7 +134,7 @@
           :opt-un [::spec.team-invitation/member-id]))
 
 (defmethod process-token :team-invitation
-  [{:keys [conn session] :as cfg}
+  [{:keys [conn] :as cfg}
    {:keys [::rpc/profile-id token]}
    {:keys [member-id team-id member-email] :as claims}]
 
@@ -179,7 +180,7 @@
                                {:columns [:id :email]})]
         (let [profile (accept-invitation cfg claims invitation member)]
           (-> (assoc claims :state :created)
-              (rph/with-transform (session/create-fn session (:id profile)))
+              (rph/with-transform (session/create-fn cfg (:id profile)))
               (rph/with-meta {::audit/name "accept-team-invitation"
                               ::audit/props (merge
                                              (audit/profile->props profile)

backend/src/app/rpc/commands/viewer.clj

@@ -13,11 +13,10 @@
    [app.rpc.commands.files :as files]
    [app.rpc.cond :as-alias cond]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.queries.share-link :as slnk]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
-;; --- Query: View Only Bundle
+;; --- QUERY: View Only Bundle
 
 (defn- get-project
   [conn id]
@@ -31,7 +30,8 @@
         users   (comments/get-file-comments-users conn file-id profile-id)
 
         links   (->> (db/query conn :share-link {:file-id file-id})
-                     (mapv slnk/decode-share-link-row))
+                     (mapv (fn [row]
+                             (update row :pages db/decode-pgarray #{}))))
 
         fonts   (db/query conn :team-font-variant
                           {:team-id (:team-id project)
@@ -84,6 +84,6 @@
    ::cond/key-fn files/get-file-etag
    ::cond/reuse-key? true
    ::doc/added "1.17"}
-  [{:keys [pool]} {:keys [::rpc/profile-id] :as params}]
+  [{:keys [::db/pool]} {:keys [::rpc/profile-id] :as params}]
   (with-open [conn (db/open pool)]
     (get-view-only-bundle conn (assoc params :profile-id profile-id))))

backend/src/app/rpc/commands/webhooks.clj

@@ -140,7 +140,7 @@
    from webhook where team_id = ? order by uri")
 
 (sv/defmethod ::get-webhooks
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id team-id)
     (db/exec! conn [sql:get-webhooks team-id])))

backend/src/app/rpc/doc.clj

@@ -70,6 +70,8 @@
       (respond (yrs/response 404)))))
 
 
+(s/def ::routes vector?)
+
 (defmethod ig/pre-init-spec ::routes [_]
   (s/keys :req-un [::rpc/methods]))
 

backend/src/app/rpc/mutations/files.clj

@@ -1,237 +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/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.rpc.mutations.files
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.logging :as l]
-   [app.common.spec :as us]
-   [app.db :as db]
-   [app.loggers.audit :as audit]
-   [app.rpc.climit :as-alias climit]
-   [app.rpc.commands.files :as cmd.files]
-   [app.rpc.commands.files.create :as cmd.files.create]
-   [app.rpc.commands.files.temp :as cmd.files.temp]
-   [app.rpc.commands.files.update :as cmd.files.update]
-   [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
-   [app.rpc.queries.projects :as proj]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [clojure.spec.alpha :as s]))
-
-;; --- Mutation: Create File
-
-(s/def ::create-file ::cmd.files.create/create-file)
-
-(sv/defmethod ::create-file
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id project-id features components-v2] :as params}]
-  (db/with-atomic [conn pool]
-    (proj/check-edition-permissions! conn profile-id project-id)
-    (let [team-id  (cmd.files/get-team-id conn project-id)
-          features (cond-> (or features #{})
-                     ;; BACKWARD COMPATIBILITY with the components-v2 param
-                     components-v2 (conj "components/v2"))
-          params   (assoc params :features features)]
-      (-> (cmd.files.create/create-file conn params)
-          (vary-meta assoc ::audit/props {:team-id team-id})))))
-
-
-;; --- Mutation: Rename File
-
-(s/def ::rename-file ::cmd.files/rename-file)
-
-(sv/defmethod ::rename-file
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id id)
-    (cmd.files/rename-file conn params)))
-
-
-;; --- Mutation: Set File shared
-
-(s/def ::set-file-shared ::cmd.files/set-file-shared)
-
-(sv/defmethod ::set-file-shared
-  {::doc/added "1.2"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [id profile-id is-shared] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id id)
-    (when-not is-shared
-      (cmd.files/absorb-library conn params)
-      (cmd.files/unlink-files conn params))
-    (cmd.files/set-file-shared conn params)))
-
-;; --- Mutation: Delete File
-
-(s/def ::delete-file ::cmd.files/delete-file)
-
-(sv/defmethod ::delete-file
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id id)
-    (cmd.files/absorb-library conn params)
-    (cmd.files/mark-file-deleted conn params)
-    nil))
-
-;; --- Mutation: Link file to library
-
-(s/def ::link-file-to-library ::cmd.files/link-file-to-library)
-
-(sv/defmethod ::link-file-to-library
-  {::doc/added "1.3"
-   ::doc/deprecated "1.17"}
-  [{: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 pool]
-    (cmd.files/check-edition-permissions! conn profile-id file-id)
-    (cmd.files/check-edition-permissions! conn profile-id library-id)
-    (cmd.files/link-file-to-library conn params)))
-
-;; --- Mutation: Unlink file from library
-
-(s/def ::unlink-file-from-library ::cmd.files/unlink-file-from-library)
-
-(sv/defmethod ::unlink-file-from-library
-  {::doc/added "1.3"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id file-id)
-    (cmd.files/unlink-file-from-library conn params)))
-
-
-;; --- Mutation: Update synchronization status of a link
-
-(s/def ::update-sync ::cmd.files/update-file-library-sync-status)
-
-(sv/defmethod ::update-sync
-  {::doc/added "1.10"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id file-id)
-    (cmd.files/update-sync conn params)))
-
-
-;; --- Mutation: Ignore updates in linked files
-
-(declare ignore-sync)
-
-(s/def ::ignore-sync ::cmd.files/ignore-file-library-sync-status)
-
-(sv/defmethod ::ignore-sync
-  {::doc/added "1.10"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id file-id)
-    (cmd.files/ignore-sync conn params)))
-
-
-;; --- MUTATION: update-file
-
-(s/def ::components-v2 ::us/boolean)
-(s/def ::update-file
-  (s/and ::cmd.files.update/update-file
-         (s/keys :opt-un [::components-v2])))
-
-(sv/defmethod ::update-file
-  {::climit/queue :update-file
-   ::climit/key-fn :id
-   ::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [id profile-id features components-v2] :as params}]
-  (db/with-atomic [conn pool]
-    (db/xact-lock! conn id)
-    (cmd.files/check-edition-permissions! conn profile-id id)
-
-    (let [;; BACKWARD COMPATIBILITY with the components-v2 parameter
-          features  (cond-> (or features #{})
-                      components-v2 (conj "components/v2"))
-          tpoint    (dt/tpoint)
-          params    (assoc params :features features)
-          cfg       (assoc cfg :conn conn)]
-
-      (-> (cmd.files.update/update-file cfg params)
-          (rph/with-defer #(let [elapsed (tpoint)]
-                             (l/trace :hint "update-file" :time (dt/format-duration elapsed))))))))
-
-;; --- Mutation: upsert object thumbnail
-
-(s/def ::upsert-file-object-thumbnail ::cmd.files/upsert-file-object-thumbnail)
-
-(sv/defmethod ::upsert-file-object-thumbnail
-  {::doc/added "1.13"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id file-id)
-    (cmd.files/upsert-file-object-thumbnail! conn params)
-    nil))
-
-
-;; --- Mutation: upsert file thumbnail
-
-(s/def ::upsert-file-thumbnail ::cmd.files/upsert-file-thumbnail)
-
-(sv/defmethod ::upsert-file-thumbnail
-  "Creates or updates the file thumbnail. Mainly used for paint the
-  grid thumbnails."
-  {::doc/added "1.13"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id file-id)
-    (cmd.files/upsert-file-thumbnail conn params)
-    nil))
-
-
-;; --- MUTATION COMMAND: create-temp-file
-
-(s/def ::create-temp-file ::cmd.files.temp/create-temp-file)
-
-(sv/defmethod ::create-temp-file
-  {::doc/added "1.7"
-   ::doc/deprecated "1.17"}
-  [{: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)
-    (cmd.files.create/create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
-
-;; --- MUTATION COMMAND: update-temp-file
-
-(s/def ::update-temp-file ::cmd.files.temp/update-temp-file)
-
-(sv/defmethod ::update-temp-file
-  {::doc/added "1.7"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} params]
-  (db/with-atomic [conn pool]
-    (cmd.files.temp/update-temp-file conn params)
-    nil))
-
-;; --- MUTATION COMMAND: persist-temp-file
-
-(s/def ::persist-temp-file ::cmd.files.temp/persist-temp-file)
-
-(sv/defmethod ::persist-temp-file
-  {::doc/added "1.7"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.files/check-edition-permissions! conn profile-id id)
-    (cmd.files.temp/persist-temp-file conn params)))

backend/src/app/rpc/mutations/fonts.clj

@@ -6,15 +6,12 @@
 
 (ns app.rpc.mutations.fonts
   (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
    [app.common.spec :as us]
-   [app.common.uuid :as uuid]
    [app.db :as db]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.media :as media]
-   [app.rpc.climit :as-alias climit]
+   [app.rpc.commands.fonts :as fonts]
    [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
@@ -22,9 +19,7 @@
    [app.storage :as sto]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
+   [clojure.spec.alpha :as s]))
 
 (declare create-font-variant)
 
@@ -44,82 +39,19 @@
   (s/keys :req-un [::profile-id ::team-id ::data
                    ::font-id ::font-family ::font-weight ::font-style]))
 
+(declare create-font-variant)
+
 (sv/defmethod ::create-font-variant
   {::doc/added "1.3"
+   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
-  (let [cfg (update cfg :storage media/configure-assets-storage)]
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
     (teams/check-edition-permissions! pool profile-id team-id)
     (quotes/check-quote! pool {::quotes/id ::quotes/font-variants-per-team
                                ::quotes/profile-id profile-id
                                ::quotes/team-id team-id})
-    (create-font-variant cfg params)))
-
-(defn create-font-variant
-  [{:keys [storage pool executor climit] :as cfg} {:keys [data] :as params}]
-  (letfn [(generate-fonts [data]
-            (climit/with-dispatch (:process-font climit)
-              (media/run {:cmd :generate-fonts :input data})))
-
-          ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data.
-          (calculate-hash [data]
-            (px/with-dispatch executor
-              (sto/calculate-hash data)))
-
-          (validate-data [data]
-            (when (and (not (contains? data "font/otf"))
-                       (not (contains? data "font/ttf"))
-                       (not (contains? data "font/woff"))
-                       (not (contains? data "font/woff2")))
-              (ex/raise :type :validation
-                        :code :invalid-font-upload))
-            data)
-
-          (persist-font-object [data mtype]
-            (when-let [resource (get data mtype)]
-              (p/let [hash    (calculate-hash resource)
-                      content (-> (sto/content resource)
-                                  (sto/wrap-with-hash hash))]
-                (sto/put-object! storage {::sto/content content
-                                          ::sto/touched-at (dt/now)
-                                          ::sto/deduplicate? true
-                                          :content-type mtype
-                                          :bucket "team-font-variant"}))))
-
-          (persist-fonts [data]
-            (p/let [otf   (persist-font-object data "font/otf")
-                    ttf   (persist-font-object data "font/ttf")
-                    woff1 (persist-font-object data "font/woff")
-                    woff2 (persist-font-object data "font/woff2")]
-
-              (d/without-nils
-               {:otf otf
-                :ttf ttf
-                :woff1 woff1
-                :woff2 woff2})))
-
-          (insert-into-db [{:keys [woff1 woff2 otf ttf]}]
-            (db/insert! pool :team-font-variant
-                        {:id (uuid/next)
-                         :team-id (:team-id params)
-                         :font-id (:font-id params)
-                         :font-family (:font-family params)
-                         :font-weight (:font-weight params)
-                         :font-style (:font-style params)
-                         :woff1-file-id (:id woff1)
-                         :woff2-file-id (:id woff2)
-                         :otf-file-id (:id otf)
-                         :ttf-file-id (:id ttf)}))
-          ]
-
-    (->> (generate-fonts data)
-         (p/fmap validate-data)
-         (p/mcat executor persist-fonts)
-         (p/fmap executor insert-into-db)
-         (p/fmap (fn [result]
-                   (let [params (update params :data (comp vec keys))]
-                     (rph/with-meta result {::audit/replace-props params})))))))
+    (fonts/create-font-variant cfg params)))
 
 ;; --- UPDATE FONT FAMILY
 
@@ -128,6 +60,7 @@
 
 (sv/defmethod ::update-font
   {::doc/added "1.3"
+   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [team-id profile-id id name] :as params}]
   (db/with-atomic [conn pool]
@@ -149,6 +82,7 @@
 
 (sv/defmethod ::delete-font
   {::doc/added "1.3"
+   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
   (db/with-atomic [conn pool]
@@ -169,6 +103,7 @@
 
 (sv/defmethod ::delete-font-variant
   {::doc/added "1.3"
+   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
   (db/with-atomic [conn pool]

backend/src/app/rpc/mutations/media.clj

@@ -11,6 +11,7 @@
    [app.rpc.commands.files :as files]
    [app.rpc.commands.media :as cmd.media]
    [app.rpc.doc :as-alias doc]
+   [app.storage :as-alias sto]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
@@ -20,9 +21,9 @@
 
 (sv/defmethod ::upload-file-media-object
   {::doc/added "1.2"
-   ::doc/deprecated "1.17"}
+   ::doc/deprecated "1.18"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}]
-  (let [cfg (update cfg :storage media/configure-assets-storage)]
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
     (files/check-edition-permissions! pool profile-id file-id)
     (media/validate-media-type! content)
     (cmd.media/validate-content-size! content)
@@ -34,9 +35,9 @@
 
 (sv/defmethod ::create-file-media-object-from-url
   {::doc/added "1.3"
-   ::doc/deprecated "1.17"}
+   ::doc/deprecated "1.18"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (let [cfg (update cfg :storage media/configure-assets-storage)]
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
     (files/check-edition-permissions! pool profile-id file-id)
     (#'cmd.media/create-file-media-object-from-url cfg params)))
 
@@ -46,7 +47,7 @@
 
 (sv/defmethod ::clone-file-media-object
   {::doc/added "1.2"
-   ::doc/deprecated "1.17"}
+   ::doc/deprecated "1.18"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)

backend/src/app/rpc/mutations/profile.clj

@@ -6,31 +6,23 @@
 
 (ns app.rpc.mutations.profile
   (:require
-   [app.auth :as auth]
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
-   [app.emails :as eml]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
    [app.media :as media]
-   [app.rpc :as-alias rpc]
    [app.rpc.climit :as-alias climit]
-   [app.rpc.commands.auth :as cmd.auth]
-   [app.rpc.commands.teams :as teams]
+   [app.rpc.commands.profile :as profile]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.rpc.queries.profile :as profile]
    [app.storage :as sto]
-   [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
+   [cuerdas.core :as str]))
 
 ;; --- Helpers & Specs
 
@@ -50,14 +42,15 @@
           :opt-un [::lang ::theme]))
 
 (sv/defmethod ::update-profile
-  {::doc/added "1.0"}
-  [{:keys [pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
+  {::doc/added "1.0"
+   ::doc/deprecated "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
   (db/with-atomic [conn pool]
     ;; NOTE: we need to retrieve the profile independently if we use
     ;; it or not for explicit locking and avoid concurrent updates of
     ;; the same row/object.
-    (let [profile (-> (db/get-by-id conn :profile profile-id {:for-update true})
-                      (profile/decode-profile-row))
+    (let [profile (-> (db/get-by-id conn :profile profile-id ::db/for-update? true)
+                      (profile/decode-row))
 
           ;; Update the profile map with direct params
           profile (-> profile
@@ -74,161 +67,68 @@
                   {:id profile-id})
 
       (-> profile
-          profile/strip-private-attrs
-          d/without-nils
+          (profile/strip-private-attrs)
+          (d/without-nils)
           (rph/with-meta {::audit/props (audit/profile->props profile)})))))
 
 
 ;; --- MUTATION: Update Password
 
-(declare validate-password!)
-(declare update-profile-password!)
-(declare invalidate-profile-session!)
-
 (s/def ::update-profile-password
   (s/keys :req-un [::profile-id ::password ::old-password]))
 
 (sv/defmethod ::update-profile-password
-  {::climit/queue :auth}
-  [{:keys [pool] :as cfg} {:keys [password] :as params}]
+  {::climit/queue :auth
+   ::doc/added "1.0"
+   ::doc/deprecated "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [password] :as params}]
   (db/with-atomic [conn pool]
-    (let [profile    (validate-password! conn params)
-          session-id (::rpc/session-id params)]
+    (let [profile    (#'profile/validate-password! conn params)
+          session-id (::session/id params)]
       (when (= (str/lower (:email profile))
                (str/lower (:password params)))
         (ex/raise :type :validation
                   :code :email-as-password
                   :hint "you can't use your email as password"))
-      (update-profile-password! conn (assoc profile :password password))
-      (invalidate-profile-session! conn (:id profile) session-id)
+      (profile/update-profile-password! conn (assoc profile :password password))
+      (#'profile/invalidate-profile-session! conn (:id profile) session-id)
       nil)))
 
-(defn- invalidate-profile-session!
-  "Removes all sessions except the current one."
-  [conn profile-id session-id]
-  (let [sql "delete from http_session where profile_id = ? and id != ?"]
-    (:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id]))))
-
-(defn- validate-password!
-  [conn {:keys [profile-id old-password] :as params}]
-  (let [profile (db/get-by-id conn :profile profile-id)]
-    (when-not (:valid (auth/verify-password old-password (:password profile)))
-      (ex/raise :type :validation
-                :code :old-password-not-match))
-    profile))
-
-(defn update-profile-password!
-  [conn {:keys [id password] :as profile}]
-  (db/update! conn :profile
-              {:password (auth/derive-password password)}
-              {:id id}))
 
 ;; --- MUTATION: Update Photo
 
-(declare update-profile-photo)
-
 (s/def ::file ::media/upload)
 (s/def ::update-profile-photo
   (s/keys :req-un [::profile-id ::file]))
 
 (sv/defmethod ::update-profile-photo
+  {::doc/added "1.0"
+   ::doc/deprecated "1.18"}
   [cfg {:keys [file] :as params}]
   ;; Validate incoming mime type
   (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
-  (let [cfg (update cfg :storage media/configure-assets-storage)]
-    (update-profile-photo cfg params)))
-
-(defn update-profile-photo
-  [{:keys [pool storage executor] :as cfg} {:keys [profile-id file] :as params}]
-  (p/let [profile (px/with-dispatch executor
-                    (db/get-by-id pool :profile profile-id))
-          photo   (teams/upload-photo cfg params)]
-
-    ;; Schedule deletion of old photo
-    (when-let [id (:photo-id profile)]
-      (sto/touch-object! storage id))
-
-    ;; Save new photo
-    (db/update! pool :profile
-                {:photo-id (:id photo)}
-                {:id profile-id})
-
-    (-> (rph/wrap)
-        (rph/with-meta {::audit/replace-props
-                        {:file-name (:filename file)
-                         :file-size (:size file)
-                         :file-path (str (:path file))
-                         :file-mtype (:mtype file)}}))))
+  (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
+    (profile/update-profile-photo cfg params)))
 
 ;; --- MUTATION: Request Email Change
 
-(declare request-email-change)
-(declare change-email-immediately)
-
 (s/def ::request-email-change
   (s/keys :req-un [::email]))
 
 (sv/defmethod ::request-email-change
-  [{:keys [pool] :as cfg} {:keys [profile-id email] :as params}]
+  {::doc/added "1.0"
+   ::doc/deprecated "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [profile-id email] :as params}]
   (db/with-atomic [conn pool]
     (let [profile (db/get-by-id conn :profile profile-id)
-          cfg     (assoc cfg :conn conn)
+          cfg     (assoc cfg ::profile/conn conn)
           params  (assoc params
                          :profile profile
                          :email (str/lower email))]
+
       (if (contains? cf/flags :smtp)
-        (request-email-change cfg params)
-        (change-email-immediately cfg params)))))
-
-(defn- change-email-immediately
-  [{:keys [conn]} {:keys [profile email] :as params}]
-  (when (not= email (:email profile))
-    (cmd.auth/check-profile-existence! conn params))
-  (db/update! conn :profile
-              {:email email}
-              {:id (:id profile)})
-  {:changed true})
-
-(defn- request-email-change
-  [{:keys [conn sprops] :as cfg} {:keys [profile email] :as params}]
-  (let [token   (tokens/generate sprops
-                                 {:iss :change-email
-                                  :exp (dt/in-future "15m")
-                                  :profile-id (:id profile)
-                                  :email email})
-        ptoken  (tokens/generate sprops
-                                 {:iss :profile-identity
-                                  :profile-id (:id profile)
-                                  :exp (dt/in-future {:days 30})})]
-
-    (when (not= email (:email profile))
-      (cmd.auth/check-profile-existence! conn params))
-
-    (when-not (eml/allow-send-emails? conn profile)
-      (ex/raise :type :validation
-                :code :profile-is-muted
-                :hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
-
-    (when (eml/has-bounce-reports? conn email)
-      (ex/raise :type :validation
-                :code :email-has-permanent-bounces
-                :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
-
-    (eml/send! {::eml/conn conn
-                ::eml/factory eml/change-email
-                :public-uri (:public-uri cfg)
-                :to (:email profile)
-                :name (:fullname profile)
-                :pending-email email
-                :token token
-                :extra-data ptoken})
-    nil))
-
-
-(defn select-profile-for-update
-  [conn id]
-  (db/get-by-id conn :profile id {:for-update true}))
-
+        (#'profile/request-email-change! cfg params)
+        (#'profile/change-email-immediately! cfg params)))))
 
 ;; --- MUTATION: Update Profile Props
 
@@ -237,9 +137,11 @@
   (s/keys :req-un [::profile-id ::props]))
 
 (sv/defmethod ::update-profile-props
-  [{:keys [pool] :as cfg} {:keys [profile-id props]}]
+  {::doc/added "1.0"
+   ::doc/deprecated "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [profile-id props]}]
   (db/with-atomic [conn pool]
-    (let [profile (profile/retrieve-profile-data conn profile-id)
+    (let [profile (profile/get-profile conn profile-id ::db/for-update? true)
           props   (reduce-kv (fn [props k v]
                                ;; We don't accept namespaced keys
                                (if (simple-ident? k)
@@ -254,22 +156,20 @@
                   {:props (db/tjson props)}
                   {:id profile-id})
 
-      (profile/filter-profile-props props))))
+      (profile/filter-props props))))
 
 
 ;; --- MUTATION: Delete Profile
 
-(declare get-owned-teams-with-participants)
-(declare check-can-delete-profile!)
-(declare mark-profile-as-deleted!)
-
 (s/def ::delete-profile
   (s/keys :req-un [::profile-id]))
 
 (sv/defmethod ::delete-profile
-  [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
+  {::doc/added "1.0"
+   ::doc/deprecated "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [teams      (get-owned-teams-with-participants conn profile-id)
+    (let [teams      (#'profile/get-owned-teams-with-participants conn profile-id)
           deleted-at (dt/now)]
 
       ;; If we found owned teams with participants, we don't allow
@@ -290,22 +190,4 @@
                   {:deleted-at deleted-at}
                   {:id profile-id})
 
-      (rph/with-transform {} (session/delete-fn session)))))
-
-(def sql:owned-teams
-  "with owner_teams as (
-      select tpr.team_id as id
-        from team_profile_rel as tpr
-       where tpr.is_owner is true
-         and tpr.profile_id = ?
-   )
-   select tpr.team_id as id,
-          count(tpr.profile_id) - 1 as participants
-     from team_profile_rel as tpr
-    where tpr.team_id in (select id from owner_teams)
-      and tpr.profile_id != ?
-    group by 1")
-
-(defn- get-owned-teams-with-participants
-  [conn profile-id]
-  (db/exec! conn [sql:owned-teams profile-id profile-id]))
+      (rph/with-transform {} (session/delete-fn cfg)))))

backend/src/app/rpc/mutations/projects.clj

@@ -10,10 +10,10 @@
    [app.db :as db]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
+   [app.rpc.commands.projects :as projects]
    [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
-   [app.rpc.queries.projects :as proj]
    [app.rpc.quotes :as quotes]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -34,6 +34,7 @@
 
 (sv/defmethod ::create-project
   {::doc/added "1.0"
+   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
   (db/with-atomic [conn pool]
@@ -70,12 +71,13 @@
 
 (sv/defmethod ::update-project-pin
   {::doc/added "1.0"
+   ::doc/deprecated "1.18"
    ::webhooks/batch-timeout (dt/duration "5s")
    ::webhooks/batch-key :id
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id profile-id team-id is-pinned] :as params}]
   (db/with-atomic [conn pool]
-    (proj/check-edition-permissions! conn profile-id id)
+    (projects/check-edition-permissions! conn profile-id id)
     (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
     nil))
 
@@ -88,10 +90,11 @@
 
 (sv/defmethod ::rename-project
   {::doc/added "1.0"
+   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id profile-id name] :as params}]
   (db/with-atomic [conn pool]
-    (proj/check-edition-permissions! conn profile-id id)
+    (projects/check-edition-permissions! conn profile-id id)
     (let [project (db/get-by-id conn :project id)]
       (db/update! conn :project
                   {:name name}
@@ -112,10 +115,11 @@
 
 (sv/defmethod ::delete-project
   {::doc/added "1.0"
+   ::doc/deprecated "1.18"
    ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (proj/check-edition-permissions! conn profile-id id)
+    (projects/check-edition-permissions! conn profile-id id)
     (let [project (db/update! conn :project
                               {:deleted-at (dt/now)}
                               {:id id :is-default false})]

backend/src/app/rpc/mutations/share_link.clj

@@ -11,6 +11,7 @@
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.rpc.commands.files :as files]
+   [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
@@ -35,8 +36,9 @@
 
   Share links are resources that allows external users access to specific
   pages of a file with specific permissions (who-comment and who-inspect)."
-
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  {::doc/added "1.5"
+   ::doc/deprecated "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (create-share-link conn params)))
@@ -51,18 +53,17 @@
                            :who-inspect who-inspect
                            :pages pages
                            :owner-id profile-id})]
-    (-> slink
-        (update :pages db/decode-pgarray #{}))))
+    (update slink :pages db/decode-pgarray #{})))
 
 ;; --- Mutation: Delete Share Link
 
-(declare delete-share-link)
-
 (s/def ::delete-share-link
   (s/keys :req-un [::profile-id ::id]))
 
 (sv/defmethod ::delete-share-link
-  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  {::doc/added "1.5"
+   ::doc/deprecated "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (let [slink (db/get-by-id conn :share-link id)]
       (files/check-edition-permissions! conn profile-id (:file-id slink))

backend/src/app/rpc/mutations/teams.clj

@@ -1,240 +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/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.rpc.mutations.teams
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.db :as db]
-   [app.emails :as eml]
-   [app.loggers.audit :as audit]
-   [app.media :as media]
-   [app.rpc.commands.teams :as cmd.teams]
-   [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]))
-
-;; --- Helpers & Specs
-
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
-(s/def ::profile-id ::us/uuid)
-
-;; --- Mutation: Create Team
-
-(s/def ::create-team ::cmd.teams/create-team)
-
-(sv/defmethod ::create-team
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} params]
-  (db/with-atomic [conn pool]
-    (cmd.teams/create-team conn params)))
-
-;; --- Mutation: Update Team
-
-(s/def ::update-team ::cmd.teams/update-team)
-
-(sv/defmethod ::update-team
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [id name profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (cmd.teams/check-edition-permissions! conn profile-id id)
-    (db/update! conn :team
-                {:name name}
-                {:id id})
-    nil))
-
-;; --- Mutation: Leave Team
-
-(s/def ::leave-team ::cmd.teams/leave-team)
-
-(sv/defmethod ::leave-team
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} params]
-  (db/with-atomic [conn pool]
-    (cmd.teams/leave-team conn params)))
-
-;; --- Mutation: Delete Team
-
-(s/def ::delete-team ::cmd.teams/delete-team)
-
-(sv/defmethod ::delete-team
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [id profile-id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (cmd.teams/get-permissions conn profile-id id)]
-      (when-not (:is-owner perms)
-        (ex/raise :type :validation
-                  :code :only-owner-can-delete-team))
-      (db/update! conn :team
-                  {:deleted-at (dt/now)}
-                  {:id id :is-default false})
-      nil)))
-
-
-;; --- Mutation: Team Update Role
-
-(s/def ::update-team-member-role ::cmd.teams/update-team-member-role)
-
-(sv/defmethod ::update-team-member-role
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} params]
-  (db/with-atomic [conn pool]
-    (cmd.teams/update-team-member-role conn params)))
-
-;; --- Mutation: Delete Team Member
-
-(s/def ::delete-team-member ::cmd.teams/delete-team-member)
-
-(sv/defmethod ::delete-team-member
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (cmd.teams/get-permissions conn profile-id team-id)]
-      (when-not (or (:is-owner perms)
-                    (:is-admin perms))
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
-      (when (= member-id profile-id)
-        (ex/raise :type :validation
-                  :code :cant-remove-yourself))
-
-      (db/delete! conn :team-profile-rel {:profile-id member-id
-                                          :team-id team-id})
-
-      nil)))
-
-;; --- Mutation: Update Team Photo
-
-(s/def ::update-team-photo ::cmd.teams/update-team-photo)
-
-(sv/defmethod ::update-team-photo
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [cfg {:keys [file] :as params}]
-  ;; Validate incoming mime type
-  (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
-  (let [cfg (update cfg :storage media/configure-assets-storage)]
-    (cmd.teams/update-team-photo cfg params)))
-
-;; --- Mutation: Invite Member
-
-(s/def ::invite-team-member ::cmd.teams/create-team-invitations)
-
-(sv/defmethod ::invite-team-member
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id team-id email emails role] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms    (cmd.teams/get-permissions conn profile-id team-id)
-          profile  (db/get-by-id conn :profile profile-id)
-          team     (db/get-by-id conn :team team-id)
-          emails   (cond-> (or emails #{}) (string? email) (conj email))]
-
-      (when-not (:is-admin perms)
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
-
-      ;; First check if the current profile is allowed to send emails.
-      (when-not (eml/allow-send-emails? conn profile)
-        (ex/raise :type :validation
-                  :code :profile-is-muted
-                  :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
-
-      (let [cfg         (assoc cfg ::cmd.teams/conn conn)
-            invitations (->> emails
-                             (map (fn [email]
-                                    {:email (str/lower email)
-                                     :team team
-                                     :profile profile
-                                     :role role}))
-                             (map (partial #'cmd.teams/create-invitation cfg)))]
-        (with-meta (vec invitations)
-          {::audit/props {:invitations (count invitations)}})))))
-
-;; --- Mutation: Create Team & Invite Members
-
-(s/def ::create-team-and-invite-members ::cmd.teams/create-team-with-invitations)
-
-(sv/defmethod ::create-team-and-invite-members
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id emails role] :as params}]
-  (db/with-atomic [conn pool]
-    (let [team     (cmd.teams/create-team conn params)
-          profile  (db/get-by-id conn :profile profile-id)
-          cfg      (assoc cfg ::cmd.teams/conn conn)]
-
-      ;; Create invitations for all provided emails.
-      (->> emails
-           (map (fn [email]
-                  {:team team
-                   :profile profile
-                   :email (str/lower email)
-                   :role role}))
-           (run! (partial #'cmd.teams/create-invitation cfg)))
-
-      (-> team
-          (vary-meta assoc ::audit/props {:invitations (count emails)})
-          (rph/with-defer
-            #(when-let [collector (::audit/collector cfg)]
-               (audit/submit! collector
-                              {:type "mutation"
-                               :name "invite-team-member"
-                               :profile-id profile-id
-                               :props {:emails emails
-                                       :role role
-                                       :profile-id profile-id
-                                       :invitations (count emails)}})))))))
-
-;; --- Mutation: Update invitation role
-
-(s/def ::update-team-invitation-role
-  (s/keys :req-un [::profile-id ::team-id ::email ::role]))
-
-(sv/defmethod ::update-team-invitation-role
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id team-id email role] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (cmd.teams/get-permissions conn profile-id team-id)]
-
-      (when-not (:is-admin perms)
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
-
-      (db/update! conn :team-invitation
-                  {:role (name role) :updated-at (dt/now)}
-                  {:team-id team-id :email-to (str/lower email)})
-      nil)))
-
-;; --- Mutation: Delete invitation
-
-(s/def ::delete-team-invitation ::cmd.teams/delete-team-invitation)
-
-(sv/defmethod ::delete-team-invitation
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [::db/pool] :as cfg} {:keys [profile-id team-id email] :as params}]
-  (db/with-atomic [conn pool]
-    (let [perms (cmd.teams/get-permissions conn profile-id team-id)]
-
-      (when-not (:is-admin perms)
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
-
-      (db/delete! conn :team-invitation
-                {:team-id team-id :email-to (str/lower email)})
-      nil)))

backend/src/app/rpc/queries/files.clj

@@ -1,183 +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/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.rpc.queries.files
-  (:require
-   [app.common.spec :as us]
-   [app.db :as db]
-   [app.rpc.commands.files :as files]
-   [app.rpc.commands.search :as search]
-   [app.rpc.commands.teams :as teams]
-   [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
-   [app.rpc.queries.projects :as projects]
-   [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
-
-;; --- Query: Project Files
-
-(s/def ::project-files ::files/get-project-files)
-
-(sv/defmethod ::project-files
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{: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)
-    (files/get-project-files conn project-id)))
-
-;; --- Query: File (By ID)
-
-(s/def ::components-v2 ::us/boolean)
-(s/def ::file
-  (s/and ::files/get-file
-         (s/keys :opt-un [::components-v2])))
-
-(defn get-file
-  [conn id features]
-  (let [file   (files/get-file conn id features)
-        thumbs (files/get-object-thumbnails conn id)]
-    (assoc file :thumbnails thumbs)))
-
-(sv/defmethod ::file
-  "Retrieve a file by its ID. Only authenticated users."
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id id features components-v2] :as params}]
-  (with-open [conn (db/open pool)]
-    (let [perms    (files/get-permissions pool profile-id id)
-          ;; BACKWARD COMPATIBILTY with the components-v2 parameter
-          features (cond-> (or features #{})
-                     components-v2 (conj "components/v2"))]
-
-      (files/check-read-permissions! perms)
-      (-> (get-file conn id features)
-          (assoc :permissions perms)))))
-
-;; --- QUERY: page
-
-(s/def ::page
-  (s/and ::files/get-page
-         (s/keys :opt-un [::components-v2])))
-
-(sv/defmethod ::page
-  "Retrieves the page data from file and returns it. If no page-id is
-  specified, the first page will be returned. If object-id is
-  specified, only that object and its children will be returned in the
-  page objects data structure.
-
-  If you specify the object-id, the page-id parameter becomes
-  mandatory.
-
-  Mainly used for rendering purposes."
-  {::doc/added "1.5"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id features components-v2] :as params}]
-  (with-open [conn (db/open pool)]
-    (files/check-read-permissions! conn profile-id file-id)
-    (let [;; BACKWARD COMPATIBILTY with the components-v2 parameter
-          features (cond-> (or features #{})
-                     components-v2 (conj "components/v2"))
-          params   (assoc params :features features)]
-
-      (files/get-page conn params))))
-
-;; --- QUERY: file-data-for-thumbnail
-
-(s/def ::file-data-for-thumbnail
-  (s/and ::files/get-file-data-for-thumbnail
-         (s/keys :opt-un [::components-v2])))
-
-(sv/defmethod ::file-data-for-thumbnail
-  "Retrieves the data for generate the thumbnail of the file. Used
-  mainly for render thumbnails on dashboard."
-  {::doc/added "1.11"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id features components-v2] :as props}]
-  (with-open [conn (db/open pool)]
-    (files/check-read-permissions! conn profile-id file-id)
-    (let [;; BACKWARD COMPATIBILTY with the components-v2 parameter
-          features (cond-> (or features #{})
-                     components-v2 (conj "components/v2"))
-          file     (files/get-file conn file-id features)]
-      {:file-id file-id
-       :revn (:revn file)
-       :page (files/get-file-data-for-thumbnail conn file)})))
-
-;; --- Query: Shared Library Files
-
-(s/def ::team-shared-files ::files/get-team-shared-files)
-
-(sv/defmethod ::team-shared-files
-  {::doc/added "1.3"
-   ::doc/deprecated "1.17"}
-  [{: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)
-    (files/get-team-shared-files conn params)))
-
-
-;; --- Query: File Libraries used by a File
-
-(s/def ::file-libraries ::files/get-file-libraries)
-
-(sv/defmethod ::file-libraries
-  {::doc/added "1.3"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id features] :as params}]
-  (with-open [conn (db/open pool)]
-    (files/check-read-permissions! conn profile-id file-id)
-    (files/get-file-libraries conn file-id features)))
-
-
-;; --- Query: Files that use this File library
-
-(s/def ::library-using-files ::files/get-library-file-references)
-
-(sv/defmethod ::library-using-files
-  {::doc/added "1.13"
-   ::doc/deprecated "1.17"}
-  [{: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)
-    (files/get-library-file-references conn file-id)))
-
-;; --- QUERY: team-recent-files
-
-(s/def ::team-recent-files ::files/get-team-recent-files)
-
-(sv/defmethod ::team-recent-files
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
-  (with-open [conn (db/open pool)]
-    (teams/check-read-permissions! conn profile-id team-id)
-    (files/get-team-recent-files conn team-id)))
-
-
-;; --- QUERY: get file thumbnail
-
-(s/def ::file-thumbnail ::files/get-file-thumbnail)
-
-(sv/defmethod ::file-thumbnail
-  {::doc/added "1.13"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool]} {:keys [profile-id file-id revn]}]
-  (with-open [conn (db/open pool)]
-    (files/check-read-permissions! conn profile-id file-id)
-    (-> (files/get-file-thumbnail conn file-id revn)
-        (rph/with-http-cache files/long-cache-duration))))
-
-
-;; --- QUERY: search files
-
-(s/def ::search-files ::search/search-files)
-
-(sv/defmethod ::search-files
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool]} {:keys [profile-id team-id search-term]}]
-  (some->> search-term (search/search-files pool profile-id team-id)))

backend/src/app/rpc/queries/fonts.clj

@@ -9,9 +9,9 @@
    [app.common.spec :as us]
    [app.db :as db]
    [app.rpc.commands.files :as files]
+   [app.rpc.commands.projects :as projects]
    [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.queries.projects :as projects]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 

backend/src/app/rpc/queries/profile.clj

@@ -6,112 +6,27 @@
 
 (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.rpc :as-alias rpc]
+   [app.rpc.commands.profile :as profile]
+   [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]))
+   [clojure.spec.alpha :as s]))
 
-;; --- Helpers & Specs
-
-(declare strip-private-attrs)
-
-(s/def ::email ::us/email)
-(s/def ::fullname ::us/string)
-(s/def ::old-password ::us/string)
-(s/def ::password ::us/string)
-(s/def ::path ::us/string)
-(s/def ::user ::us/uuid)
-(s/def ::profile-id ::us/uuid)
-(s/def ::theme ::us/string)
-
-;; --- Query: Profile (own)
-
-(declare retrieve-profile)
-(declare retrieve-additional-data)
-
-(s/def ::profile
-  (s/keys :opt-un [::profile-id]))
+(s/def ::profile ::profile/get-profile)
 
 (sv/defmethod ::profile
-  {::rpc/auth false}
-  [{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
+  {::rpc/auth false
+   ::doc/added "1.0"
+   ::doc/deprecated "1.18"}
+  [{:keys [::db/pool] :as cfg} {:keys [profile-id]}]
   ;; We need to return the anonymous profile object in two cases, when
   ;; no profile-id is in session, and when db call raises not found. In all other
   ;; cases we need to reraise the exception.
-  (or (ex/try*
-       #(some->> profile-id (retrieve-profile pool))
-       #(when (not= :not-found (:type (ex-data %))) (throw %)))
-      {:id uuid/zero
-       :fullname "Anonymous User"}))
-
-(def ^:private sql:default-profile-team
-  "select t.id, name
-     from team as t
-    inner join team_profile_rel as tp on (tp.team_id = t.id)
-    where tp.profile_id = ?
-      and tp.is_owner is true
-      and t.is_default is true")
-
-(def ^:private sql:default-profile-project
-  "select p.id, name
-     from project as p
-    inner join project_profile_rel as tp on (tp.project_id = p.id)
-    where tp.profile_id = ?
-      and tp.is_owner is true
-      and p.is_default is true
-      and p.team_id = ?")
-
-(defn retrieve-additional-data
-  [conn id]
-  (let [team    (db/exec-one! conn [sql:default-profile-team id])
-        project (db/exec-one! conn [sql:default-profile-project id (:id team)])]
-    {:default-team-id (:id team)
-     :default-project-id (:id project)}))
-
-(defn populate-additional-data
-  [conn profile]
-  (merge profile (retrieve-additional-data conn (:id profile))))
-
-(defn filter-profile-props
-  [props]
-  (into {} (filter (fn [[k _]] (simple-ident? k))) props))
-
-(defn decode-profile-row
-  [{:keys [props] :as row}]
-  (cond-> row
-    (db/pgobject? props "jsonb")
-    (assoc :props (db/decode-transit-pgobject props))))
-
-(defn retrieve-profile-data
-  [conn id]
-  (-> (db/get-by-id conn :profile id)
-      (decode-profile-row)))
-
-(defn retrieve-profile
-  [conn id]
-  (let [profile (->> (retrieve-profile-data conn id)
-                     (strip-private-attrs)
-                     (populate-additional-data conn))]
-    (update profile :props filter-profile-props)))
-
-(def ^:private sql:profile-by-email
-  "select p.* from profile as p
-    where p.email = ?
-      and (p.deleted_at is null or
-           p.deleted_at > now())")
-
-(defn retrieve-profile-data-by-email
-  [conn email]
-  (ex/ignoring
-   (db/exec-one! conn [sql:profile-by-email (str/lower email)])))
-
-;; --- Attrs Helpers
-
-(defn strip-private-attrs
-  "Only selects a publicly visible profile attrs."
-  [row]
-  (dissoc row :password :deleted-at))
+  (try
+    (-> (profile/get-profile pool profile-id)
+        (profile/strip-private-attrs)
+        (update :props profile/filter-props))
+    (catch Throwable _
+      {:id uuid/zero :fullname "Anonymous User"})))

backend/src/app/rpc/queries/projects.clj

@@ -8,135 +8,39 @@
   (:require
    [app.common.spec :as us]
    [app.db :as db]
+   [app.rpc.commands.projects :as projects]
    [app.rpc.commands.teams :as teams]
-   [app.rpc.permissions :as perms]
+   [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
-;; --- Check Project Permissions
-
-(def ^:private sql:project-permissions
-  "select tpr.is_owner,
-          tpr.is_admin,
-          tpr.can_edit
-     from team_profile_rel as tpr
-    inner join project as p on (p.team_id = tpr.team_id)
-    where p.id = ?
-      and tpr.profile_id = ?
-   union all
-   select ppr.is_owner,
-          ppr.is_admin,
-          ppr.can_edit
-     from project_profile_rel as ppr
-    where ppr.project_id = ?
-      and ppr.profile_id = ?")
-
-(defn- get-permissions
-  [conn profile-id project-id]
-  (let [rows     (db/exec! conn [sql:project-permissions
-                                 project-id profile-id
-                                 project-id profile-id])
-        is-owner (boolean (some :is-owner rows))
-        is-admin (boolean (some :is-admin rows))
-        can-edit (boolean (some :can-edit rows))]
-     (when (seq rows)
-       {:is-owner is-owner
-        :is-admin (or is-owner is-admin)
-        :can-edit (or is-owner is-admin can-edit)
-        :can-read true})))
-
-(def has-edit-permissions?
-  (perms/make-edition-predicate-fn get-permissions))
-
-(def has-read-permissions?
-  (perms/make-read-predicate-fn get-permissions))
-
-(def check-edition-permissions!
-  (perms/make-check-fn has-edit-permissions?))
-
-(def check-read-permissions!
-  (perms/make-check-fn has-read-permissions?))
-
 ;; --- Query: Projects
 
-(declare retrieve-projects)
-
 (s/def ::team-id ::us/uuid)
 (s/def ::profile-id ::us/uuid)
 (s/def ::projects
   (s/keys :req-un [::profile-id ::team-id]))
 
 (sv/defmethod ::projects
+  {::doc/added "1.0"
+   ::doc/deprecated "1.18"}
   [{: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)))
-
-(def sql:projects
-  "select p.*,
-          coalesce(tpp.is_pinned, false) as is_pinned,
-          (select count(*) from file as f
-            where f.project_id = p.id
-              and deleted_at is null) as count
-     from project as p
-    inner join team as t on (t.id = p.team_id)
-     left join team_project_profile_rel as tpp
-            on (tpp.project_id = p.id and
-                tpp.team_id = p.team_id and
-                tpp.profile_id = ?)
-    where p.team_id = ?
-      and p.deleted_at is null
-      and t.deleted_at is null
-    order by p.modified_at desc")
-
-(defn retrieve-projects
-  [conn profile-id team-id]
-  (db/exec! conn [sql:projects profile-id team-id]))
-
+    (projects/get-projects conn profile-id team-id)))
 
 ;; --- Query: All projects
 
-(declare retrieve-all-projects)
-
 (s/def ::profile-id ::us/uuid)
 (s/def ::all-projects
   (s/keys :req-un [::profile-id]))
 
 (sv/defmethod ::all-projects
+  {::doc/added "1.0"
+   ::doc/deprecated "1.18"}
   [{:keys [pool]} {:keys [profile-id]}]
   (with-open [conn (db/open pool)]
-    (retrieve-all-projects conn profile-id)))
-
-(def sql:all-projects
-  "select p1.*, t.name as team_name, t.is_default as is_default_team
-     from project as p1
-    inner join team as t on (t.id = p1.team_id)
-    where t.id in (select team_id
-                     from team_profile_rel as tpr
-                    where tpr.profile_id = ?
-                      and (tpr.can_edit = true or
-                           tpr.is_owner = true or
-                           tpr.is_admin = true))
-      and t.deleted_at is null
-      and p1.deleted_at is null
-   union
-   select p2.*, t.name as team_name, t.is_default as is_default_team
-     from project as p2
-    inner join team as t on (t.id = p2.team_id)
-    where p2.id in (select project_id
-                     from project_profile_rel as ppr
-                    where ppr.profile_id = ?
-                      and (ppr.can_edit = true or
-                           ppr.is_owner = true or
-                           ppr.is_admin = true))
-      and t.deleted_at is null
-      and p2.deleted_at is null
-    order by team_name, name;")
-
-(defn retrieve-all-projects
-  [conn profile-id]
-  (db/exec! conn [sql:all-projects profile-id profile-id]))
-
+    (projects/get-all-projects conn profile-id)))
 
 ;; --- Query: Project
 
@@ -145,9 +49,11 @@
   (s/keys :req-un [::profile-id ::id]))
 
 (sv/defmethod ::project
+  {::doc/added "1.0"
+   ::doc/deprecated "1.18"}
   [{: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)
+      (projects/check-read-permissions! conn profile-id id)
       project)))
 

backend/src/app/rpc/queries/share_link.clj

@@ -1,23 +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/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.rpc.queries.share-link
-  (:require
-   [app.db :as db]))
-
-(defn decode-share-link-row
-  [row]
-  (-> row
-      (dissoc :flags)
-      (update :pages db/decode-pgarray #{})))
-
-(defn retrieve-share-link
-  [conn file-id share-id]
-  (some-> (db/get-by-params conn :share-link
-                            {:id share-id :file-id file-id}
-                            {:check-not-found false})
-          (decode-share-link-row)))
-

backend/src/app/rpc/queries/teams.clj

@@ -1,87 +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/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.rpc.queries.teams
-  (:require
-   [app.db :as db]
-   [app.rpc.commands.teams :as cmd.teams]
-   [app.rpc.doc :as-alias doc]
-   [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
-
-;; --- Query: Teams
-
-(s/def ::teams ::cmd.teams/get-teams)
-
-(sv/defmethod ::teams
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id]}]
-  (with-open [conn (db/open pool)]
-    (cmd.teams/retrieve-teams conn profile-id)))
-
-;; --- Query: Team (by ID)
-
-(s/def ::team ::cmd.teams/get-team)
-
-(sv/defmethod ::team
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id id]}]
-  (with-open [conn (db/open pool)]
-    (cmd.teams/retrieve-team conn profile-id id)))
-
-;; --- Query: Team Members
-
-(s/def ::team-members ::cmd.teams/get-team-members)
-
-(sv/defmethod ::team-members
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
-  (with-open [conn (db/open pool)]
-    (cmd.teams/check-read-permissions! conn profile-id team-id)
-    (cmd.teams/retrieve-team-members conn team-id)))
-
-;; --- Query: Team Users
-(s/def ::team-users ::cmd.teams/get-team-users)
-
-(sv/defmethod ::team-users
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id team-id file-id]}]
-  (with-open [conn (db/open pool)]
-    (if team-id
-      (do
-        (cmd.teams/check-read-permissions! conn profile-id team-id)
-        (cmd.teams/retrieve-users conn team-id))
-      (let [{team-id :id} (cmd.teams/retrieve-team-for-file conn file-id)]
-        (cmd.teams/check-read-permissions! conn profile-id team-id)
-        (cmd.teams/retrieve-users conn team-id)))))
-
-;; --- Query: Team Stats
-
-(s/def ::team-stats ::cmd.teams/get-team-stats)
-
-(sv/defmethod ::team-stats
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
-  (with-open [conn (db/open pool)]
-    (cmd.teams/check-read-permissions! conn profile-id team-id)
-    (cmd.teams/retrieve-team-stats conn team-id)))
-
-;; --- Query: Team invitations
-
-(s/def ::team-invitations ::cmd.teams/get-team-invitations)
-
-(sv/defmethod ::team-invitations
-  {::doc/added "1.0"
-   ::doc/deprecated "1.17"}
-  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
-  (with-open [conn (db/open pool)]
-    (cmd.teams/check-read-permissions! conn profile-id team-id)
-    (cmd.teams/get-team-invitations conn team-id)))

backend/src/app/rpc/queries/viewer.clj

@@ -22,7 +22,7 @@
 (sv/defmethod ::view-only-bundle
   {::rpc/auth false
    ::doc/added "1.3"
-   ::doc/deprecated "1.17"}
+   ::doc/deprecated "1.18"}
   [{:keys [pool] :as cfg} {:keys [features components-v2] :as params}]
   (with-open [conn (db/open pool)]
     (let [;; BACKWARD COMPATIBILTY with the components-v2 parameter

backend/src/app/rpc/quotes.clj

@@ -160,6 +160,28 @@
       (assoc ::count-sql [sql:get-teams-per-profile profile-id])
       (generic-check!)))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; QUOTE: ACCESS-TOKENS-PER-PROFILE
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private sql:get-access-tokens-per-profile
+  "select count(*) as total
+     from access_token
+    where profile_id = ?")
+
+(s/def ::access-tokens-per-profile
+  (s/keys :req [::profile-id ::target]))
+
+(defmethod check-quote ::access-tokens-per-profile
+  [{:keys [::profile-id ::target] :as quote}]
+  (us/assert! ::access-tokens-per-profile quote)
+  (-> quote
+      (assoc ::default (cf/get :quotes-access-tokens-per-profile Integer/MAX_VALUE))
+      (assoc ::quote-sql [sql:get-quotes-1 target profile-id])
+      (assoc ::count-sql [sql:get-access-tokens-per-profile profile-id])
+      (generic-check!)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: PROJECTS-PER-TEAM
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -279,7 +301,6 @@
       (assoc ::count-sql [sql:get-files-per-project project-id])
       (generic-check!)))
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: COMMENT-THREADS-PER-FILE
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/app/rpc/rlimit.clj

@@ -52,7 +52,7 @@
    [app.config :as cf]
    [app.http :as-alias http]
    [app.loggers.audit :refer [parse-client-ip]]
-   [app.redis :as redis]
+   [app.redis :as rds]
    [app.redis.script :as-alias rscript]
    [app.rpc :as-alias rpc]
    [app.rpc.rlimit.result :as-alias lresult]
@@ -71,7 +71,7 @@
   (dt/duration 400))
 
 (def ^:private default-options
-  {:codec redis/string-codec
+  {:codec rds/string-codec
    :timeout default-timeout})
 
 (def ^:private bucket-rate-limit-script
@@ -141,23 +141,23 @@
   (let [script (-> bucket-rate-limit-script
                    (assoc ::rscript/keys [(str key "." service "." user-id)])
                    (assoc ::rscript/vals (conj params (dt/->seconds now))))]
-    (-> (redis/eval! redis script)
-        (p/then (fn [result]
-                  (let [allowed?  (boolean (nth result 0))
-                        remaining (nth result 1)
-                        reset     (* (/ (inst-ms interval) rate)
-                                     (- capacity remaining))]
-                    (l/trace :hint "limit processed"
-                             :service service
-                             :limit (name (::name limit))
-                             :strategy (name (::strategy limit))
-                             :opts (::opts limit)
+    (->> (rds/eval! redis script)
+         (p/fmap (fn [result]
+                   (let [allowed?  (boolean (nth result 0))
+                         remaining (nth result 1)
+                         reset     (* (/ (inst-ms interval) rate)
+                                      (- capacity remaining))]
+                     (l/trace :hint "limit processed"
+                              :service service
+                              :limit (name (::name limit))
+                              :strategy (name (::strategy limit))
+                              :opts (::opts limit)
                              :allowed? allowed?
                              :remaining remaining)
-                    (-> limit
-                        (assoc ::lresult/allowed? allowed?)
-                        (assoc ::lresult/reset (dt/plus now reset))
-                        (assoc ::lresult/remaining remaining))))))))
+                     (-> limit
+                         (assoc ::lresult/allowed? allowed?)
+                         (assoc ::lresult/reset (dt/plus now reset))
+                         (assoc ::lresult/remaining remaining))))))))
 
 (defmethod process-limit :window
   [redis user-id now {:keys [::nreq ::unit ::key ::service] :as limit}]
@@ -166,94 +166,113 @@
         script (-> window-rate-limit-script
                    (assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))])
                    (assoc ::rscript/vals [nreq (dt/->seconds ttl)]))]
-    (-> (redis/eval! redis script)
-        (p/then (fn [result]
-                  (let [allowed?  (boolean (nth result 0))
-                        remaining (nth result 1)]
-                    (l/trace :hint "limit processed"
-                             :service service
-                             :limit (name (::name limit))
-                             :strategy (name (::strategy limit))
-                             :opts (::opts limit)
-                             :allowed? allowed?
+    (->> (rds/eval! redis script)
+         (p/fmap (fn [result]
+                   (let [allowed?  (boolean (nth result 0))
+                         remaining (nth result 1)]
+                     (l/trace :hint "limit processed"
+                              :service service
+                              :limit (name (::name limit))
+                              :strategy (name (::strategy limit))
+                              :opts (::opts limit)
+                              :allowed? allowed?
                              :remaining remaining)
-                    (-> limit
-                        (assoc ::lresult/allowed? allowed?)
-                        (assoc ::lresult/remaining remaining)
-                        (assoc ::lresult/reset (dt/plus ts {unit 1})))))))))
+                     (-> limit
+                         (assoc ::lresult/allowed? allowed?)
+                         (assoc ::lresult/remaining remaining)
+                         (assoc ::lresult/reset (dt/plus ts {unit 1})))))))))
 
-(defn- process-limits
+(defn- process-limits!
   [redis user-id limits now]
-  (-> (p/all (map (partial process-limit redis user-id now) limits))
-      (p/then (fn [results]
-                (let [remaining (->> results
-                                     (d/index-by ::name ::lresult/remaining)
-                                     (uri/map->query-string))
-                      reset     (->> results
-                                     (d/index-by ::name (comp dt/->seconds ::lresult/reset))
-                                     (uri/map->query-string))
-                      rejected  (->> results
-                                     (filter (complement ::lresult/allowed?))
-                                     (first))]
+  (->> (p/all (map (partial process-limit redis user-id now) limits))
+       (p/fmap (fn [results]
+                 (let [remaining (->> results
+                                      (d/index-by ::name ::lresult/remaining)
+                                      (uri/map->query-string))
+                       reset     (->> results
+                                      (d/index-by ::name (comp dt/->seconds ::lresult/reset))
+                                      (uri/map->query-string))
+                       rejected  (->> results
+                                      (filter (complement ::lresult/allowed?))
+                                      (first))]
 
-                  (when rejected
-                    (l/warn :hint "rejected rate limit"
-                            :user-id (str user-id)
-                            :limit-service (-> rejected ::service name)
-                            :limit-name (-> rejected ::name name)
-                            :limit-strategy (-> rejected ::strategy name)))
+                   (when rejected
+                     (l/warn :hint "rejected rate limit"
+                             :user-id (str user-id)
+                             :limit-service (-> rejected ::service name)
+                             :limit-name (-> rejected ::name name)
+                             :limit-strategy (-> rejected ::strategy name)))
 
-                  {:enabled? true
-                   :allowed? (not (some? rejected))
-                   :headers  {"x-rate-limit-remaining" remaining
-                              "x-rate-limit-reset" reset}})))))
+                   {:enabled? true
+                    :allowed? (not (some? rejected))
+                    :headers  {"x-rate-limit-remaining" remaining
+                               "x-rate-limit-reset" reset}})))))
 
 (defn- handle-response
   [f cfg params result]
   (if (:enabled? result)
     (let [headers (:headers result)]
-      (when-not (:allowed? result)
-        (ex/raise :type :rate-limit
-                  :code :request-blocked
-                  :hint "rate limit reached"
-                  ::http/headers headers))
-      (-> (f cfg params)
-          (p/then (fn [response]
-                    (vary-meta response update ::http/headers merge headers)))))
+      (if (:allowed? result)
+        (->> (f cfg params)
+             (p/fmap (fn [response]
+                       (vary-meta response update ::http/headers merge headers))))
+        (p/rejected
+         (ex/error :type :rate-limit
+                   :code :request-blocked
+                   :hint "rate limit reached"
+                   ::http/headers headers))))
     (f cfg params)))
 
+(defn- get-limits
+  [state skey sname]
+  (some->> (or (get-in @state [::limits skey])
+               (get-in @state [::limits :default]))
+           (map #(assoc % ::service sname))
+           (seq)))
+
+(defn- get-uid
+  [{:keys [::http/request] :as params}]
+  (or (::rpc/profile-id params)
+      (some-> request parse-client-ip)
+      uuid/zero))
+
 (defn wrap
-  [{:keys [rlimit redis] :as cfg} f mdata]
+  [{:keys [::rpc/rlimit ::rds/redis] :as cfg} f mdata]
+  (us/assert! ::rpc/rlimit rlimit)
+  (us/assert! ::rds/redis redis)
+
   (if rlimit
     (let [skey  (keyword (::rpc/type cfg) (->> mdata ::sv/spec name))
           sname (str (::rpc/type cfg) "." (->> mdata ::sv/spec name))]
-      (fn [cfg {:keys [::http/request] :as params}]
-        (let [uid (or (:profile-id params)
-                      (some-> request parse-client-ip)
-                      uuid/zero)
 
-              rsp (when (and uid @enabled?)
-                    (when-let [limits (or (get-in @rlimit [::limits skey])
-                                          (get-in @rlimit [::limits :default]))]
-                      (let [redis  (redis/get-or-connect redis ::rlimit default-options)
-                            limits (map #(assoc % ::service sname) limits)
-                            resp   (-> (process-limits redis uid limits (dt/now))
-                                       (p/catch (fn [cause]
-                                                  ;; If we have an error on processing the rate-limit we just skip
-                                                  ;; it for do not cause service interruption because of redis
-                                                  ;; downtime or similar situation.
-                                                  (l/error :hint "error on processing rate-limit" :cause cause)
-                                                  {:enabled? false})))]
+      (fn [cfg params]
+        (if @enabled?
+          (try
+            (let [uid (get-uid params)
+                  rsp (when-let [limits (get-limits rlimit skey sname)]
+                        (let [redis (rds/get-or-connect redis ::rpc/rlimit default-options)
+                              rsp   (->> (process-limits! redis uid limits (dt/now))
+                                         (p/merr (fn [cause]
+                                                   ;; If we have an error on processing the rate-limit we just skip
+                                                   ;; it for do not cause service interruption because of redis
+                                                   ;; downtime or similar situation.
+                                                   (l/error :hint "error on processing rate-limit" :cause cause)
+                                                   (p/resolved {:enabled? false}))))]
 
-                        ;; If soft rate are enabled, we process the rate-limit but return unprotected
-                        ;; response.
-                        (if (contains? cf/flags :soft-rpc-rlimit)
-                          (p/resolved {:enabled? false})
-                          resp))))
+                          ;; If soft rate are enabled, we process the rate-limit but return unprotected
+                          ;; response.
+                          (if (contains? cf/flags :soft-rpc-rlimit)
+                            {:enabled? false}
+                            rsp)))]
 
-              rsp (or rsp (p/resolved {:enabled? false}))]
+              (->> (p/promise rsp)
+                   (p/fmap #(or % {:enabled? false}))
+                   (p/mcat #(handle-response f cfg params %))))
 
-          (p/then rsp (partial handle-response f cfg params)))))
+            (catch Throwable cause
+              (p/rejected cause)))
+
+          (f cfg params))))
     f))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -289,8 +308,9 @@
          (s/keys :req [::nreq
                        ::unit]))))
 
-(s/def ::rlimit
-  #(instance? clojure.lang.Agent %))
+(s/def ::rpc/rlimit
+  (s/nilable
+   #(instance? clojure.lang.Agent %)))
 
 (s/def ::config
   (s/map-of (s/or :kw keyword? :set set?)
@@ -332,7 +352,7 @@
          ::limits limits}))))
 
 (defn- refresh-config
-  [{:keys [state path executor scheduled-executor] :as params}]
+  [{:keys [::state ::path ::wrk/executor ::wrk/scheduled-executor] :as cfg}]
   (letfn [(update-config [{:keys [::updated-at] :as state}]
             (let [updated-at' (fs/last-modified-time path)]
               (merge state
@@ -349,7 +369,7 @@
           (schedule-next [state]
             (px/schedule! scheduled-executor
                           (inst-ms (::refresh state))
-                          (partial refresh-config params))
+                          (partial refresh-config cfg))
             state)]
 
     (send-via executor state update-config)
@@ -371,10 +391,11 @@
     (and (fs/exists? path) (fs/regular-file? path) path)))
 
 (defmethod ig/pre-init-spec :app.rpc/rlimit [_]
-  (s/keys :req-un [::wrk/executor ::wrk/scheduled-executor]))
+  (s/keys :req [::wrk/executor
+                ::wrk/scheduled-executor]))
 
 (defmethod ig/init-key ::rpc/rlimit
-  [_ {:keys [executor] :as params}]
+  [_ {:keys [::wrk/executor] :as cfg}]
   (when (contains? cf/flags :rpc-rlimit)
     (let [state (agent {})]
       (set-error-handler! state on-refresh-error)
@@ -387,6 +408,6 @@
         (send-via executor state (constantly {::refresh (dt/duration "5s")}))
 
         ;; Force a refresh
-        (refresh-config (assoc params :path path :state state)))
+        (refresh-config (assoc cfg ::path path ::state state)))
 
       state)))

backend/src/app/srepl.clj

@@ -9,7 +9,11 @@
   (:require
    [app.common.logging :as l]
    [app.common.spec :as us]
+   [app.config :as cf]
+   [app.srepl.ext]
    [app.srepl.main]
+   [app.util.json :as json]
+   [app.util.locks :as locks]
    [clojure.core.server :as ccs]
    [clojure.main :as cm]
    [clojure.spec.alpha :as s]
@@ -20,39 +24,59 @@
   (ccs/repl-init)
   (in-ns 'app.srepl.main))
 
-(defn repl
+(defn user-repl
   []
   (cm/repl
    :init repl-init
    :read ccs/repl-read))
 
+(defn json-prepl
+  []
+  (let [out  *out*
+        lock (locks/create)]
+    (ccs/prepl *in*
+               (fn [m]
+                 (binding [*out* out, *flush-on-newline* true, *print-readably* true]
+                   (locks/locking lock
+                     (println (json/encode-str m))))))))
+
 ;; --- State initialization
 
-(s/def ::name ::us/not-empty-string)
-(s/def ::port int?)
+(s/def ::port ::us/integer)
 (s/def ::host ::us/not-empty-string)
+(s/def ::flag #{:urepl-server :prepl-server})
+(s/def ::type #{::prepl ::urepl})
+(s/def ::key (s/tuple ::type ::us/keyword))
 
 (defmethod ig/pre-init-spec ::server
   [_]
-  (s/keys :opt-un [::port ::host ::name]))
+  (s/keys :req [::flag]
+          :req-un [::port ::host]))
 
 (defmethod ig/prep-key ::server
-  [_ cfg]
-  (merge {:name "main"} cfg))
+  [[type _] cfg]
+  (assoc cfg ::flag (keyword (str (name type) "-server"))))
 
 (defmethod ig/init-key ::server
-  [_ {:keys [port host name] :as cfg}]
-  (when (and port host name)
-    (l/info :msg "initializing server repl" :port port :host host :name name)
-    (ccs/start-server {:address host
-                       :port port
-                       :name name
-                       :accept 'app.srepl/repl})
-    cfg))
+  [[type _] {:keys [::flag port host] :as cfg}]
+  (when (contains? cf/flags flag)
+    (let [accept (case type
+                   ::prepl 'app.srepl/json-prepl
+                   ::urepl 'app.srepl/user-repl)
+          params {:address host
+                  :port port
+                  :name (name type)
+                  :accept accept}]
+
+      (l/info :msg "initializing repl server"
+              :name (name type)
+              :port port
+              :host host)
+
+      (ccs/start-server params)
+
+      params)))
 
 (defmethod ig/halt-key! ::server
-  [_ cfg]
-  (when cfg
-    (ccs/stop-server (:name cfg))))
-
-
+  [_ params]
+  (some-> params :name ccs/stop-server))

backend/src/app/srepl/ext.clj

@@ -0,0 +1,42 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.srepl.ext
+  "PREPL API for external usage (CLI or ADMIN)"
+  (:require
+   [app.auth :as auth]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.rpc.commands.auth :as cmd.auth]))
+
+(defn- get-current-system
+  []
+  (or (deref (requiring-resolve 'app.main/system))
+      (deref (requiring-resolve 'user/system))))
+
+(defn derive-password
+  [password]
+  (auth/derive-password password))
+
+(defn create-profile
+  [fullname, email, password]
+  (when-let [system (get-current-system)]
+    (db/with-atomic [conn (:app.db/pool system)]
+      (let [params  {:id (uuid/next)
+                     :email email
+                     :fullname fullname
+                     :is-active true
+                     :password (derive-password password)
+                     :props {}}
+            profile (->> (cmd.auth/create-profile! conn params)
+                         (cmd.auth/create-profile-rels! conn))]
+        (str (:id profile))))))
+
+
+
+
+
+

backend/src/app/srepl/helpers.clj

@@ -70,7 +70,7 @@
   [system & {:keys [update-fn id save? migrate? inc-revn?]
              :or {save? false migrate? true inc-revn? true}}]
   (db/with-atomic [conn (:app.db/pool system)]
-    (let [file (-> (db/get-by-id conn :file id {:for-update true})
+    (let [file (-> (db/get-by-id conn :file id {::db/for-update? true})
                    (update :features db/decode-pgarray #{}))]
       (binding [*conn* conn
                 pmap/*tracked* (atom {})

backend/src/app/srepl/main.clj

@@ -12,8 +12,8 @@
    [app.common.pprint :as p]
    [app.common.spec :as us]
    [app.db :as db]
-   [app.rpc.commands.auth :as cmd.auth]
-   [app.rpc.queries.profile :as profile]
+   [app.rpc.commands.auth :as auth]
+   [app.rpc.commands.profile :as profile]
    [app.srepl.fixes :as f]
    [app.srepl.helpers :as h]
    [app.util.blob :as blob]
@@ -71,9 +71,9 @@
 
   (let [sprops  (:app.setup/props system)
         pool    (:app.db/pool system)
-        profile (profile/retrieve-profile-data-by-email pool email)]
+        profile (profile/get-profile-by-email pool email)]
 
-    (cmd.auth/send-email-verification! pool sprops profile)
+    (auth/send-email-verification! pool sprops profile)
     :email-sent))
 
 (defn mark-profile-as-active!
@@ -81,10 +81,9 @@
   associated with the profile-id."
   [system email]
   (db/with-atomic [conn (:app.db/pool system)]
-    (when-let [profile (db/get-by-params conn :profile
-                                         {:email (str/lower email)}
-                                         {:columns [:id :email]
-                                          :check-not-found false})]
+    (when-let [profile (db/get* conn :profile
+                                {:email (str/lower email)}
+                                {:columns [:id :email]})]
       (when-not (:is-blocked profile)
         (db/update! conn :profile {:is-active true} {:id (:id profile)})
         :activated))))
@@ -94,10 +93,9 @@
   associated with the profile-id."
   [system email]
   (db/with-atomic [conn (:app.db/pool system)]
-    (when-let [profile (db/get-by-params conn :profile
-                                         {:email (str/lower email)}
-                                         {:columns [:id :email]
-                                          :check-not-found false})]
+    (when-let [profile (db/get* conn :profile
+                                {:email (str/lower email)}
+                                {:columns [:id :email]})]
       (when-not (:is-blocked profile)
         (db/update! conn :profile {:is-blocked true} {:id (:id profile)})
         (db/delete! conn :http-session {:profile-id (:id profile)})

backend/src/app/storage.clj

@@ -188,7 +188,7 @@
           res (db/update! (or conn pool) :storage-object
                           {:touched-at (dt/now)}
                           {:id id}
-                          {:return-keys false})]
+                          {::db/return-keys? false})]
       (pos? (:next.jdbc/update-count res)))))
 
 (defn get-object-data
@@ -247,7 +247,7 @@
           res (db/update! (or conn pool) :storage-object
                           {:deleted-at (dt/now)}
                           {:id id}
-                          {:return-keys false})]
+                          {::db/return-keys? false})]
       (pos? (:next.jdbc/update-count res)))))
 
 (dm/export impl/resolve-backend)

backend/src/app/util/retry.clj

@@ -29,6 +29,6 @@
                          (throw cause#))))]
        (if (= ::retry result#)
          (do
-           (l/warn :hint "retrying operation" :label ~label)
+           (l/warn :hint "retrying operation" :label ~label :retry tnum#)
            (recur (inc tnum#)))
          result#))))

backend/src/app/util/websocket.clj

@@ -60,7 +60,7 @@
   (assert (fn? on-snd-message) "'on-snd-message' should be a function")
   (assert (fn? on-connect) "'on-connect' should be a function")
 
-  (fn [{:keys [::yws/channel session-id] :as request}]
+  (fn [{:keys [::yws/channel] :as request}]
     (let [input-ch   (a/chan input-buff-size)
           output-ch  (a/chan output-buff-size)
           hbeat-ch   (a/chan (a/sliding-buffer 6))
@@ -81,7 +81,6 @@
                                  ::stop-ch stop-ch
                                  ::channel channel
                                  ::remote-addr ip-addr
-                                 ::http-session-id session-id
                                  ::user-agent uagent})
                          (atom))
 

backend/src/app/worker.clj

@@ -45,7 +45,7 @@
 
 (defmethod ig/init-key ::executor
   [skey {:keys [::parallelism]}]
-  (let [prefix  (if (vector? skey) (-> skey first name keyword) :default)
+  (let [prefix  (if (vector? skey) (-> skey first name keyword) "default")
         tname   (str "penpot/" prefix "/%s")
         factory (px/forkjoin-thread-factory :name tname)]
     (px/forkjoin-executor

backend/test/backend_tests/bounce_handling_test.clj

@@ -6,12 +6,12 @@
 
 (ns backend-tests.bounce-handling-test
   (:require
-   [backend-tests.helpers :as th]
    [app.db :as db]
    [app.emails :as emails]
    [app.http.awsns :as awsns]
    [app.tokens :as tokens]
    [app.util.time :as dt]
+   [backend-tests.helpers :as th]
    [clojure.pprint :refer [pprint]]
    [clojure.test :as t]
    [mockery.core :refer [with-mocks]]))

backend/test/backend_tests/helpers.clj

@@ -8,6 +8,7 @@
   (:require
    [app.auth]
    [app.common.data :as d]
+   [app.common.exceptions :as ex]
    [app.common.flags :as flags]
    [app.common.pages :as cp]
    [app.common.pprint :as pp]
@@ -16,13 +17,15 @@
    [app.config :as cf]
    [app.db :as db]
    [app.main :as main]
+   [app.media :as-alias mtx]
    [app.media]
    [app.migrations]
+   [app.msgbus :as-alias mbus]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.auth :as cmd.auth]
    [app.rpc.commands.files :as files]
-   [app.rpc.commands.files.create :as files.create]
-   [app.rpc.commands.files.update :as files.update]
+   [app.rpc.commands.files-create :as files.create]
+   [app.rpc.commands.files-update :as files.update]
    [app.rpc.commands.teams :as teams]
    [app.rpc.helpers :as rph]
    [app.rpc.mutations.profile :as profile]
@@ -64,52 +67,50 @@
 
 (defn state-init
   [next]
-  (let [templates [{:id "test"
-                    :name "test"
-                    :file-uri "test"
-                    :thumbnail-uri "test"
-                    :path (-> "backend_tests/test_files/template.penpot" io/resource fs/path)}]
-        system (-> (merge main/system-config main/worker-config)
-                   (assoc-in [:app.redis/redis :app.redis/uri] (:redis-uri config))
-                   (assoc-in [:app.db/pool :uri] (:database-uri config))
-                   (assoc-in [:app.db/pool :username] (:database-username config))
-                   (assoc-in [:app.db/pool :password] (:database-password config))
-                   (assoc-in [:app.rpc/methods :templates] templates)
-                   (dissoc :app.srepl/server
-                           :app.http/server
-                           :app.http/router
-                           :app.http.awsns/handler
-                           :app.http.session/updater
-                           :app.auth.oidc/google-provider
-                           :app.auth.oidc/gitlab-provider
-                           :app.auth.oidc/github-provider
-                           :app.auth.oidc/generic-provider
-                           :app.setup/builtin-templates
-                           :app.auth.oidc/routes
-                           :app.worker/executors-monitor
-                           :app.http.oauth/handler
-                           :app.notifications/handler
-                           :app.loggers.sentry/reporter
-                           :app.loggers.mattermost/reporter
-                           :app.loggers.loki/reporter
-                           :app.loggers.database/reporter
-                           :app.loggers.zmq/receiver
-                           :app.worker/cron
-                           :app.worker/worker))
-        _      (ig/load-namespaces system)
-        system (-> (ig/prep system)
-                   (ig/init))]
-    (try
-      (binding [*system* system
-                *pool*   (:app.db/pool system)]
-        (with-redefs [app.config/flags (flags/parse flags/default default-flags (:flags config))
-                      app.config/config config
-                      app.loggers.audit/submit! (constantly nil)
-                      app.auth/derive-password identity
-                      app.auth/verify-password (fn [a b] {:valid (= a b)})]
-          (next)))
-      (finally
-        (ig/halt! system)))))
+  (with-redefs [app.config/flags (flags/parse flags/default default-flags)
+                app.config/config config
+                app.loggers.audit/submit! (constantly nil)
+                app.auth/derive-password identity
+                app.auth/verify-password (fn [a b] {:valid (= a b)})]
+
+    (let [templates [{:id "test"
+                      :name "test"
+                      :file-uri "test"
+                      :thumbnail-uri "test"
+                      :path (-> "backend_tests/test_files/template.penpot" io/resource fs/path)}]
+          system (-> (merge main/system-config main/worker-config)
+                     (assoc-in [:app.redis/redis :app.redis/uri] (:redis-uri config))
+                     (assoc-in [:app.db/pool :uri] (:database-uri config))
+                     (assoc-in [:app.db/pool :username] (:database-username config))
+                     (assoc-in [:app.db/pool :password] (:database-password config))
+                     (assoc-in [:app.rpc/methods :templates] templates)
+                     (dissoc :app.srepl/server
+                             :app.http/server
+                             :app.http/router
+                             :app.auth.oidc/google-provider
+                             :app.auth.oidc/gitlab-provider
+                             :app.auth.oidc/github-provider
+                             :app.auth.oidc/generic-provider
+                             :app.setup/builtin-templates
+                             :app.auth.oidc/routes
+                             :app.worker/executors-monitor
+                             :app.http.oauth/handler
+                             :app.notifications/handler
+                             :app.loggers.mattermost/reporter
+                             :app.loggers.loki/reporter
+                             :app.loggers.database/reporter
+                             :app.loggers.zmq/receiver
+                             :app.worker/cron
+                             :app.worker/worker))
+          _      (ig/load-namespaces system)
+          system (-> (ig/prep system)
+                     (ig/init))]
+      (try
+        (binding [*system* system
+                  *pool*   (:app.db/pool system)]
+          (next))
+        (finally
+          (ig/halt! system))))))
 
 (defn database-reset
   [next]
@@ -163,8 +164,8 @@
                        params)]
      (with-open [conn (db/open pool)]
        (->> params
-            (cmd.auth/create-profile conn)
-            (cmd.auth/create-profile-relations conn))))))
+            (cmd.auth/create-profile! conn)
+            (cmd.auth/create-profile-rels! conn))))))
 
 (defn create-project*
   ([i params] (create-project* *pool* i params))
@@ -274,12 +275,10 @@
   ([pool {:keys [file-id changes session-id profile-id revn]
           :or {session-id (uuid/next) revn 0}}]
    (with-open [conn (db/open pool)]
-     (let [msgbus    (:app.msgbus/msgbus *system*)
-           metrics   (:app.metrics/metrics *system*)
-           features  #{"components/v2"}]
-       (files.update/update-file {:conn conn
-                                  :msgbus msgbus
-                                  :metrics metrics}
+     (let [features #{"components/v2"}
+           cfg      (-> (select-keys *system* [::mbus/msgbus ::mtx/metrics])
+                        (assoc :conn conn))]
+       (files.update/update-file cfg
                                  {:id file-id
                                   :revn revn
                                   :features features
@@ -322,6 +321,11 @@
 (defn command!
   [{:keys [::type] :as data}]
   (let [method-fn (get-in *system* [:app.rpc/methods :commands type])]
+    (when-not method-fn
+      (ex/raise :type :assertion
+                :code :rpc-method-not-found
+                :hint (str/ffmt "rpc method '%' not found" (name type))))
+
     ;; (app.common.pprint/pprint (:app.rpc/methods *system*))
     (try-on! (method-fn (-> data
                             (dissoc ::type)

backend/test/backend_tests/rpc_file_test.clj

@@ -652,7 +652,9 @@
       ;; check that the unknown frame thumbnail is deleted
       (let [res (th/db-exec! ["select * from file_object_thumbnail"])]
         (t/is (= 1 (count res)))
-        (t/is (= "new-data" (get-in res [0 :data])))))))
+        (t/is (= "new-data" (get-in res [0 :data])))))
+
+    ))
 
 
 (t/deftest file-thumbnail-ops

backend/test/backend_tests/rpc_font_test.clj

@@ -9,6 +9,7 @@
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.http :as http]
+   [app.rpc :as-alias rpc]
    [app.storage :as sto]
    [backend-tests.helpers :as th]
    [clojure.test :as t]
@@ -31,14 +32,14 @@
                       io/read-as-bytes)
 
           params  {::th/type :create-font-variant
-                   :profile-id (:id prof)
+                   ::rpc/profile-id (:id prof)
                    :team-id team-id
                    :font-id font-id
                    :font-family "somefont"
                    :font-weight 400
                    :font-style "normal"
                    :data {"font/ttf" ttfdata}}
-          out     (th/mutation! params)]
+          out     (th/command! params)]
 
       (t/is (= 1 (:call-count @mock)))
 
@@ -68,14 +69,14 @@
                     io/read-as-bytes)
 
         params  {::th/type :create-font-variant
-                 :profile-id (:id prof)
+                 ::rpc/profile-id (:id prof)
                  :team-id team-id
                  :font-id font-id
                  :font-family "somefont"
                  :font-weight 400
                  :font-style "normal"
                  :data {"font/woff" data}}
-        out     (th/mutation! params)]
+        out     (th/command! params)]
 
     ;; (th/print-result! out)
     (t/is (nil? (:error out)))
@@ -91,8 +92,3 @@
         :font-family
         :font-weight
         :font-style))))
-
-
-
-
-

backend/test/backend_tests/rpc_profile_test.clj

@@ -6,14 +6,14 @@
 
 (ns backend-tests.rpc-profile-test
   (:require
-   [backend-tests.helpers :as th]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
+   [app.rpc :as-alias rpc]
    [app.rpc.commands.auth :as cauth]
-   [app.rpc.mutations.profile :as profile]
    [app.tokens :as tokens]
    [app.util.time :as dt]
+   [backend-tests.helpers :as th]
    [clojure.java.io :as io]
    [clojure.test :as t]
    [cuerdas.core :as str]
@@ -67,9 +67,9 @@
 (t/deftest profile-query-and-manipulation
   (let [profile (th/create-profile* 1)]
     (t/testing "query profile"
-      (let [data {::th/type :profile
-                  :profile-id (:id profile)}
-            out  (th/query! data)]
+      (let [data {::th/type :get-profile
+                  ::rpc/profile-id (:id profile)}
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
@@ -82,20 +82,20 @@
     (t/testing "update profile"
       (let [data (assoc profile
                         ::th/type :update-profile
-                        :profile-id (:id profile)
+                        ::rpc/profile-id (:id profile)
                         :fullname "Full Name"
                         :lang "en"
                         :theme "dark")
-            out  (th/mutation! data)]
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
         (t/is (map? (:result out)))))
 
     (t/testing "query profile after update"
-      (let [data {::th/type :profile
-                  :profile-id (:id profile)}
-            out  (th/query! data)]
+      (let [data {::th/type :get-profile
+                  ::rpc/profile-id (:id profile)}
+            out  (th/command! data)]
 
         #_(th/print-result! out)
         (t/is (nil? (:error out)))
@@ -107,12 +107,12 @@
 
     (t/testing "update photo"
       (let [data {::th/type :update-profile-photo
-                  :profile-id (:id profile)
+                  ::rpc/profile-id (:id profile)
                   :file {:filename "sample.jpg"
                          :size 123123
                          :path (th/tempfile "backend_tests/test_files/sample.jpg")
                          :mtype "image/jpeg"}}
-            out  (th/mutation! data)]
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))))
@@ -131,15 +131,15 @@
 
     ;; Request profile to be deleted
     (let [params {::th/type :delete-profile
-                  :profile-id (:id prof)}
-          out    (th/mutation! params)]
+                  ::rpc/profile-id (:id prof)}
+          out    (th/command! params)]
       (t/is (nil? (:error out))))
 
     ;; query files after profile soft deletion
-    (let [params {::th/type :project-files
-                  :project-id (:default-project-id prof)
-                  :profile-id (:id prof)}
-          out    (th/query! params)]
+    (let [params {::th/type :get-project-files
+                  ::rpc/profile-id (:id prof)
+                  :project-id (:default-project-id prof)}
+          out    (th/command! params)]
       ;; (th/print-result! out)
       (t/is (nil? (:error out)))
       (t/is (= 1 (count (:result out)))))
@@ -150,13 +150,13 @@
 
     (let [row (th/db-get :team
                          {:id (:default-team-id prof)}
-                         {:check-deleted? false})]
+                         {::db/remove-deleted? false})]
       (t/is (dt/instant? (:deleted-at row))))
 
     ;; query profile after delete
-    (let [params {::th/type :profile
-                  :profile-id (:id prof)}
-          out    (th/query! params)]
+    (let [params {::th/type :get-profile
+                  ::rpc/profile-id (:id prof)}
+          out    (th/command! params)]
       ;; (th/print-result! out)
       (let [result (:result out)]
         (t/is (= uuid/zero (:id result)))))))
@@ -174,7 +174,7 @@
   (let [data  {::th/type :prepare-register-profile
                :email "user@example.com"
                :password "foobar"}
-        out   (th/mutation! data)
+        out   (th/command! data)
         token (get-in out [:result :token])]
     (t/is (string? token))
 
@@ -183,7 +183,7 @@
     (let [data  {::th/type :register-profile
                  :fullname "foobar"
                  :accept-terms-and-privacy true}
-          out   (th/mutation! data)]
+          out   (th/command! data)]
       (let [error (:error out)]
         (t/is (th/ex-info? error))
         (t/is (th/ex-of-type? error :validation))
@@ -195,7 +195,7 @@
                  :fullname "foobar"
                  :accept-terms-and-privacy true
                  :accept-newsletter-subscription true}]
-      (let [{:keys [result error]} (th/mutation! data)]
+      (let [{:keys [result error]} (th/command! data)]
         (t/is (nil? error))))
     ))
 
@@ -413,11 +413,11 @@
     (let [profile (th/create-profile* 1)
           pool    (:app.db/pool th/*system*)
           data    {::th/type :request-email-change
-                   :profile-id (:id profile)
+                   ::rpc/profile-id (:id profile)
                    :email "user1@example.com"}]
 
       ;; without complaints
-      (let [out (th/mutation! data)]
+      (let [out (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? (:result out)))
         (let [mock @mock]
@@ -426,14 +426,14 @@
 
       ;; with complaints
       (th/create-global-complaint-for pool {:type :complaint :email (:email data)})
-      (let [out (th/mutation! data)]
+      (let [out (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? (:result out)))
         (t/is (= 2 (:call-count @mock))))
 
       ;; with bounces
       (th/create-global-complaint-for pool {:type :bounce :email (:email data)})
-      (let [out   (th/mutation! data)
+      (let [out   (th/command! data)
             error (:error out)]
         ;; (th/print-result! out)
         (t/is (th/ex-info? error))
@@ -448,9 +448,9 @@
       (let [profile (th/create-profile* 1)
             pool    (:app.db/pool th/*system*)
             data    {::th/type :request-email-change
-                     :profile-id (:id profile)
+                     ::rpc/profile-id (:id profile)
                      :email "user1@example.com"}
-            out     (th/mutation! data)]
+            out     (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (false? (:called? @mock)))
@@ -467,7 +467,7 @@
 
       ;; with invalid email
       (let [data (assoc data :email "foo@bar.com")
-            out  (th/mutation! data)]
+            out  (th/command! data)]
         (t/is (nil? (:result out)))
         (t/is (= 0 (:call-count @mock))))
 
@@ -512,10 +512,10 @@
 (t/deftest update-profile-password
   (let [profile (th/create-profile* 1)
         data  {::th/type :update-profile-password
-               :profile-id (:id profile)
+               ::rpc/profile-id (:id profile)
                :old-password "123123"
                :password "foobarfoobar"}
-        out   (th/mutation! data)]
+        out   (th/command! data)]
     (t/is (nil? (:error out)))
     (t/is (nil? (:result out)))
   ))
@@ -524,10 +524,10 @@
 (t/deftest update-profile-password-bad-old-password
   (let [profile (th/create-profile* 1)
         data  {::th/type :update-profile-password
-               :profile-id (:id profile)
+               ::rpc/profile-id (:id profile)
                :old-password "badpassword"
                :password "foobarfoobar"}
-        {:keys [result error] :as out} (th/mutation! data)]
+        {:keys [result error] :as out} (th/command! data)]
     (t/is (th/ex-info? error))
     (t/is (th/ex-of-type? error :validation))
     (t/is (th/ex-of-code? error :old-password-not-match))))
@@ -536,10 +536,10 @@
 (t/deftest update-profile-password-email-as-password
   (let [profile (th/create-profile* 1)
         data  {::th/type :update-profile-password
-               :profile-id (:id profile)
+               ::rpc/profile-id (:id profile)
                :old-password "123123"
                :password "profile1.test@nodomain.com"}
-        {:keys [result error] :as out} (th/mutation! data)]
+        {:keys [result error] :as out} (th/command! data)]
     (t/is (th/ex-info? error))
     (t/is (th/ex-of-type? error :validation))
     (t/is (th/ex-of-code? error :email-as-password))))

backend/test/backend_tests/rpc_project_test.clj

@@ -9,6 +9,7 @@
    [backend-tests.helpers :as th]
    [app.common.uuid :as uuid]
    [app.db :as db]
+   [app.rpc :as-alias rpc]
    [app.http :as http]
    [app.util.time :as dt]
    [clojure.test :as t]))
@@ -214,10 +215,10 @@
       (t/is (= 0 (:processed result))))
 
     ;; query the list of files of a after soft deletion
-    (let [data {::th/type :project-files
-                :project-id (:id project)
-                :profile-id (:id profile1)}
-          out  (th/query! data)]
+    (let [data {::th/type :get-project-files
+                ::rpc/profile-id (:id profile1)
+                :project-id (:id project)}
+          out  (th/command! data)]
       ;; (th/print-result! out)
       (t/is (nil? (:error out)))
       (let [result (:result out)]
@@ -228,10 +229,10 @@
       (t/is (= 1 (:processed result))))
 
     ;; query the list of files of a after hard deletion
-    (let [data {::th/type :project-files
-                :project-id (:id project)
-                :profile-id (:id profile1)}
-          out  (th/query! data)]
+    (let [data {::th/type :get-project-files
+                ::rpc/profile-id (:id profile1)
+                :project-id (:id project)}
+          out  (th/command! data)]
       ;; (th/print-result! out)
       (let [error (:error out)
             error-data (ex-data error)]

common/src/app/common/uuid.cljc

@@ -59,3 +59,10 @@
        (.putLong buf (.getMostSignificantBits o))
        (.putLong buf (.getLeastSignificantBits o))
        (.array buf))))
+
+#?(:clj
+   (defn from-bytes
+     [^bytes o]
+     (let [buf (ByteBuffer/wrap o)]
+       (UUID. ^long (.getLong buf)
+              ^long (.getLong buf)))))

frontend/src/app/main/data/common.cljs

@@ -27,7 +27,7 @@
   (ptk/reify ::create-share-link
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (rp/mutation! :create-share-link params)
+      (->> (rp/cmd! :create-share-link params)
            (rx/map share-link-created)))))
 
 (defn delete-share-link
@@ -41,6 +41,6 @@
 
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (rp/mutation! :delete-share-link {:id id})
+      (->> (rp/cmd! :delete-share-link {:id id})
            (rx/ignore)))))
 

frontend/src/app/main/data/dashboard.cljs

@@ -185,7 +185,7 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [team-id (:current-team-id state)]
-        (->> (rp/query! :projects {:team-id team-id})
+        (->> (rp/cmd! :get-projects {:team-id team-id})
              (rx/map projects-fetched))))))
 
 ;; --- EVENT: search
@@ -671,7 +671,7 @@
             {:keys [on-success on-error]
              :or {on-success identity
                   on-error rx/throw}} (meta params)]
-        (->> (rp/mutation! :create-project params)
+        (->> (rp/cmd! :create-project params)
              (rx/tap on-success)
              (rx/map project-created)
              (rx/catch on-error))))))
@@ -733,7 +733,7 @@
     (watch [_ state _]
       (let [project (get-in state [:dashboard-projects id])
             params  (select-keys project [:id :is-pinned :team-id])]
-        (->> (rp/mutation :update-project-pin params)
+        (->> (rp/cmd! :update-project-pin params)
              (rx/ignore))))))
 
 ;; --- EVENT: rename-project
@@ -751,7 +751,7 @@
     ptk/WatchEvent
     (watch [_ _ _]
       (let [params {:id id :name name}]
-        (->> (rp/mutation :rename-project params)
+        (->> (rp/cmd! :rename-project params)
              (rx/ignore))))))
 
 ;; --- EVENT: delete-project
@@ -766,7 +766,7 @@
 
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (rp/mutation :delete-project {:id id})
+      (->> (rp/cmd! :delete-project {:id id})
            (rx/ignore)))))
 
 ;; --- EVENT: delete-file
@@ -1077,7 +1077,7 @@
             action-name   (if in-project? :create-file :create-project)
             action        (if in-project? file-created project-created)]
 
-        (->> (rp/mutation! action-name params)
+        (->> (rp/cmd! action-name params)
              (rx/map action))))))
 
 (defn open-selected-file

frontend/src/app/main/data/fonts.cljs

@@ -76,7 +76,7 @@
   (ptk/reify ::load-team-fonts
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (rp/query :font-variants {:team-id team-id})
+      (->> (rp/cmd! :get-font-variants {:team-id team-id})
            (rx/map fonts-fetched)))))
 
 (defn process-upload
@@ -236,7 +236,7 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [team-id (:current-team-id state)]
-        (->> (rp/mutation! :update-font {:id id :name name :team-id team-id})
+        (->> (rp/cmd! :update-font {:id id :name name :team-id team-id})
              (rx/ignore))))))
 
 (defn delete-font
@@ -253,7 +253,7 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [team-id (:current-team-id state)]
-        (->> (rp/mutation! :delete-font {:id font-id :team-id team-id})
+        (->> (rp/cmd! :delete-font {:id font-id :team-id team-id})
              (rx/ignore))))))
 
 (defn delete-font-variant
@@ -270,7 +270,7 @@
     ptk/WatchEvent
     (watch [_ state _]
       (let [team-id (:current-team-id state)]
-        (->> (rp/mutation! :delete-font-variant {:id id :team-id team-id})
+        (->> (rp/cmd! :delete-font-variant {:id id :team-id team-id})
              (rx/ignore))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

frontend/src/app/main/data/users.cljs

@@ -124,7 +124,7 @@
   (ptk/reify ::fetch-profile
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (rp/query! :profile)
+      (->> (rp/cmd! :get-profile)
            (rx/map profile-fetched)))))
 
 ;; --- EVENT: INITIALIZE PROFILE
@@ -207,7 +207,7 @@
         ;; the returned profile is an NOT authenticated profile, we
         ;; proceed to logout and show an error message.
 
-        (->> (rp/command! :login-with-password (d/without-nils params))
+        (->> (rp/cmd! :login-with-password (d/without-nils params))
              (rx/merge-map (fn [data]
                              (rx/merge
                               (rx/of (fetch-profile))
@@ -293,7 +293,7 @@
    (ptk/reify ::logout
      ptk/WatchEvent
      (watch [_ _ _]
-       (->> (rp/command! :logout)
+       (->> (rp/cmd! :logout)
             (rx/delay-at-least 300)
             (rx/catch (constantly (rx/of 1)))
             (rx/map #(logged-out params)))))))
@@ -309,7 +309,7 @@
       (let [mdata      (meta data)
             on-success (:on-success mdata identity)
             on-error   (:on-error mdata rx/throw)]
-        (->> (rp/mutation :update-profile (dissoc data :props))
+        (->> (rp/cmd! :update-profile (dissoc data :props))
              (rx/catch on-error)
              (rx/mapcat
               (fn [_]
@@ -333,7 +333,7 @@
       (let [{:keys [on-error on-success]
              :or {on-error identity
                   on-success identity}} (meta data)]
-        (->> (rp/mutation :request-email-change data)
+        (->> (rp/cmd! :request-email-change data)
              (rx/tap on-success)
              (rx/catch on-error))))))
 
@@ -343,7 +343,7 @@
   (ptk/reify ::cancel-email-change
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (rp/mutation :cancel-email-change {})
+      (->> (rp/cmd! :cancel-email-change {})
            (rx/map (constantly (fetch-profile)))))))
 
 ;; --- Update Password (Form)
@@ -364,7 +364,7 @@
                   on-success identity}} (meta data)
             params {:old-password (:password-old data)
                     :password (:password-1 data)}]
-        (->> (rp/mutation :update-profile-password params)
+        (->> (rp/cmd! :update-profile-password params)
              (rx/tap on-success)
              (rx/catch (fn [err]
                          (on-error err)
@@ -382,7 +382,7 @@
     ;; the response value of update-profile-props RPC call
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (rp/mutation :update-profile-props {:props props})
+      (->> (rp/cmd! :update-profile-props {:props props})
            (rx/map (constantly (fetch-profile)))))))
 
 (defn mark-onboarding-as-viewed
@@ -394,7 +394,7 @@
        (let [version (or version (:main @cf/version))
              props   {:onboarding-viewed true
                       :release-notes-viewed version}]
-         (->> (rp/mutation :update-profile-props {:props props})
+         (->> (rp/cmd! :update-profile-props {:props props})
               (rx/map (constantly (fetch-profile)))))))))
 
 (defn mark-questions-as-answered
@@ -407,7 +407,7 @@
     ptk/WatchEvent
     (watch [_ _ _]
       (let [props {:onboarding-questions-answered true}]
-        (->> (rp/mutation :update-profile-props {:props props})
+        (->> (rp/cmd! :update-profile-props {:props props})
              (rx/map (constantly (fetch-profile))))))))
 
 
@@ -431,7 +431,7 @@
         (->> (rx/of file)
              (rx/map di/validate-file)
              (rx/map prepare)
-             (rx/mapcat #(rp/mutation :update-profile-photo %))
+             (rx/mapcat #(rp/cmd! :update-profile-photo %))
              (rx/do on-success)
              (rx/map (constantly (fetch-profile)))
              (rx/catch on-error))))))
@@ -460,7 +460,7 @@
       ptk/WatchEvent
       (watch [_ state _]
         (let [share-id (-> state :viewer-local :share-id)]
-          (->> (rp/command! :get-profiles-for-file-comments {:team-id team-id :share-id share-id})
+          (->> (rp/cmd! :get-profiles-for-file-comments {:team-id team-id :share-id share-id})
                (rx/map #(partial fetched %))))))))
 
 ;; --- EVENT: request-account-deletion
@@ -473,7 +473,7 @@
       (let [{:keys [on-error on-success]
              :or {on-error rx/throw
                   on-success identity}} (meta params)]
-        (->> (rp/mutation :delete-profile {})
+        (->> (rp/cmd! :delete-profile {})
              (rx/tap on-success)
              (rx/delay-at-least 300)
              (rx/catch (constantly (rx/of 1)))
@@ -495,7 +495,7 @@
              :or {on-error rx/throw
                   on-success identity}} (meta data)]
 
-        (->> (rp/command! :request-profile-recovery data)
+        (->> (rp/cmd! :request-profile-recovery data)
              (rx/tap on-success)
              (rx/catch on-error))))))
 
@@ -514,7 +514,7 @@
       (let [{:keys [on-error on-success]
              :or {on-error rx/throw
                   on-success identity}} (meta data)]
-        (->> (rp/command! :recover-profile data)
+        (->> (rp/cmd! :recover-profile data)
              (rx/tap on-success)
              (rx/catch on-error))))))
 
@@ -525,7 +525,7 @@
   (ptk/reify ::create-demo-profile
     ptk/WatchEvent
     (watch [_ _ _]
-      (->> (rp/command! :create-demo-profile {})
+      (->> (rp/cmd! :create-demo-profile {})
            (rx/map login)))))
 
 

frontend/src/app/main/data/viewer.cljs

@@ -129,22 +129,22 @@
                               (rx/map :content)
                               (rx/map #(vector key %)))))]
 
-        (->> (rp/query! :view-only-bundle params')
-               (rx/mapcat
-                (fn [bundle]
-                  (->> (rx/from (-> bundle :file :data :pages-index seq))
-                       (rx/merge-map
-                        (fn [[_ page :as kp]]
-                          (if (t/pointer? page)
-                            (resolve kp)
-                            (rx/of kp))))
-                       (rx/reduce conj {})
-                       (rx/map (fn [pages-index]
-                                 (update-in bundle [:file :data] assoc :pages-index pages-index))))))
-               (rx/mapcat
-                (fn [{:keys [fonts] :as bundle}]
-                  (rx/of (df/fonts-fetched fonts)
-                         (bundle-fetched (merge bundle params))))))))))
+        (->> (rp/cmd! :get-view-only-bundle params')
+             (rx/mapcat
+              (fn [bundle]
+                (->> (rx/from (-> bundle :file :data :pages-index seq))
+                     (rx/merge-map
+                      (fn [[_ page :as kp]]
+                        (if (t/pointer? page)
+                          (resolve kp)
+                          (rx/of kp))))
+                     (rx/reduce conj {})
+                     (rx/map (fn [pages-index]
+                               (update-in bundle [:file :data] assoc :pages-index pages-index))))))
+             (rx/mapcat
+              (fn [{:keys [fonts] :as bundle}]
+                (rx/of (df/fonts-fetched fonts)
+                       (bundle-fetched (merge bundle params))))))))))
 
 (declare go-to-frame-auto)
 

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

@@ -267,7 +267,7 @@
 
         (->> (rx/zip (rp/cmd! :get-file {:id file-id :features features})
                      (rp/cmd! :get-file-object-thumbnails {:file-id file-id})
-                     (rp/query! :project {:id project-id})
+                     (rp/cmd! :get-project {:id project-id})
                      (rp/cmd! :get-team-users {:file-id file-id})
                      (rp/cmd! :get-profiles-for-file-comments {:file-id file-id :share-id share-id}))
              (rx/take 1)
@@ -1427,7 +1427,7 @@
                      :file-id file-id
                      :content blob
                      :is-local true}))
-                 (rx/mapcat #(rp/mutation! :upload-file-media-object %))
+                 (rx/mapcat #(rp/cmd! :upload-file-media-object %))
                  (rx/map (fn [media]
                            (assoc media :prev-id (:id imgpart))))))
 
@@ -1564,7 +1564,7 @@
                                  (into (d/ordered-set)))
                   undo-id (js/Symbol)]
 
-              (rx/of (dwu/start-undo-transaction undo-id) 
+              (rx/of (dwu/start-undo-transaction undo-id)
                      (dch/commit-changes changes)
                      (dws/select-shapes selected)
                      (ptk/data-event :layout/update [frame-id])

frontend/src/app/main/data/workspace/media.cljs

@@ -125,7 +125,7 @@
           (rx/map dmm/validate-file)
           (rx/filter (comp not svg-blob?))
           (rx/map prepare-blob)
-          (rx/mapcat #(rp/mutation! :upload-file-media-object %))
+          (rx/mapcat #(rp/cmd! :upload-file-media-object %))
           (rx/do on-image))
 
      (->> (rx/from blobs)
@@ -361,7 +361,7 @@
                           :type :info
                           :timeout nil
                           :tag :media-loading}))
-         (->> (rp/mutation! :clone-file-media-object params)
+         (->> (rp/cmd! :clone-file-media-object params)
               (rx/do on-success)
               (rx/catch on-error)
               (rx/finalize #(st/emit! (dm/hide-tag :media-loading)))))))))

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

@@ -214,7 +214,7 @@
                      :features features}]
 
         (when (:id params)
-          (->> (rp/mutation :update-file params)
+          (->> (rp/cmd! :update-file params)
                (rx/ignore)))))))
 
 (defn update-persistence-status

frontend/src/app/main/repo.cljs

@@ -12,17 +12,23 @@
    [app.util.http :as http]
    [beicon.core :as rx]))
 
+(derive :get-all-projects ::query)
+(derive :get-comment-threads ::query)
 (derive :get-file ::query)
-(derive :get-file-object-thumbnails ::query)
-(derive :get-file-libraries ::query)
 (derive :get-file-fragment ::query)
-(derive :search-files ::query)
-(derive :get-teams ::query)
-(derive :get-team-users ::query)
-(derive :get-team-members ::query)
-(derive :get-team-stats ::query)
+(derive :get-file-libraries ::query)
+(derive :get-file-object-thumbnails ::query)
+(derive :get-font-variants ::query)
+(derive :get-profile ::query)
+(derive :get-project ::query)
 (derive :get-team-invitations ::query)
+(derive :get-team-members ::query)
 (derive :get-team-shared-files ::query)
+(derive :get-team-stats ::query)
+(derive :get-team-users ::query)
+(derive :get-teams ::query)
+(derive :get-view-only-bundle ::query)
+(derive :search-files ::query)
 
 (defn handle-response
   [{:keys [status body] :as response}]
@@ -164,15 +170,6 @@
          (rx/map http/conditional-decode-transit)
          (rx/mapcat handle-response))))
 
-(defmethod command :send-feedback
-  [_ params]
-  (->> (http/send! {:method :post
-                    :uri (u/join @cf/public-uri "api/feedback")
-                    :credentials "include"
-                    :body (http/transit-data params)})
-       (rx/map http/conditional-decode-transit)
-       (rx/mapcat handle-response)))
-
 (defn- send-export
   [{:keys [blob?] :as params}]
   (->> (http/send! {:method :post
@@ -200,3 +197,12 @@
                     :body (http/form-data params)})
        (rx/map http/conditional-decode-transit)
        (rx/mapcat handle-response)))
+
+(defmethod command ::multipart-upload
+  [id params]
+  (->> (http/send! {:method :post
+                    :uri  (u/join @cf/public-uri "api/rpc/command/" (name id))
+                    :credentials "include"
+                    :body (http/form-data params)})
+       (rx/map http/conditional-decode-transit)
+       (rx/mapcat handle-response)))

frontend/src/app/main/ui/dashboard/file_menu.cljs

@@ -207,7 +207,7 @@
      (mf/deps show?)
      (fn []
        (when show?
-         (->> (rp/query! :all-projects)
+         (->> (rp/cmd! :get-all-projects)
               (rx/map group-by-team)
               (rx/subs #(when (mf/ref-val mounted-ref)
                           (reset! teams %)))))))

frontend/src/app/main/ui/dashboard/fonts.cljs

@@ -94,7 +94,7 @@
          (mf/deps team)
          (fn [item]
            (swap! uploading conj (:id item))
-           (->> (rp/mutation! :create-font-variant item)
+           (->> (rp/cmd! :create-font-variant item)
                 (rx/delay-at-least 2000)
                 (rx/subs (fn [font]
                            (swap! fonts dissoc (:id item))

frontend/src/app/main/ui/routes.cljs

@@ -99,7 +99,7 @@
     ;; We just recheck with an additional profile request; this avoids
     ;; some race conditions that causes unexpected redirects on
     ;; invitations workflows (and probably other cases).
-    (->> (rp/query! :profile)
+    (->> (rp/command! :get-profile)
          (rx/subs (fn [{:keys [id] :as profile}]
                     (if (= id uuid/zero)
                       (st/emit! (rt/nav :auth-login))

frontend/src/app/main/ui/settings/feedback.cljs

@@ -55,7 +55,7 @@
          (fn [form _]
            (reset! loading true)
            (let [data (:clean-data @form)]
-             (->> (rp/command! :send-feedback data)
+             (->> (rp/command! :send-user-feedback data)
                   (rx/subs on-succes on-error)))))]
 
     [:& fm/form {:class "feedback-form"

frontend/src/app/worker/import.cljs

@@ -196,7 +196,7 @@
            :content blob
            :is-local true}))
        (rx/tap #(progress! context :upload-media name))
-       (rx/flat-map #(rp/mutation! :upload-file-media-object %))))
+       (rx/flat-map #(rp/cmd! :upload-file-media-object %))))
 
 (defn resolve-text-content [node context]
   (let [resolve (:resolve context)]
@@ -511,7 +511,7 @@
                                   :content content
                                   :is-local false})))
                      (rx/tap #(progress! context :upload-media (:name %)))
-                     (rx/merge-map #(rp/mutation! :upload-file-media-object %))
+                     (rx/merge-map #(rp/cmd! :upload-file-media-object %))
                      (rx/map (constantly media))
                      (rx/catch #(do (.error js/console (str "Error uploading media: " (:name media)) )
                                     (rx/empty)))))))