Merge pull request #336 from tokens-studio/develop-merge

Develop Sync

.circleci/config.yml

@@ -33,6 +33,12 @@ jobs:
           command: |
             clojure -M:dev:test
 
+      - run:
+          name: "NODE tests"
+          working_directory: "./common"
+          command: |
+            yarn run test
+
       - save_cache:
           paths:
             - ~/.m2
@@ -161,7 +167,7 @@ jobs:
           name: "tests"
           working_directory: "./backend"
           command: |
-            clojure -M:dev:test
+            clojure -M:dev:test --reporter kaocha.report/documentation
 
           environment:
             PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"

.cljfmt.edn

@@ -4,7 +4,6 @@
  :remove-consecutive-blank-lines? false
  :extra-indents {rumext.v2/fnc [[:inner 0]]
                  cljs.test/async [[:inner 0]]
-                 app.common.schema/register! [[:inner 0] [:inner 1]]
                  promesa.exec/thread [[:inner 0]]
                  specify! [[:inner 0] [:inner 1]]}
  }

.gitignore

@@ -74,5 +74,5 @@ node_modules
 /playwright-report/
 /blob-report/
 /playwright/.cache/
-/frontend/vendor/draft-js/.yarn/
+/render-wasm/target/
-/frontend/vendor/hljs/.yarn
+/**/.yarn/*

CHANGES.md

@@ -1,5 +1,20 @@
 # CHANGELOG
 
+## 2.5.0
+
+### :rocket: Epics and highlights
+
+### :boom: Breaking changes & Deprecations
+
+### :heart: Community contributions (Thank you!)
+
+### :sparkles: New features
+
+- New gradients UI with multi-stop support.
+
+### :bug: Bugs fixed
+
+
 ## 2.4.0
 
 ### :rocket: Epics and highlights
@@ -8,8 +23,16 @@
 
 - Use [nginx-unprivileged](https://hub.docker.com/r/nginxinc/nginx-unprivileged) as base image for
   Penpot's frontend docker image. Now all the docker images runs with the same unprivileged user
-  (penpot). Because of that, the default NGINX listen port now is 8080, instead of 80, so you will
+  (penpot). Because of that, the default NGINX listen port is now 8080 instead of 80, so
-  have to modify your infrastructure to apply this change.
+  you will have to modify your infrastructure to apply this change.
+
+- Redis 7.2 is explicitly pinned in our example docker-compose.yml file. This is done because, 
+  starting with the next versions, Redis is no longer distributed under an open-source license. 
+  On-premise users are obviously free to upgrade to the version they are using or a more modern one. 
+  Keep in mind that if you were using a version other than 7.2, you may have to recreate the volume 
+  associated with the Redis container because the 7.2 storage format may not be compatible with what 
+  you already have stored on the volume, and Redis may not start. In the near future, we will evaluate 
+  whether to move to an open-source version of Redis (such as https://valkey.io/).
 
 ### :heart: Community contributions (Thank you!)
 
@@ -22,6 +45,26 @@
 ### :bug: Bugs fixed
 
 
+## 2.3.3
+
+### :bug: Bugs fixed
+
+- Fix problem creating manual overlay interactions [Taiga #9146](https://tree.taiga.io/project/penpot/issue/9146)
+- Fix plugins list default URL
+- Activate plugins feature by default
+
+## 2.3.2
+
+### :bug: Bugs fixed
+
+- Fix null pointer exception on number checking functions
+- Fix problem with grid layout ordering after moving [Taiga #9179](https://tree.taiga.io/project/penpot/issue/9179)
+
+### :books: Documentation
+
+- Add initial documentation for Kubernetes
+
+
 ## 2.3.1
 
 ### :bug: Bugs fixed

backend/dev/user.clj

@@ -137,7 +137,6 @@
 ;;        :v6 v6
 ;;        }])))
 
-
 (defn calculate-frames
   [{:keys [data]}]
   (->> (vals (:pages-index data))

backend/scripts/repl

@@ -1,7 +1,6 @@
 #!/usr/bin/env bash
 
 export PENPOT_HOST=devenv
-export PENPOT_TENANT=dev
 export PENPOT_FLAGS="\
        $PENPOT_FLAGS \
        enable-login-with-ldap \

backend/scripts/start-dev

@@ -1,7 +1,6 @@
 #!/usr/bin/env bash
 
 export PENPOT_HOST=devenv
-export PENPOT_TENANT=dev
 export PENPOT_FLAGS="\
        $PENPOT_FLAGS \
        enable-prepl-server \
@@ -10,6 +9,7 @@ export PENPOT_FLAGS="\
        enable-webhooks \
        enable-backend-asserts \
        enable-audit-log \
+       enable-login-with-ldap \
        enable-transit-readable-response \
        enable-demo-users \
        enable-feature-fdata-pointer-map \

backend/src/app/auth/ldap.clj

@@ -8,9 +8,8 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [clj-ldap.client :as ldap]
-   [clojure.spec.alpha :as s]
    [clojure.string]
    [integrant.core :as ig]))
 
@@ -58,21 +57,26 @@
        :email    email
        :backend  "ldap"})))
 
-(s/def ::fullname ::us/not-empty-string)
+(def ^:private schema:info-data
-(s/def ::email ::us/email)
+  [:map
-(s/def ::backend ::us/not-empty-string)
+   [:fullname ::sm/text]
+   [:email ::sm/email]
+   [:backend ::sm/text]])
 
-(s/def ::info-data
+(def ^:private valid-info-data?
-  (s/keys :req-un [::fullname ::email ::backend]))
+  (sm/lazy-validator schema:info-data))
+
+(def ^:private explain-info-data
+  (sm/lazy-explainer schema:info-data))
 
 (defn authenticate
   [cfg params]
   (with-open [conn (connect cfg)]
     (when-let [user (-> (assoc cfg ::conn conn)
                         (retrieve-user params))]
-      (when-not (s/valid? ::info-data user)
+      (when-not (valid-info-data? user)
-        (let [explain (s/explain-str ::info-data user)]
+        (let [explain (explain-info-data user)]
-          (l/warn ::l/raw (str "invalid response from ldap, looks like ldap is not configured correctly\n" explain))
+          (l/warn :hint "invalid response from ldap, looks like ldap is not configured correctly" :data user)
           (ex/raise :type :restriction
                     :code :wrong-ldap-response
                     :explain explain)))
@@ -102,38 +106,31 @@
                  :host (:host cfg) :port (:port cfg) :cause cause)
         nil))))
 
-(s/def ::enabled? ::us/boolean)
+(def ^:private schema:params
-(s/def ::host ::us/string)
+  [:map
-(s/def ::port ::us/integer)
+   [:host {:optional true} :string]
-(s/def ::ssl ::us/boolean)
+   [:port {:optional true} ::sm/int]
-(s/def ::tls ::us/boolean)
+   [:bind-dn {:optional true} :string]
-(s/def ::query ::us/string)
+   [:bind-passwor {:optional true} :string]
-(s/def ::base-dn ::us/string)
+   [:query {:optional true} :string]
-(s/def ::bind-dn ::us/string)
+   [:base-dn {:optional true} :string]
-(s/def ::bind-password ::us/string)
+   [:attrs-email {:optional true} :string]
-(s/def ::attrs-email ::us/string)
+   [:attrs-username {:optional true} :string]
-(s/def ::attrs-fullname ::us/string)
+   [:attrs-fullname {:optional true} :string]
-(s/def ::attrs-username ::us/string)
+   [:ssl {:optional true} ::sm/boolean]
+   [:tls {:optional true} ::sm/boolean]])
 
-(s/def ::provider-params
+(def ^:private check-params
-  (s/keys :opt-un [::host ::port
+  (sm/check-fn schema:params :hint "Invalid LDAP provider parameters"))
-                   ::ssl ::tls
-                   ::enabled?
-                   ::bind-dn
-                   ::bind-password
-                   ::query
-                   ::attrs-email
-                   ::attrs-username
-                   ::attrs-fullname]))
 
-(s/def ::provider
+(defmethod ig/assert-key ::provider
-  (s/nilable ::provider-params))
+  [_ params]
-
+  (when (:enabled params)
-(defmethod ig/pre-init-spec ::provider
+    (some->> params check-params)))
-  [_]
-  (s/spec ::provider))
 
 (defmethod ig/init-key ::provider
   [_ cfg]
-  (when (:enabled? cfg)
+  (when (:enabled cfg)
     (try-connectivity cfg)))
+
+(sm/register! ::provider schema:params)

backend/src/app/auth/oidc.clj

@@ -12,7 +12,7 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
@@ -32,7 +32,6 @@
    [buddy.sign.jwk :as jwk]
    [buddy.sign.jwt :as jwt]
    [clojure.set :as set]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [yetti.request :as yreq]
@@ -140,8 +139,9 @@
         (l/warn :hint "unable to retrieve JWKs (unexpected exception)"
                 :cause cause)))))
 
-(defmethod ig/pre-init-spec ::providers/generic [_]
+(defmethod ig/assert-key ::providers/generic
-  (s/keys :req [::http/client]))
+  [_ params]
+  (assert (http/client? (::http/client params)) "expected a valid http client"))
 
 (defmethod ig/init-key ::providers/generic
   [_ cfg]
@@ -197,6 +197,10 @@
 ;; GITHUB AUTH PROVIDER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn- int-in-range?
+  [val start end]
+  (and (<= start val) (< val end)))
+
 (defn- retrieve-github-email
   [cfg tdata props]
   (or (some-> props :github/email)
@@ -207,7 +211,7 @@
 
             {:keys [status body]} (http/req! cfg params {:sync? true})]
 
-        (when-not (s/int-in-range? 200 300 status)
+        (when-not (int-in-range? status 200 300)
           (ex/raise :type :internal
                     :code :unable-to-retrieve-github-emails
                     :hint "unable to retrieve github emails"
@@ -217,8 +221,9 @@
 
         (->> body json/decode (filter :primary) first :email))))
 
-(defmethod ig/pre-init-spec ::providers/github [_]
+(defmethod ig/assert-key ::providers/github
-  (s/keys :req [::http/client]))
+  [_ params]
+  (assert (http/client? (::http/client params)) "expected a valid http client"))
 
 (defmethod ig/init-key ::providers/github
   [_ cfg]
@@ -394,7 +399,7 @@
            :status (:status response)
            :body   (:body response))
 
-    (when-not (s/int-in-range? 200 300 (:status response))
+    (when-not (int-in-range? (:status response) 200 300)
       (ex/raise :type :internal
                 :code :unable-to-retrieve-user-info
                 :hint "unable to retrieve user info"
@@ -418,15 +423,15 @@
       (l/warn :hint "unable to get user info from JWT token (unexpected exception)"
               :cause cause))))
 
-(s/def ::backend ::us/not-empty-string)
+(def ^:private schema:info
-(s/def ::email ::us/not-empty-string)
+  [:map
-(s/def ::fullname ::us/not-empty-string)
+   [:backend ::sm/text]
-(s/def ::props (s/map-of ::us/keyword any?))
+   [:email ::sm/email]
-(s/def ::info
+   [:fullname ::sm/text]
-  (s/keys :req-un [::backend
+   [:props [:map-of :keyword :any]]])
-                   ::email
+
-                   ::fullname
+(def ^:private valid-info?
-                   ::props]))
+  (sm/validator schema:info))
 
 (defn- get-info
   [{:keys [::provider ::setup/props] :as cfg} {:keys [params] :as request}]
@@ -444,7 +449,7 @@
 
     (l/trc :hint "user info" :info info)
 
-    (when-not (s/valid? ::info info)
+    (when-not (valid-info? info)
       (l/warn :hint "received incomplete profile info object (please set correct scopes)" :info info)
       (ex/raise :type :internal
                 :code :incomplete-user-info
@@ -655,46 +660,37 @@
                        :provider provider
                        :hint "provider not configured"))))))})
 
-(s/def ::client-id ::us/string)
+(def ^:private schema:provider
-(s/def ::client-secret ::us/string)
+  [:map {:title "provider"}
-(s/def ::base-uri ::us/string)
+   [:client-id ::sm/text]
-(s/def ::token-uri ::us/string)
+   [:client-secret ::sm/text]
-(s/def ::auth-uri ::us/string)
+   [:base-uri {:optional true} ::sm/text]
-(s/def ::user-uri ::us/string)
+   [:token-uri {:optional true} ::sm/text]
-(s/def ::scopes ::us/set-of-strings)
+   [:auth-uri {:optional true} ::sm/text]
-(s/def ::roles ::us/set-of-strings)
+   [:user-uri {:optional true} ::sm/text]
-(s/def ::roles-attr ::us/string)
+   [:scopes {:optional true}
-(s/def ::email-attr ::us/string)
+    [::sm/set ::sm/text]]
-(s/def ::name-attr ::us/string)
+   [:roles {:optional true}
+    [::sm/set ::sm/text]]
+   [:roles-attr {:optional true} ::sm/text]
+   [:email-attr {:optional true} ::sm/text]
+   [:name-attr {:optional true} ::sm/text]])
 
-(s/def ::provider
+(def ^:private schema:routes-params
-  (s/keys :req-un [::client-id
+  [:map
-                   ::client-secret]
+   ::session/manager
-          :opt-un [::base-uri
-                   ::token-uri
-                   ::auth-uri
-                   ::user-uri
-                   ::scopes
-                   ::roles
-                   ::roles-attr
-                   ::email-attr
-                   ::name-attr]))
-
-(s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider)))
-
-(s/def ::routes vector?)
-
-(defmethod ig/pre-init-spec ::routes
-  [_]
-  (s/keys :req [::session/manager
    ::http/client
    ::setup/props
    ::db/pool
-                ::providers]))
+   [::providers [:map-of :keyword [:maybe schema:provider]]]])
+
+(defmethod ig/assert-key ::routes
+  [_ params]
+  (assert (sm/check schema:routes-params params)))
 
 (defmethod ig/init-key ::routes
   [_ cfg]
-  (let [cfg (update cfg :provider d/without-nils)]
+  (let [cfg (update cfg :providers d/without-nils)]
     ["" {:middleware [[session/authz cfg]
                       [provider-lookup cfg]]}
      ["/auth/oauth"

backend/src/app/binfile/common.clj

@@ -134,6 +134,16 @@
                          (update :data feat.fdata/process-pointers deref)
                          (update :data feat.fdata/process-objects (partial into {}))))))))
 
+(defn clean-file-features
+  [file]
+  (update file :features (fn [features]
+                           (if (set? features)
+                             (-> features
+                                 (cfeat/migrate-legacy-features)
+                                 (set/difference cfeat/frontend-only-features)
+                                 (set/difference cfeat/backend-only-features))
+                             #{}))))
+
 (defn get-project
   [cfg project-id]
   (db/get cfg :project {:id project-id}))
@@ -445,8 +455,11 @@
                            (fn [features]
                              (let [features (cfeat/check-supported-features! features)]
                                (-> (::features cfg #{})
-                                   (set/difference cfeat/frontend-only-features)
+                                   (set/union features)
-                                   (set/union features))))))
+                                   ;; We never want to store
+                                   ;; frontend-only features on file
+                                   (set/difference cfeat/frontend-only-features))))))
+
 
         _      (when (contains? cf/flags :file-schema-validation)
                  (fval/validate-file-schema! file))

backend/src/app/binfile/v1.clj

@@ -508,15 +508,6 @@
               (update :object-id #(str/replace-first % #"^(.*?)/" (str file-id "/")))))
         thumbnails))
 
-(defn- clean-features
-  [file]
-  (update file :features (fn [features]
-                           (if (set? features)
-                             (-> features
-                                 (cfeat/migrate-legacy-features)
-                                 (set/difference cfeat/backend-only-features))
-                             #{}))))
-
 (defmethod read-section :v1/files
   [{:keys [::db/conn ::input ::project-id ::bfc/overwrite ::name] :as system}]
 
@@ -527,7 +518,7 @@
           file-id    (:id file)
           file-id'   (bfc/lookup-index file-id)
 
-          file       (clean-features file)
+          file       (bfc/clean-file-features file)
           thumbnails (:thumbnails file)]
 
       (when (not= file-id expected-file-id)

backend/src/app/binfile/v3.clj

@@ -12,6 +12,7 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
+   [app.common.features :as cfeat]
    [app.common.json :as json]
    [app.common.logging :as l]
    [app.common.schema :as sm]
@@ -55,7 +56,8 @@
      [:map
       [:id ::sm/uuid]
       [:name :string]
-      [:project-id ::sm/uuid]]]]
+      [:project-id ::sm/uuid]
+      [:features ::cfeat/features]]]]
 
    [:relations {:optional true}
     [:vector
@@ -203,7 +205,10 @@
           (dissoc :libraries))
 
       embed-assets
-      (update :data #(bfc/embed-assets cfg % file-id)))))
+      (update :data #(bfc/embed-assets cfg % file-id))
+
+      :always
+      (bfc/clean-file-features))))
 
 (defn- resolve-extension
   [mtype]
@@ -259,7 +264,8 @@
     (vswap! bfc/*state* update :files assoc file-id
             {:id file-id
              :project-id (:project-id file)
-             :name (:name file)})
+             :name (:name file)
+             :features (:features file)})
 
     (let [file (cond-> (dissoc file :data)
                  (:options data)
@@ -296,7 +302,7 @@
 
     (doseq [thumbnail thumbnails]
       (let [data (cth/parse-object-id (:object-id thumbnail))
-            path (str "files/" file-id "/thumbnails/" (:page-id data)
+            path (str "files/" file-id "/thumbnails/" (:tag data) "/" (:page-id data)
                       "/" (:frame-id data) ".json")
             data (-> data
                      (assoc :media-id (:media-id thumbnail))
@@ -459,11 +465,12 @@
 
 (defn- match-thumbnail-entry-fn
   [file-id]
-  (let [pattern (str "^files/" file-id "/thumbnails/([^/]+)/([^/]+).json$")
+  (let [pattern (str "^files/" file-id "/thumbnails/([^/]+)/([^/]+)/([^/]+).json$")
         pattern (re-pattern pattern)]
     (fn [entry]
-      (when-let [[_ page-id frame-id] (re-matches pattern (zip-entry-name entry))]
+      (when-let [[_ tag page-id frame-id] (re-matches pattern (zip-entry-name entry))]
         {:entry entry
+         :tag tag
          :page-id (parse-uuid page-id)
          :frame-id (parse-uuid frame-id)
          :file-id file-id}))))
@@ -603,12 +610,13 @@
 (defn- read-file-thumbnails
   [{:keys [::input ::file-id ::entries] :as cfg}]
   (->> (keep (match-thumbnail-entry-fn file-id) entries)
-       (reduce (fn [result {:keys [page-id frame-id entry]}]
+       (reduce (fn [result {:keys [page-id frame-id tag entry]}]
                  (let [object (->> (read-entry input entry)
                                    (decode-file-thumbnail)
                                    (validate-file-thumbnail))]
                    (if (and (= frame-id (:frame-id object))
-                            (= page-id (:page-id object)))
+                            (= page-id (:page-id object))
+                            (= tag (:tag object)))
                      (conj result object)
                      result)))
                [])
@@ -788,7 +796,6 @@
           media-id  (bfc/lookup-index (:media-id item))
           object-id (-> (assoc item :file-id file-id)
                         (cth/fmt-object-id))
-
           params    {:file-id file-id
                      :object-id object-id
                      :tag (:tag item)
@@ -902,6 +909,11 @@
               (export-files cfg)
               (export-storage-objects cfg)))))
 
+      (catch java.util.zip.ZipException cause
+        (vreset! cs cause)
+        (vreset! ab true)
+        (throw cause))
+
       (catch java.io.IOException _cause
         ;; Do nothing, EOF means client closes connection abruptly
         (vreset! ab true)

backend/src/app/config.clj

@@ -26,11 +26,11 @@
   [_ data]
   (d/without-nils data))
 
-(defmethod ig/prep-key :default
+(defmethod ig/expand-key :default
-  [_ data]
+  [k v]
-  (if (map? data)
+  {k (if (map? v)
-    (d/without-nils data)
+       (d/without-nils v)
-    data))
+       v)})
 
 (def default
   {:database-uri "postgresql://postgres/penpot"
@@ -126,7 +126,7 @@
     [:worker-webhook-parallelism {:optional true} ::sm/int]
 
     [:database-password {:optional true} [:maybe :string]]
-    [:database-uri {:optional true} :string]
+    [:database-uri {:optional true} ::sm/uri]
     [:database-username {:optional true} [:maybe :string]]
     [:database-readonly {:optional true} ::sm/boolean]
     [:database-min-pool-size {:optional true} ::sm/int]
@@ -144,6 +144,8 @@
     [:quotes-comments-per-file {:optional true} ::sm/int]
     [:quotes-snapshots-per-file {:optional true} ::sm/int]
     [:quotes-snapshots-per-team {:optional true} ::sm/int]
+    [:quotes-team-access-requests-per-team {:optional true} ::sm/int]
+    [:quotes-team-access-requests-per-requester {:optional true} ::sm/int]
 
     [:auth-data-cookie-domain {:optional true} :string]
     [:auth-token-cookie-name {:optional true} :string]
@@ -190,7 +192,7 @@
     [:profile-complaint-max-age {:optional true} ::dt/duration]
     [:profile-complaint-threshold {:optional true} ::sm/int]
 
-    [:redis-uri {:optional true} :string]
+    [:redis-uri {:optional true} ::sm/uri]
 
     [:email-domain-blacklist {:optional true} ::fs/path]
     [:email-domain-whitelist {:optional true} ::fs/path]
@@ -218,14 +220,14 @@
     [:storage-assets-fs-directory {:optional true} :string]
     [:storage-assets-s3-bucket {:optional true} :string]
     [:storage-assets-s3-region {:optional true} :keyword]
-    [:storage-assets-s3-endpoint {:optional true} :string]
+    [:storage-assets-s3-endpoint {:optional true} ::sm/uri]
     [:storage-assets-s3-io-threads {:optional true} ::sm/int]
 
     [:objects-storage-backend {:optional true} :keyword]
     [:objects-storage-fs-directory {:optional true} :string]
     [:objects-storage-s3-bucket {:optional true} :string]
     [:objects-storage-s3-region {:optional true} :keyword]
-    [:objects-storage-s3-endpoint {:optional true} :string]
+    [:objects-storage-s3-endpoint {:optional true} ::sm/uri]
     [:objects-storage-s3-io-threads {:optional true} ::sm/int]]))
 
 (def default-flags

backend/src/app/db.clj

@@ -11,7 +11,7 @@
    [app.common.exceptions :as ex]
    [app.common.geom.point :as gpt]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.db.sql :as sql]
@@ -20,7 +20,6 @@
    [app.util.time :as dt]
    [clojure.java.io :as io]
    [clojure.set :as set]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [next.jdbc :as jdbc]
    [next.jdbc.date-time :as jdbc-dt])
@@ -49,27 +48,17 @@
 ;; Initialization
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::connection-timeout ::us/integer)
+(def ^:private schema:pool-options
-(s/def ::max-size ::us/integer)
+  [:map {:title "pool-options"}
-(s/def ::min-size ::us/integer)
+   [::connect-timeout {:optional true} ::sm/int]
-(s/def ::name keyword?)
+   [::max-size {:optional true} ::sm/int]
-(s/def ::password ::us/string)
+   [::min-size {:optional true} ::sm/int]
-(s/def ::uri ::us/not-empty-string)
+   [::name {:optional true} :keyword]
-(s/def ::username ::us/string)
+   [::uri {:optional true} ::sm/uri]
-(s/def ::validation-timeout ::us/integer)
+   [::password {:optional true} :string]
-(s/def ::read-only? ::us/boolean)
+   [::username {:optional true} :string]
-
+   [::validation-timeout {:optional true} ::sm/int]
-(s/def ::pool-options
+   [::read-only {:optional true} ::sm/boolean]])
-  (s/keys :opt [::uri
-                ::name
-                ::min-size
-                ::max-size
-                ::connection-timeout
-                ::validation-timeout
-                ::username
-                ::password
-                ::mtx/metrics
-                ::read-only?]))
 
 (def defaults
   {::name :main
@@ -79,27 +68,26 @@
    ::validation-timeout 10000
    ::idle-timeout 120000 ; 2min
    ::max-lifetime 1800000 ; 30m
-   ::read-only? false})
+   ::read-only false})
 
-(defmethod ig/prep-key ::pool
+(defmethod ig/assert-key ::pool
-  [_ cfg]
+  [_ options]
-  (merge defaults (d/without-nils cfg)))
+  (assert (sm/check schema:pool-options options)))
-
-;; Don't validate here, just validate that a map is received.
-(defmethod ig/pre-init-spec ::pool [_] ::pool-options)
 
 (defmethod ig/init-key ::pool
-  [_ {:keys [::uri ::read-only?] :as cfg}]
+  [_ cfg]
+  (let [{:keys [::uri ::read-only] :as cfg}
+        (merge defaults cfg)]
     (when uri
       (l/info :hint "initialize connection pool"
               :name (d/name (::name cfg))
-            :uri uri
+              :uri (str uri)
-            :read-only read-only?
+              :read-only read-only
-            :with-credentials (and (contains? cfg ::username)
+              :credentials (and (contains? cfg ::username)
                                 (contains? cfg ::password))
               :min-size (::min-size cfg)
               :max-size (::max-size cfg))
-    (create-pool cfg)))
+      (create-pool cfg))))
 
 (defmethod ig/halt-key! ::pool
   [_ pool]
@@ -115,13 +103,15 @@
        "SET idle_in_transaction_session_timeout = 300000;"))
 
 (defn- create-datasource-config
-  [{:keys [::mtx/metrics ::uri] :as cfg}]
+  [{:keys [::uri] :as cfg}]
+
+  ;; (app.common.pprint/pprint cfg)
   (let [config (HikariConfig.)]
     (doto config
       (.setJdbcUrl           (str "jdbc:" uri))
       (.setPoolName          (d/name (::name cfg)))
       (.setAutoCommit true)
-      (.setReadOnly          (::read-only? cfg))
+      (.setReadOnly          (::read-only cfg))
       (.setConnectionTimeout (::connection-timeout cfg))
       (.setValidationTimeout (::validation-timeout cfg))
       (.setIdleTimeout       (::idle-timeout cfg))
@@ -132,8 +122,8 @@
       (.setInitializationFailTimeout -1))
 
     ;; When metrics namespace is provided
-    (when metrics
+    (when-let [instance (::mtx/metrics cfg)]
-      (->> (::mtx/registry metrics)
+      (->> (mtx/get-registry instance)
            (PrometheusMetricsTrackerFactory.)
            (.setMetricsTrackerFactory config)))
 
@@ -150,10 +140,22 @@
   [conn]
   (instance? Connection conn))
 
-(s/def ::conn some?)
+(defn connectable?
-(s/def ::nilable-pool (s/nilable ::pool))
+  [o]
-(s/def ::pool pool?)
+  (or (connection? o)
-(s/def ::connectable some?)
+      (pool? o)))
+
+(sm/register!
+ {:type ::conn
+  :pred connection?})
+
+(sm/register!
+ {:type ::connectable
+  :pred connectable?})
+
+(sm/register!
+ {:type ::pool
+  :pred pool?})
 
 (defn closed?
   [pool]

backend/src/app/email.clj

@@ -12,18 +12,12 @@
    [app.common.logging :as l]
    [app.common.pprint :as pp]
    [app.common.schema :as sm]
-   [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
-   [app.email.invite-to-team :as-alias email.invite-to-team]
-   [app.email.join-team :as-alias email.join-team]
-   [app.email.request-team-access :as-alias email.request-team-access]
-   [app.metrics :as mtx]
    [app.util.template :as tmpl]
    [app.worker :as wrk]
    [clojure.java.io :as io]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig])
   (:import
@@ -223,37 +217,35 @@
               [{:type "text/html"
                 :content html}]))}))
 
-(s/def ::priority #{:high :low})
+(def ^:private schema:context
-(s/def ::to (s/or :single ::us/email
+  [:map
-                  :multi (s/coll-of ::us/email)))
+   [:to [:or ::sm/email [::sm/vec ::sm/email]]]
-(s/def ::from ::us/email)
+   [:reply-to {:optional true} ::sm/email]
-(s/def ::reply-to ::us/email)
+   [:from {:optional true} ::sm/email]
-(s/def ::lang string?)
+   [:lang {:optional true} ::sm/text]
-(s/def ::extra-data ::us/string)
+   [:priority {:optional true} [:enum :high :low]]
+   [:extra-data {:optional true} ::sm/text]])
 
-(s/def ::context
+(def ^:private valid-context?
-  (s/keys :req-un [::to]
+  (sm/validator schema:context))
-          :opt-un [::reply-to ::from ::lang ::priority ::extra-data]))
 
 (defn template-factory
-  ([id] (template-factory id {}))
+  [& {:keys [id schema]}]
-  ([id extra-context]
+  (assert (keyword? id) "id should be provided and it should be a keyword")
-   (s/assert keyword? id)
+  (let [check-fn (if schema
+                   (sm/check-fn schema)
+                   (constantly nil))]
     (fn [context]
-     (us/verify ::context context)
+      (assert (valid-context? context) "expected a valid context")
-     (when-let [spec (s/get-spec id)]
+      (check-fn context)
-       (s/assert spec context))
 
-     (let [context (merge (if (fn? extra-context)
+      (let [email (build-email-template id context)]
-                            (extra-context)
-                            extra-context)
-                          context)
-           email   (build-email-template id context)]
         (when-not email
           (ex/raise :type :internal
                     :code :email-template-does-not-exists
                     :hint "seems like the template is wrong or does not exists."
-                   :context {:id id}))
+                    :template-id id))
+
         (cond-> (assoc email :id (name id))
           (:extra-data context)
           (assoc :extra-data (:extra-data context))
@@ -267,7 +259,6 @@
           (:to context)
           (assoc :to (:to context)))))))
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; PUBLIC HIGH-LEVEL API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -280,7 +271,8 @@
   "Schedule an already defined email to be sent using asynchronously
   using worker task."
   [{:keys [::conn ::factory] :as context}]
-  (us/verify some? conn)
+  (assert (db/connection? conn) "expected a valid database connection")
+
   (let [email (if factory
                 (factory context)
                 (dissoc context ::conn))]
@@ -297,8 +289,6 @@
 
 (declare send-to-logger!)
 
-(s/def ::sendmail fn?)
-
 (defmethod ig/init-key ::sendmail
   [_ cfg]
   (fn [params]
@@ -324,8 +314,9 @@
     (when (contains? cf/flags :log-emails)
       (send-to-logger! cfg params))))
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::sendmail ::mtx/metrics]))
+  [_ params]
+  (assert (fn? (::sendmail params)) "expected valid sendmail handler"))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::sendmail]}]
@@ -352,125 +343,113 @@
 ;; EMAIL FACTORIES
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::subject ::us/string)
+(def ^:private schema:feedback
-(s/def ::content ::us/string)
+  [:map
-
+   [:subject ::sm/text]
-(s/def ::feedback
+   [:content ::sm/text]])
-  (s/keys :req-un [::subject ::content]))
 
 (def feedback
   "A profile feedback email."
-  (template-factory ::feedback))
+  (template-factory
+   :id ::feedback
+   :schema schema:feedback))
 
-(s/def ::name ::us/string)
+(def ^:private schema:register
-(s/def ::register
+  [:map [:name ::sm/text]])
-  (s/keys :req-un [::name]))
 
 (def register
   "A new profile registration welcome email."
-  (template-factory ::register))
+  (template-factory
+   :id ::register
+   :schema schema:register))
 
-(s/def ::token ::us/string)
+(def ^:private schema:password-recovery
-(s/def ::password-recovery
+  [:map
-  (s/keys :req-un [::name ::token]))
+   [:name ::sm/text]
+   [:token ::sm/text]])
 
 (def password-recovery
   "A password recovery notification email."
-  (template-factory ::password-recovery))
+  (template-factory
+   :id ::password-recovery
+   :schema schema:password-recovery))
 
-(s/def ::pending-email ::us/email)
+(def ^:private schema:change-email
-(s/def ::change-email
+  [:map
-  (s/keys :req-un [::name ::pending-email ::token]))
+   [:name ::sm/text]
+   [:pending-email ::sm/email]
+   [:token ::sm/text]])
 
 (def change-email
   "Password change confirmation email"
-  (template-factory ::change-email))
+  (template-factory
+   :id ::change-email
+   :schema schema:change-email))
 
-(s/def ::email.invite-to-team/invited-by ::us/string)
+(def ^:private schema:invite-to-team
-(s/def ::email.invite-to-team/team ::us/string)
+  [:map
-(s/def ::email.invite-to-team/token ::us/string)
+   [:invited-by ::sm/text]
-
+   [:team ::sm/text]
-(s/def ::invite-to-team
+   [:token ::sm/text]])
-  (s/keys :req-un [::email.invite-to-team/invited-by
-                   ::email.invite-to-team/token
-                   ::email.invite-to-team/team]))
 
 (def invite-to-team
   "Teams member invitation email."
-  (template-factory ::invite-to-team))
+  (template-factory
+   :id ::invite-to-team
+   :schema schema:invite-to-team))
 
-
+(def ^:private schema:join-team
-(s/def ::email.join-team/invited-by ::us/string)
+  [:map
-(s/def ::email.join-team/team ::us/string)
+   [:invited-by ::sm/text]
-(s/def ::email.join-team/team-id ::us/uuid)
+   [:team ::sm/text]
-
+   [:team-id ::sm/uuid]])
-(s/def ::join-team
-  (s/keys :req-un [::email.join-team/invited-by
-                   ::email.join-team/team-id
-                   ::email.join-team/team]))
 
 (def join-team
   "Teams member joined after request email."
-  (template-factory ::join-team))
+  (template-factory
+   :id ::join-team
+   :schema schema:join-team))
 
-(s/def ::email.request-team-access/requested-by ::us/string)
+(def ^:private schema:request-file-access
-(s/def ::email.request-team-access/requested-by-email ::us/string)
+  [:map
-(s/def ::email.request-team-access/team-name ::us/string)
+   [:requested-by ::sm/text]
-(s/def ::email.request-team-access/team-id ::us/uuid)
+   [:requested-by-email ::sm/text]
-(s/def ::email.request-team-access/file-name ::us/string)
+   [:team-name ::sm/text]
-(s/def ::email.request-team-access/file-id ::us/uuid)
+   [:team-id ::sm/uuid]
-(s/def ::email.request-team-access/page-id ::us/uuid)
+   [:file-name ::sm/text]
-
+   [:file-id ::sm/uuid]
-(s/def ::request-file-access
+   [:page-id ::sm/uuid]])
-  (s/keys :req-un [::email.request-team-access/requested-by
-                   ::email.request-team-access/requested-by-email
-                   ::email.request-team-access/team-name
-                   ::email.request-team-access/team-id
-                   ::email.request-team-access/file-name
-                   ::email.request-team-access/file-id
-                   ::email.request-team-access/page-id]))
 
 (def request-file-access
   "File access request email."
-  (template-factory ::request-file-access))
+  (template-factory
-
+   :id ::request-file-access
-
+   :schema schema:request-file-access))
-(s/def ::request-file-access-yourpenpot
-  (s/keys :req-un [::email.request-team-access/requested-by
-                   ::email.request-team-access/requested-by-email
-                   ::email.request-team-access/team-name
-                   ::email.request-team-access/team-id
-                   ::email.request-team-access/file-name
-                   ::email.request-team-access/file-id
-                   ::email.request-team-access/page-id]))
 
 (def request-file-access-yourpenpot
   "File access on Your Penpot request email."
-  (template-factory ::request-file-access-yourpenpot))
+  (template-factory
-
+   :id ::request-file-access-yourpenpot
-(s/def ::request-file-access-yourpenpot-view
+   :schema schema:request-file-access))
-  (s/keys :req-un [::email.request-team-access/requested-by
-                   ::email.request-team-access/requested-by-email
-                   ::email.request-team-access/team-name
-                   ::email.request-team-access/team-id
-                   ::email.request-team-access/file-name
-                   ::email.request-team-access/file-id
-                   ::email.request-team-access/page-id]))
 
 (def request-file-access-yourpenpot-view
   "File access on Your Penpot view mode request email."
-  (template-factory ::request-file-access-yourpenpot-view))
+  (template-factory
+   :id ::request-file-access-yourpenpot-view
+   :schema schema:request-file-access))
 
-(s/def ::request-team-access
+(def ^:private schema:request-team-access
-  (s/keys :req-un [::email.request-team-access/requested-by
+  [:map
-                   ::email.request-team-access/requested-by-email
+   [:requested-by ::sm/text]
-                   ::email.request-team-access/team-name
+   [:requested-by-email ::sm/text]
-                   ::email.request-team-access/team-id]))
+   [:team-name ::sm/text]
+   [:team-id ::sm/uuid]])
 
 (def request-team-access
   "Team access request email."
-  (template-factory ::request-team-access))
+  (template-factory
-
+   :id ::request-team-access
+   :schema schema:request-team-access))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; BOUNCE/COMPLAINS HELPERS

backend/src/app/http.clj

@@ -9,6 +9,7 @@
    [app.auth.oidc :as-alias oidc]
    [app.common.data :as d]
    [app.common.logging :as l]
+   [app.common.schema :as sm]
    [app.common.transit :as t]
    [app.db :as-alias db]
    [app.http.access-token :as actoken]
@@ -24,7 +25,6 @@
    [app.rpc :as-alias rpc]
    [app.rpc.doc :as-alias rpc.doc]
    [app.setup :as-alias setup]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.exec :as px]
    [reitit.core :as r]
@@ -39,31 +39,28 @@
 ;; HTTP SERVER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::handler fn?)
+(def default-params
-(s/def ::router some?)
+  {::port 6060
-(s/def ::port integer?)
-(s/def ::host string?)
-(s/def ::name string?)
-
-(s/def ::max-body-size integer?)
-(s/def ::max-multipart-body-size integer?)
-(s/def ::io-threads integer?)
-
-(defmethod ig/prep-key ::server
-  [_ cfg]
-  (merge {::port 6060
    ::host "0.0.0.0"
    ::max-body-size (* 1024 1024 30)             ; default 30 MiB
-          ::max-multipart-body-size (* 1024 1024 120)} ; default 120 MiB
+   ::max-multipart-body-size (* 1024 1024 120)}) ; default 120 MiB
-         (d/without-nils cfg)))
 
-(defmethod ig/pre-init-spec ::server [_]
+(defmethod ig/expand-key ::server
-  (s/keys :req [::port ::host]
+  [k v]
-          :opt [::max-body-size
+  {k (merge default-params (d/without-nils v))})
-                ::max-multipart-body-size
+
-                ::router
+(def ^:private schema:server-params
-                ::handler
+  [:map
-                ::io-threads]))
+   [::port ::sm/int]
+   [::host ::sm/text]
+   [::max-body-size {:optional true} ::sm/int]
+   [::max-multipart-body-size {:optional true} ::sm/int]
+   [::router {:optional true} [:fn r/router?]]
+   [::handler {:optional true} ::sm/fn]])
+
+(defmethod ig/assert-key ::server
+  [_ params]
+  (assert (sm/check schema:server-params params)))
 
 (defmethod ig/init-key ::server
   [_ {:keys [::handler ::router ::host ::port] :as cfg}]
@@ -131,18 +128,26 @@
 ;; HTTP ROUTER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/pre-init-spec ::router [_]
+(def ^:private schema:routes
-  (s/keys :req [::session/manager
+  [:vector :any])
-                ::ws/routes
+
-                ::rpc/routes
+(def ^:private schema:router-params
-                ::rpc.doc/routes
+  [:map
-                ::oidc/routes
+   [::ws/routes schema:routes]
+   [::rpc/routes schema:routes]
+   [::rpc.doc/routes schema:routes]
+   [::oidc/routes schema:routes]
+   [::assets/routes schema:routes]
+   [::debug/routes schema:routes]
+   [::mtx/routes schema:routes]
+   [::awsns/routes schema:routes]
+   ::session/manager
    ::setup/props
-                ::assets/routes
+   ::db/pool])
-                ::debug/routes
+
-                ::db/pool
+(defmethod ig/assert-key ::router
-                ::mtx/routes
+  [_ params]
-                ::awsns/routes]))
+  (assert (sm/check schema:router-params params)))
 
 (defmethod ig/init-key ::router
   [_ cfg]

backend/src/app/http/assets.clj

@@ -9,12 +9,10 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
    [app.common.uri :as u]
    [app.db :as db]
    [app.storage :as sto]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [yetti.response :as-alias yres]))
 
@@ -95,11 +93,10 @@
 
 ;; --- Initialization
 
-(s/def ::path ::us/string)
+(defmethod ig/assert-key ::routes
-(s/def ::routes vector?)
+  [_ params]
-
+  (assert (sto/valid-storage? (::sto/storage params)) "expected valid storage instance")
-(defmethod ig/pre-init-spec ::routes [_]
+  (assert (string? (::path params))))
-  (s/keys :req [::sto/storage  ::path]))
 
 (defmethod ig/init-key ::routes
   [_ cfg]

backend/src/app/http/awsns.clj

@@ -10,6 +10,7 @@
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.pprint :as pp]
+   [app.common.schema :as sm]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.http.client :as http]
@@ -18,7 +19,6 @@
    [app.tokens :as tokens]
    [app.worker :as-alias wrk]
    [clojure.data.json :as j]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.exec :as px]
@@ -30,10 +30,11 @@
 (declare parse-notification)
 (declare process-report)
 
-(defmethod ig/pre-init-spec ::routes [_]
+(defmethod ig/assert-key ::routes
-  (s/keys :req [::http/client
+  [_ params]
-                ::setup/props
+  (assert (http/client? (::http/client params)) "expect a valid http client")
-                ::db/pool]))
+  (assert (sm/valid? ::setup/props (::setup/props params)) "expected valid setup props")
+  (assert (db/pool? (::db/pool params)) "expect valid database pool"))
 
 (defmethod ig/init-key ::routes
   [_ cfg]

backend/src/app/http/client.clj

@@ -7,20 +7,20 @@
 (ns app.http.client
   "Http client abstraction layer."
   (:require
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [java-http-clj.core :as http]
    [promesa.core :as p])
   (:import
    java.net.http.HttpClient))
 
-(s/def ::client #(instance? HttpClient %))
+(defn client?
-(s/def ::client-holder
+  [o]
-  (s/keys :req [::client]))
+  (instance? HttpClient o))
 
-(defmethod ig/pre-init-spec ::client [_]
+(sm/register!
-  (s/keys :req []))
+ {:type ::client
+  :pred client?})
 
 (defmethod ig/init-key ::client
   [_ _]
@@ -30,7 +30,7 @@
 (defn send!
   ([client req] (send! client req {}))
   ([client req {:keys [response-type sync?] :or {response-type :string sync? false}}]
-   (us/assert! ::client client)
+   (assert (client? client) "expected valid http client")
    (if sync?
      (http/send req {:client client :as response-type})
      (try

backend/src/app/http/debug.clj

@@ -26,7 +26,6 @@
    [app.util.blob :as blob]
    [app.util.template :as tmpl]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.io :as io]
    [emoji.core :as emj]
@@ -473,8 +472,10 @@
            (ex/raise :type :authentication
                      :code :only-admins-allowed)))))})
 
-(defmethod ig/pre-init-spec ::routes [_]
+(defmethod ig/assert-key ::routes
-  (s/keys :req [::db/pool ::session/manager]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool")
+  (assert (session/manager? (::session/manager params)) "expected a valid session manager"))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [::db/pool] :as cfg}]

backend/src/app/http/session.clj

@@ -9,7 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
@@ -19,7 +19,6 @@
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [yetti.request :as yreq]))
@@ -51,21 +50,32 @@
   (update! [_ data])
   (delete! [_ key]))
 
-(s/def ::manager #(satisfies? ISessionManager %))
+(defn manager?
+  [o]
+  (satisfies? ISessionManager o))
+
+(sm/register!
+ {:type ::manager
+  :pred manager?})
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; STORAGE IMPL
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::session-params
+(def ^:private schema:params
-  (s/keys :req-un [::user-agent
+  [:map {:title "session-params"}
-                   ::profile-id
+   [:user-agent ::sm/text]
-                   ::created-at]))
+   [:profile-id ::sm/uuid]
+   [:created-at ::sm/inst]])
+
+(def ^:private valid-params?
+  (sm/validator schema:params))
 
 (defn- prepare-session-params
   [key params]
-  (us/assert! ::us/not-empty-string key)
+  (assert (string? key) "expected key to be a string")
-  (us/assert! ::session-params params)
+  (assert (not (str/blank? key)) "expected key to be not empty")
+  (assert (valid-params? params) "expected valid params")
 
   {:user-agent (:user-agent params)
    :profile-id (:profile-id params)
@@ -116,8 +126,9 @@
         (swap! cache dissoc token)
         nil))))
 
-(defmethod ig/pre-init-spec ::manager [_]
+(defmethod ig/assert-key ::manager
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expect valid database pool"))
 
 (defmethod ig/init-key ::manager
   [_ {:keys [::db/pool]}]
@@ -140,8 +151,8 @@
 
 (defn create-fn
   [{:keys [::manager ::setup/props]} profile-id]
-  (us/assert! ::manager manager)
+  (assert (manager? manager) "expected valid session manager")
-  (us/assert! ::us/uuid profile-id)
+  (assert (uuid? profile-id) "expected valid uuid for profile-id")
 
   (fn [request response]
     (let [uagent  (yreq/get-header request "user-agent")
@@ -157,7 +168,7 @@
 
 (defn delete-fn
   [{:keys [::manager]}]
-  (us/assert! ::manager manager)
+  (assert (manager? manager) "expected valid session manager")
   (fn [request response]
     (let [cname   (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
           cookie  (yreq/get-cookie request cname)]
@@ -198,7 +209,7 @@
 
 (defn- wrap-soft-auth
   [handler {:keys [::manager ::setup/props]}]
-  (us/assert! ::manager manager)
+  (assert (manager? manager) "expected valid session manager")
   (letfn [(handle-request [request]
             (try
               (let [token  (get-token request)
@@ -216,7 +227,7 @@
 
 (defn- wrap-authz
   [handler {:keys [::manager]}]
-  (us/assert! ::manager manager)
+  (assert (manager? manager) "expected valid session manager")
   (fn [request]
     (let [session  (get-session manager (::token request))
           request  (cond-> request
@@ -307,16 +318,17 @@
 ;; TASK: SESSION GC
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::tasks/max-age ::dt/duration)
+;; FIXME: MOVE
 
-(defmethod ig/pre-init-spec ::tasks/gc [_]
+(defmethod ig/assert-key ::tasks/gc
-  (s/keys :req [::db/pool]
+  [_ params]
-          :opt [::tasks/max-age]))
+  (assert (db/pool? (::db/pool params)) "expected valid database pool")
+  (assert (dt/duration? (::tasks/max-age params))))
 
-(defmethod ig/prep-key ::tasks/gc
+(defmethod ig/expand-key ::tasks/gc
-  [_ cfg]
+  [k v]
   (let [max-age (cf/get :auth-token-cookie-max-age default-cookie-max-age)]
-    (merge {::tasks/max-age max-age} (d/without-nils cfg))))
+    {k (merge {::tasks/max-age max-age} (d/without-nils v))}))
 
 (def ^:private
   sql:delete-expired

backend/src/app/http/websocket.clj

@@ -18,7 +18,6 @@
    [app.msgbus :as mbus]
    [app.util.time :as dt]
    [app.util.websocket :as ws]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.exec.csp :as sp]
    [yetti.websocket :as yws]))
@@ -305,13 +304,17 @@
                                      ::profile-id profile-id
                                      ::session-id session-id)}))))
 
-(defmethod ig/pre-init-spec ::routes [_]
+
-  (s/keys :req [::mbus/msgbus
+(def ^:private schema:routes-params
+  [:map
+   ::mbus/msgbus
    ::mtx/metrics
    ::db/pool
-                ::session/manager]))
+   ::session/manager])
 
-(s/def ::routes vector?)
+(defmethod ig/assert-key ::routes
+  [_ params]
+  (assert (sm/valid? schema:routes-params params)))
 
 (defmethod ig/init-key ::routes
   [_ cfg]

backend/src/app/loggers/audit.clj

@@ -10,7 +10,7 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
@@ -25,9 +25,7 @@
    [app.util.services :as-alias sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]))
-   [cuerdas.core :as str]
-   [integrant.core :as ig]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; HELPERS
@@ -95,46 +93,28 @@
 ;; --- SPECS
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; COLLECTOR
+;; COLLECTOR API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Defines a service that collects the audit/activity log using
 ;; internal database. Later this audit log can be transferred to
 ;; an external storage and data cleared.
 
-(s/def ::profile-id ::us/uuid)
+(def ^:private schema:event
-(s/def ::name ::us/string)
+  [:map {:title "event"}
-(s/def ::type ::us/string)
+   [::type ::sm/text]
-(s/def ::props (s/map-of ::us/keyword any?))
+   [::name ::sm/text]
-(s/def ::ip-addr ::us/string)
+   [::profile-id ::sm/uuid]
+   [::ip-addr {:optional true} ::sm/text]
+   [::props {:optional true} [:map-of :keyword :any]]
+   [::context {:optional true} [:map-of :keyword :any]]
+   [::webhooks/event? {:optional true} ::sm/boolean]
+   [::webhooks/batch-timeout {:optional true} ::dt/duration]
+   [::webhooks/batch-key {:optional true}
+    [:or ::sm/fn ::sm/text :keyword]]])
 
-(s/def ::webhooks/event? ::us/boolean)
+(def ^:private check-event
-(s/def ::webhooks/batch-timeout ::dt/duration)
+  (sm/check-fn schema:event))
-(s/def ::webhooks/batch-key
-  (s/or :fn fn? :str string? :kw keyword?))
-
-(s/def ::event
-  (s/keys :req [::type ::name ::profile-id]
-          :opt [::ip-addr
-                ::props
-                ::webhooks/event?
-                ::webhooks/batch-timeout
-                ::webhooks/batch-key]))
-
-(s/def ::collector
-  (s/keys :req [::wrk/executor ::db/pool]))
-
-(defmethod ig/pre-init-spec ::collector [_]
-  (s/keys :req [::db/pool ::wrk/executor]))
-
-(defmethod ig/init-key ::collector
-  [_ {:keys [::db/pool] :as cfg}]
-  (cond
-    (db/read-only? pool)
-    (l/warn :hint "audit disabled (db is read-only)")
-
-    :else
-    cfg))
 
 (defn prepare-event
   [cfg mdata params result]
@@ -273,12 +253,12 @@
   "Submit audit event to the collector."
   [cfg event]
   (try
-    (let [event (d/without-nils event)
+    (let [event (-> (d/without-nils event)
+                    (check-event))
           cfg   (-> cfg
                     (assoc ::rtry/when rtry/conflict-exception?)
                     (assoc ::rtry/max-retries 6)
                     (assoc ::rtry/label "persist-audit-log"))]
-      (us/verify! ::event event)
       (rtry/invoke! cfg db/tx-run! handle-event! event))
     (catch Throwable cause
       (l/error :hint "unexpected error processing event" :cause cause))))
@@ -289,8 +269,8 @@
   logic."
   [cfg event]
   (when (contains? cf/flags :audit-log)
-    (let [event (d/without-nils event)]
+    (let [event (-> (d/without-nils event)
-      (us/verify! ::event event)
+                    (check-event))]
       (db/run! cfg (fn [cfg]
                      (let [tnow   (dt/now)
                            params (-> (event->params event)

backend/src/app/loggers/audit/archive_task.clj

@@ -8,6 +8,7 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
+   [app.common.schema :as sm]
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -16,7 +17,6 @@
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [lambdaisland.uri :as u]
    [promesa.exec :as px]))
@@ -108,8 +108,15 @@
                           (mark-archived! cfg rows)
                           (count events)))))))
 
-(defmethod ig/pre-init-spec ::handler [_]
+(def ^:private schema:handler-params
-  (s/keys :req [::db/pool ::setup/props ::http/client]))
+  [:map
+   ::db/pool
+   ::setup/props
+   ::http/client])
+
+(defmethod ig/assert-key ::handler
+  [_ params]
+  (assert (sm/valid? schema:handler-params params) "valid params expected for handler"))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/loggers/audit/gc_task.clj

@@ -8,7 +8,6 @@
   (:require
    [app.common.logging :as l]
    [app.db :as db]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private sql:clean-archived
@@ -22,8 +21,9 @@
     (l/debug :hint "delete archived audit log entries" :deleted result)
     result))
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "valid database pool expected"))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/loggers/database.clj

@@ -12,7 +12,6 @@
    [app.common.logging :as l]
    [app.common.pprint :as pp]
    [app.common.schema :as sm]
-   [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
    [clojure.spec.alpha :as s]
@@ -38,7 +37,7 @@
 
 (defn record->report
   [{:keys [::l/context ::l/message ::l/props ::l/logger ::l/level ::l/cause] :as record}]
-  (us/assert! ::l/record record)
+  (assert (l/valid-record? record) "expectd valid log record")
   (if (or (instance? java.util.concurrent.CompletionException cause)
           (instance? java.util.concurrent.ExecutionException cause))
     (-> record
@@ -91,8 +90,9 @@
     (catch Throwable cause
       (l/warn :hint "unexpected exception on database error logger" :cause cause))))
 
-(defmethod ig/pre-init-spec ::reporter [_]
+(defmethod ig/assert-key ::reporter
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expect valid database pool"))
 
 (defmethod ig/init-key ::reporter
   [_ cfg]

backend/src/app/loggers/mattermost.clj

@@ -9,12 +9,10 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
    [app.config :as cf]
    [app.http.client :as http]
    [app.loggers.database :as ldb]
    [app.util.json :as json]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.exec :as px]
    [promesa.exec.csp :as sp]))
@@ -54,7 +52,7 @@
 
 (defn record->report
   [{:keys [::l/context ::l/id ::l/cause] :as record}]
-  (us/assert! ::l/record record)
+  (assert (l/valid-record? record) "expectd valid log record")
   {:id               id
    :tenant           (cf/get :tenant)
    :host             (cf/get :host)
@@ -75,8 +73,9 @@
       (catch Throwable cause
         (l/warn :hint "unhandled error" :cause cause)))))
 
-(defmethod ig/pre-init-spec ::reporter [_]
+(defmethod ig/assert-key ::reporter
-  (s/keys :req [::http/client]))
+  [_ params]
+  (assert (http/client? (::http/client params)) "expect valid http client"))
 
 (defmethod ig/init-key ::reporter
   [_ cfg]

backend/src/app/loggers/webhooks.clj

@@ -18,7 +18,6 @@
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.data.json :as json]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]))
 
@@ -60,8 +59,10 @@
       (some->> (:project-id props) (lookup-webhooks-by-project pool))
       (some->> (:file-id props) (lookup-webhooks-by-file pool))))
 
-(defmethod ig/pre-init-spec ::process-event-handler [_]
+(defmethod ig/assert-key ::process-event-handler
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expect valid database pool")
+  (assert (http/client? (::http/client params)) "expect valid http client"))
 
 (defmethod ig/init-key ::process-event-handler
   [_ cfg]
@@ -87,12 +88,14 @@
   {:key-fn str/camel
    :indent true})
 
-(defmethod ig/pre-init-spec ::run-webhook-handler [_]
+(defmethod ig/assert-key ::run-webhook-handler
-  (s/keys :req [::http/client ::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expect valid database pool")
+  (assert (http/client? (::http/client params)) "expect valid http client"))
 
-(defmethod ig/prep-key ::run-webhook-handler
+(defmethod ig/expand-key ::run-webhook-handler
-  [_ cfg]
+  [k v]
-  (merge {::max-errors 3} (d/without-nils cfg)))
+  {k (merge {::max-errors 3} (d/without-nils v))})
 
 (defmethod ig/init-key ::run-webhook-handler
   [_ {:keys [::db/pool ::max-errors] :as cfg}]

backend/src/app/main.clj

@@ -9,6 +9,7 @@
    [app.auth.ldap :as-alias ldap]
    [app.auth.oidc :as-alias oidc]
    [app.auth.oidc.providers :as-alias oidc.providers]
+   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.config :as cf]
    [app.db :as-alias db]
@@ -28,6 +29,7 @@
    [app.msgbus :as-alias mbus]
    [app.redis :as-alias rds]
    [app.rpc :as-alias rpc]
+   [app.rpc.climit :as-alias climit]
    [app.rpc.doc :as-alias rpc.doc]
    [app.setup :as-alias setup]
    [app.srepl :as-alias srepl]
@@ -169,7 +171,7 @@
    {::db/uri        (cf/get :database-uri)
     ::db/username   (cf/get :database-username)
     ::db/password   (cf/get :database-password)
-    ::db/read-only? (cf/get :database-readonly false)
+    ::db/read-only  (cf/get :database-readonly false)
     ::db/min-size   (cf/get :database-min-pool-size 0)
     ::db/max-size   (cf/get :database-max-pool-size 60)
     ::mtx/metrics   (ig/ref ::mtx/metrics)}
@@ -245,7 +247,7 @@
     :base-dn        (cf/get :ldap-base-dn)
     :bind-dn        (cf/get :ldap-bind-dn)
     :bind-password  (cf/get :ldap-bind-password)
-    :enabled?       (contains? cf/flags :login-with-ldap)}
+    :enabled        (contains? cf/flags :login-with-ldap)}
 
    ::oidc.providers/google
    {}
@@ -302,9 +304,11 @@
     ::http.assets/cache-max-agesignature-max-age (dt/duration {:hours 24 :minutes 5})
     ::sto/storage  (ig/ref ::sto/storage)}
 
-   :app.rpc/climit
+   ::rpc/climit
    {::mtx/metrics        (ig/ref ::mtx/metrics)
-    ::wrk/executor (ig/ref ::wrk/executor)}
+    ::wrk/executor       (ig/ref ::wrk/executor)
+    ::climit/config      (cf/get :rpc-climit-config)
+    ::climit/enabled     (contains? cf/flags :rpc-climit)}
 
    :app.rpc/rlimit
    {::wrk/executor (ig/ref ::wrk/executor)}
@@ -329,7 +333,7 @@
     ::email/whitelist    (ig/ref ::email/whitelist)}
 
    :app.rpc.doc/routes
-   {:methods (ig/ref :app.rpc/methods)}
+   {:app.rpc/methods (ig/ref :app.rpc/methods)}
 
    :app.rpc/routes
    {::rpc/methods     (ig/ref :app.rpc/methods)
@@ -378,8 +382,7 @@
     ::email/default-from     (cf/get :smtp-default-from)}
 
    ::email/handler
-   {::email/sendmail (ig/ref ::email/sendmail)
+   {::email/sendmail (ig/ref ::email/sendmail)}
-    ::mtx/metrics    (ig/ref ::mtx/metrics)}
 
    :app.tasks.tasks-gc/handler
    {::db/pool (ig/ref ::db/pool)}
@@ -516,11 +519,13 @@
    ::wrk/dispatcher
    {::rds/redis   (ig/ref ::rds/redis)
     ::mtx/metrics (ig/ref ::mtx/metrics)
-    ::db/pool     (ig/ref ::db/pool)}
+    ::db/pool     (ig/ref ::db/pool)
+    ::wrk/tenant  (cf/get :tenant)}
 
    [::default ::wrk/runner]
    {::wrk/parallelism (cf/get ::worker-default-parallelism 1)
     ::wrk/queue       :default
+    ::wrk/tenant      (cf/get :tenant)
     ::rds/redis       (ig/ref ::rds/redis)
     ::wrk/registry    (ig/ref ::wrk/registry)
     ::mtx/metrics     (ig/ref ::mtx/metrics)
@@ -529,6 +534,7 @@
    [::webhook ::wrk/runner]
    {::wrk/parallelism (cf/get ::worker-webhook-parallelism 1)
     ::wrk/queue       :webhooks
+    ::wrk/tenant      (cf/get :tenant)
     ::rds/redis       (ig/ref ::rds/redis)
     ::wrk/registry    (ig/ref ::wrk/registry)
     ::mtx/metrics     (ig/ref ::mtx/metrics)
@@ -546,7 +552,7 @@
                              (-> system-config
                                  (cond-> (contains? cf/flags :backend-worker)
                                    (merge worker-config))
-                                 (ig/prep)
+                                 (ig/expand)
                                  (ig/init))))
   (l/inf :hint "welcome to penpot"
          :flags (str/join "," (map name cf/flags))
@@ -559,7 +565,7 @@
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))
                              (-> config
-                                 (ig/prep)
+                                 (ig/expand)
                                  (ig/init)))))
 
 (defn stop
@@ -615,12 +621,6 @@
 
       (deref p))
     (catch Throwable cause
-      (binding [*out* *err*]
+      (ex/print-throwable cause)
-        (println "==== ERROR ===="))
-      (.printStackTrace cause)
-      (when-let [cause' (ex-cause cause)]
-        (binding [*out* *err*]
-          (println "==== CAUSE ===="))
-        (.printStackTrace cause'))
       (px/sleep 500)
       (System/exit -1))))

backend/src/app/media.clj

@@ -46,7 +46,8 @@
   (s/keys :req-un [::path]
           :opt-un [::mtype]))
 
-(sm/register! ::upload
+(sm/register!
+ ^{::sm/type ::upload}
  [:map {:title "Upload"}
   [:filename :string]
   [:size ::sm/int]

backend/src/app/metrics.clj

@@ -8,9 +8,8 @@
   (:refer-clojure :exclude [run!])
   (:require
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.metrics.definition :as-alias mdef]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig])
   (:import
    io.prometheus.client.CollectorRegistry
@@ -34,41 +33,52 @@
 (declare create-collector)
 (declare handler)
 
+(defprotocol IMetrics
+  (get-registry [_])
+  (get-collector [_ id])
+  (get-handler [_]))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; METRICS SERVICE PROVIDER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::mdef/name string?)
+(sm/register!
-(s/def ::mdef/help string?)
+ {:type ::collector
-(s/def ::mdef/labels (s/every string? :kind vector?))
+  :pred #(instance? SimpleCollector %)
-(s/def ::mdef/type #{:gauge :counter :summary :histogram})
+  :type-properties
+  {:title "collector"
+   :description "An instance of SimpleCollector"}})
 
-(s/def ::mdef/instance
+(sm/register!
-  #(instance? SimpleCollector %))
+ {:type ::registry
+  :pred  #(instance? CollectorRegistry %)
+  :type-properties
+  {:title "Metrics Registry"
+   :description "Instance of CollectorRegistry"}})
 
-(s/def ::mdef/definition
+(def ^:private schema:definitions
-  (s/keys :req [::mdef/name
+  [:map-of :keyword
-                ::mdef/help
+   [:map {:title "definition"}
-                ::mdef/type]
+    [::mdef/name :string]
-          :opt [::mdef/labels
+    [::mdef/help :string]
-                ::mdef/instance]))
+    [::mdef/type [:enum :gauge :counter :summary :histogram]]
+    [::mdef/labels {:optional true} [::sm/vec :string]]
+    [::mdef/instance {:optional true} ::collector]]])
 
-(s/def ::definitions
+(defn metrics?
-  (s/map-of keyword? ::mdef/definition))
+  [o]
+  (satisfies? IMetrics o))
 
-(s/def ::registry
+(sm/register!
-  #(instance? CollectorRegistry %))
+ {:type ::metrics
+  :pred metrics?})
 
-(s/def ::handler fn?)
+(def ^:private valid-definitions?
-(s/def ::metrics
+  (sm/validator schema:definitions))
-  (s/keys :req [::registry
-                ::handler
-                ::definitions]))
 
-(s/def ::default ::definitions)
+(defmethod ig/assert-key ::metrics
-
+  [_ {:keys [default]}]
-(defmethod ig/pre-init-spec ::metrics [_]
+  (assert (valid-definitions? default) "expected valid definitions"))
-  (s/keys :req-un [::default]))
 
 (defmethod ig/init-key ::metrics
   [_ cfg]
@@ -81,12 +91,14 @@
                                {}
                                (:default cfg))]
 
-    (us/verify! ::definitions definitions)
+    (reify
-
+      IMetrics
-    {::handler (partial handler registry)
+      (get-handler [_]
-     ::definitions definitions
+        (partial handler registry))
-     ::registry registry}))
+      (get-collector [_ id]
-
+        (get definitions id))
+      (get-registry [_]
+        registry))))
 
 (defn- handler
   [registry _]
@@ -96,17 +108,14 @@
     {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
      :body (.toString writer)}))
 
-
+(defmethod ig/assert-key ::routes
-
+  [_ {:keys [::metrics]}]
-(s/def ::routes vector?)
+  (assert (metrics? metrics) "expected a valid instance for metrics"))
-(defmethod ig/pre-init-spec ::routes [_]
-  (s/keys :req [::metrics]))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [::metrics]}]
-  (let [registry (::registry metrics)]
+  ["/metrics" {:handler (get-handler metrics)
-    ["/metrics" {:handler (partial handler registry)
+               :allowed-methods #{:get}}])
-                 :allowed-methods #{:get}}]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation
@@ -126,8 +135,9 @@
 (defmulti create-collector ::mdef/type)
 
 (defn run!
-  [{:keys [::definitions]} & {:keys [id] :as params}]
+  [instance & {:keys [id] :as params}]
-  (when-let [mobj (get definitions id)]
+  (assert (metrics? instance) "expected valid metrics instance")
+  (when-let [mobj (get-collector instance id)]
     (run-collector! mobj params)
     true))
 

backend/src/app/migrations.clj

@@ -11,7 +11,6 @@
    [app.db :as db]
    [app.migrations.clj.migration-0023 :as mg0023]
    [app.util.migrations :as mg]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def migrations
@@ -424,7 +423,10 @@
     :fn (mg/resource "app/migrations/sql/0133-mod-file-table.sql")}
 
    {:name "0134-mod-file-change-table"
-    :fn (mg/resource "app/migrations/sql/0134-mod-file-change-table.sql")}])
+    :fn (mg/resource "app/migrations/sql/0134-mod-file-change-table.sql")}
+
+   {:name "0135-mod-team-invitation-table.sql"
+    :fn (mg/resource "app/migrations/sql/0135-mod-team-invitation-table.sql")}])
 
 (defn apply-migrations!
   [pool name migrations]
@@ -432,9 +434,9 @@
     (mg/setup! conn)
     (mg/migrate! conn {:name name :steps migrations})))
 
-(defmethod ig/pre-init-spec ::migrations
+(defmethod ig/assert-key ::migrations
-  [_]
+  [_ {:keys [::db/pool]}]
-  (s/keys :req [::db/pool]))
+  (assert (db/pool? pool) "expected valid pool"))
 
 (defmethod ig/init-key ::migrations
   [module {:keys [::db/pool]}]

backend/src/app/migrations/sql/0135-mod-team-invitation-table.sql

@@ -0,0 +1,2 @@
+ALTER TABLE team_invitation
+  ADD COLUMN created_by uuid NULL REFERENCES profile(id) ON DELETE SET NULL;

backend/src/app/msgbus.clj

@@ -9,22 +9,27 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.transit :as t]
    [app.config :as cfg]
    [app.redis :as rds]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.core :as p]
    [promesa.exec :as px]
    [promesa.exec.csp :as sp]))
 
 (set! *warn-on-reflection* true)
-
 (def ^:private prefix (cfg/get :tenant))
 
+(defprotocol IMsgBus
+  (-sub [_ topics chan])
+  (-pub [_ topic message])
+  (-purge [_ chans]))
+
+
+
 (defn- prefix-topic
   [topic]
   (str prefix "." topic))
@@ -32,30 +37,33 @@
 (def ^:private xform-prefix-topic
   (map (fn [obj] (update obj :topic prefix-topic))))
 
-(declare ^:private redis-pub!)
+(declare ^:private redis-pub)
-(declare ^:private redis-sub!)
+(declare ^:private redis-sub)
-(declare ^:private redis-unsub!)
+(declare ^:private redis-unsub)
-(declare ^:private start-io-loop!)
+(declare ^:private start-io-loop)
 (declare ^:private subscribe-to-topics)
 (declare ^:private unsubscribe-channels)
 
-(s/def ::cmd-ch sp/chan?)
+(defn msgbus?
-(s/def ::rcv-ch sp/chan?)
+  [o]
-(s/def ::pub-ch sp/chan?)
+  (satisfies? IMsgBus o))
-(s/def ::state ::us/agent)
-(s/def ::pconn ::rds/connection-holder)
-(s/def ::sconn ::rds/connection-holder)
-(s/def ::msgbus
-  (s/keys :req [::cmd-ch ::rcv-ch ::pub-ch ::state ::pconn ::sconn ::wrk/executor]))
 
-(defmethod ig/pre-init-spec ::msgbus [_]
+(sm/register!
-  (s/keys :req [::rds/redis ::wrk/executor]))
+ {:type ::msgbus
+  :pred msgbus?})
 
-(defmethod ig/prep-key ::msgbus
+(defmethod ig/expand-key ::msgbus
-  [_ cfg]
+  [k v]
-  (-> cfg
+  {k (-> (d/without-nils v)
          (assoc ::buffer-size 128)
-      (assoc ::timeout (dt/duration {:seconds 30}))))
+         (assoc ::timeout (dt/duration {:seconds 30})))})
+
+(def ^:private schema:params
+  [:map ::rds/redis ::wrk/executor])
+
+(defmethod ig/assert-key ::msgbus
+  [_ params]
+  (assert (sm/check schema:params params)))
 
 (defmethod ig/init-key ::msgbus
   [_ {:keys [::buffer-size ::wrk/executor ::timeout ::rds/redis] :as cfg}]
@@ -66,47 +74,66 @@
                         :xf  xform-prefix-topic)
         state  (agent {})
 
-        pconn  (rds/connect redis :timeout timeout)
+        pconn  (rds/connect redis :type :default :timeout timeout)
         sconn  (rds/connect redis :type :pubsub :timeout timeout)
-        msgbus (-> cfg
+
+        _      (set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/sync? true))
+        _      (set-error-mode! state :continue)
+
+        cfg    (-> cfg
                    (assoc ::pconn pconn)
                    (assoc ::sconn sconn)
                    (assoc ::cmd-ch cmd-ch)
                    (assoc ::rcv-ch rcv-ch)
                    (assoc ::pub-ch pub-ch)
-                   (assoc ::state state)
+                   (assoc ::state state))
-                   (assoc ::wrk/executor executor))]
 
-    (set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/sync? true))
+        io-thr (start-io-loop cfg)]
-    (set-error-mode! state :continue)
 
-    (assoc msgbus ::io-thr (start-io-loop! msgbus))))
+    (reify
+      java.lang.AutoCloseable
+      (close [_]
+        (px/interrupt! io-thr)
+        (sp/close! cmd-ch)
+        (sp/close! rcv-ch)
+        (sp/close! pub-ch)
+        (d/close! pconn)
+        (d/close! sconn))
+
+      IMsgBus
+      (-sub [_ topics chan]
+        (l/debug :hint "subscribe" :topics topics :chan (hash chan))
+        (send-via executor state subscribe-to-topics cfg topics chan))
+
+      (-pub [_ topic message]
+        (let [message (assoc message :topic topic)]
+          (sp/put! pub-ch {:topic topic :message message})))
+
+      (-purge [_ chans]
+        (l/debug :hint "purge" :chans (count chans))
+        (send-via executor state unsubscribe-channels cfg chans)))))
 
 (defmethod ig/halt-key! ::msgbus
-  [_ msgbus]
+  [_ instance]
-  (px/interrupt! (::io-thr msgbus))
+  (d/close! instance))
-  (sp/close! (::cmd-ch msgbus))
-  (sp/close! (::rcv-ch msgbus))
-  (sp/close! (::pub-ch msgbus))
-  (d/close! (::pconn msgbus))
-  (d/close! (::sconn msgbus)))
 
 (defn sub!
-  [{:keys [::state ::wrk/executor] :as cfg} & {:keys [topic topics chan]}]
+  [instance & {:keys [topic topics chan]}]
+  (assert (satisfies? IMsgBus instance) "expected valid msgbus instance")
   (let [topics (into [] (map prefix-topic) (if topic [topic] topics))]
-    (l/debug :hint "subscribe" :topics topics :chan (hash chan))
+    (-sub instance topics chan)
-    (send-via executor state subscribe-to-topics cfg topics chan)
     nil))
 
 (defn pub!
-  [{::keys [pub-ch]} & {:keys [topic] :as params}]
+  [instance & {:keys [topic message]}]
-  (let [params (update params :message assoc :topic topic)]
+  (assert (satisfies? IMsgBus instance) "expected valid msgbus instance")
-    (sp/put! pub-ch params)))
+  (-pub instance topic message))
 
 (defn purge!
-  [{:keys [::state ::wrk/executor] :as msgbus} chans]
+  [instance chans]
-  (l/debug :hint "purge" :chans (count chans))
+  (assert (satisfies? IMsgBus instance) "expected valid msgbus instance")
-  (send-via executor state unsubscribe-channels msgbus chans)
+  (assert (every? sp/chan? chans) "expected a seq of chans")
+  (-purge instance chans)
   nil)
 
 ;; --- IMPL
@@ -119,7 +146,7 @@
   (let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
     (when (= 1 (count nsubs))
       (l/trace :hint "open subscription" :topic topic ::l/sync? true)
-      (redis-sub! cfg topic))
+      (redis-sub cfg topic))
     nsubs))
 
 (defn- disj-subscription
@@ -130,7 +157,7 @@
   (let [nsubs (disj nsubs chan)]
     (when (empty? nsubs)
       (l/trace :hint "close subscription" :topic topic ::l/sync? true)
-      (redis-unsub! cfg topic))
+      (redis-unsub cfg topic))
     nsubs))
 
 (defn- subscribe-to-topics
@@ -171,7 +198,7 @@
                    (when-not (sp/offer! rcv-ch val)
                      (l/warn :msg "dropping message on subscription loop"))))))
 
-(defn- process-input!
+(defn- process-input
   [{:keys [::state ::wrk/executor] :as cfg} topic message]
   (let [chans (get-in @state [:topics topic])]
     (when-let [closed (loop [chans  (seq chans)
@@ -184,9 +211,9 @@
       (send-via executor state unsubscribe-channels cfg closed))))
 
 
-(defn start-io-loop!
+(defn start-io-loop
   [{:keys [::sconn ::rcv-ch ::pub-ch ::state ::wrk/executor] :as cfg}]
-  (rds/add-listener! sconn (create-listener rcv-ch))
+  (rds/add-listener sconn (create-listener rcv-ch))
 
   (px/thread
     {:name "penpot/msgbus/io-loop"
@@ -210,12 +237,12 @@
 
             (identical? port rcv-ch)
             (let [{:keys [topic message]} val]
-              (process-input! cfg topic message)
+              (process-input cfg topic message)
               (recur))
 
             (identical? port pub-ch)
             (do
-              (redis-pub! cfg val)
+              (redis-pub cfg val)
               (recur)))))
 
       (catch InterruptedException _
@@ -231,12 +258,12 @@
 
         (l/debug :hint "io-loop thread terminated")))))
 
-(defn- redis-pub!
+(defn- redis-pub
   "Publish a message to the redis server. Asynchronous operation,
   intended to be used in core.async go blocks."
   [{:keys [::pconn] :as cfg} {:keys [topic message]}]
   (try
-    (p/await! (rds/publish! pconn topic (t/encode message)))
+    (p/await! (rds/publish pconn topic (t/encode message)))
     (catch InterruptedException cause
       (throw cause))
     (catch Throwable cause
@@ -244,23 +271,23 @@
                :message message
                :cause cause))))
 
-(defn- redis-sub!
+(defn- redis-sub
   "Create redis subscription. Blocking operation, intended to be used
   inside an agent."
   [{:keys [::sconn] :as cfg} topic]
   (try
-    (rds/subscribe! sconn topic)
+    (rds/subscribe sconn [topic])
     (catch InterruptedException cause
       (throw cause))
     (catch Throwable cause
       (l/trace :hint "exception on subscribing" :topic topic :cause cause))))
 
-(defn- redis-unsub!
+(defn- redis-unsub
   "Removes redis subscription. Blocking operation, intended to be used
   inside an agent."
   [{:keys [::sconn] :as cfg} topic]
   (try
-    (rds/unsubscribe! sconn topic)
+    (rds/unsubscribe sconn [topic])
     (catch InterruptedException cause
       (throw cause))
     (catch Throwable cause

backend/src/app/redis.clj

@@ -6,11 +6,12 @@
 
 (ns app.redis
   "The msgbus abstraction implemented using redis as underlying backend."
+  (:refer-clojure :exclude [eval])
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.metrics :as mtx]
    [app.redis.script :as-alias rscript]
    [app.util.cache :as cache]
@@ -18,13 +19,11 @@
    [app.worker :as-alias wrk]
    [clojure.core :as c]
    [clojure.java.io :as io]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.core :as p]
    [promesa.exec :as px])
   (:import
-   clojure.lang.IDeref
    clojure.lang.MapEntry
    io.lettuce.core.KeyValue
    io.lettuce.core.RedisClient
@@ -53,79 +52,24 @@
 
 (set! *warn-on-reflection* true)
 
-(declare initialize-resources)
+(declare ^:private initialize-resources)
-(declare shutdown-resources)
+(declare ^:private shutdown-resources)
-(declare connect*)
+(declare ^:private impl-eval)
 
-(s/def ::timer
+(defprotocol IRedis
-  #(instance? Timer %))
+  (-connect [_ options])
+  (-get-or-connect [_ key options]))
 
-(s/def ::default-connection
+(defprotocol IConnection
-  #(or (instance? StatefulRedisConnection %)
+  (publish [_ topic message])
-       (and (instance? IDeref %)
+  (rpush [_ key payload])
-            (instance? StatefulRedisConnection (deref %)))))
+  (blpop [_ timeout keys])
+  (eval [_ script]))
 
-(s/def ::pubsub-connection
+(defprotocol IPubSubConnection
-  #(or (instance? StatefulRedisPubSubConnection %)
+  (add-listener [_ listener])
-       (and (instance? IDeref %)
+  (subscribe [_ topics])
-            (instance? StatefulRedisPubSubConnection (deref %)))))
+  (unsubscribe [_ topics]))
-
-(s/def ::connection
-  (s/or :default ::default-connection
-        :pubsub  ::pubsub-connection))
-
-(s/def ::connection-holder
-  (s/keys :req [::connection]))
-
-(s/def ::redis-uri
-  #(instance? RedisURI %))
-
-(s/def ::resources
-  #(instance? ClientResources %))
-
-(s/def ::pubsub-listener
-  #(instance? RedisPubSubListener %))
-
-(s/def ::uri ::us/not-empty-string)
-(s/def ::timeout ::dt/duration)
-(s/def ::connect? ::us/boolean)
-(s/def ::io-threads ::us/integer)
-(s/def ::worker-threads ::us/integer)
-(s/def ::cache cache/cache?)
-
-(s/def ::redis
-  (s/keys :req [::resources
-                ::redis-uri
-                ::timer
-                ::mtx/metrics]
-          :opt [::connection
-                ::cache]))
-
-(defmethod ig/prep-key ::redis
-  [_ cfg]
-  (let [cpus    (px/get-available-processors)
-        threads (max 1 (int (* cpus 0.2)))]
-    (merge {::timeout (dt/duration "10s")
-            ::io-threads (max 3 threads)
-            ::worker-threads (max 3 threads)}
-           (d/without-nils cfg))))
-
-(defmethod ig/pre-init-spec ::redis [_]
-  (s/keys :req [::uri ::mtx/metrics]
-          :opt [::timeout
-                ::connect?
-                ::io-threads
-                ::worker-threads]))
-
-(defmethod ig/init-key ::redis
-  [_ {:keys [::connect?] :as cfg}]
-  (let [state (initialize-resources cfg)]
-    (cond-> state
-      connect? (assoc ::connection (connect* cfg {})))))
-
-(defmethod ig/halt-key! ::redis
-  [_ state]
-  (shutdown-resources state))
 
 (def default-codec
   (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE))
@@ -133,23 +77,76 @@
 (def string-codec
   (RedisCodec/of StringCodec/UTF8 StringCodec/UTF8))
 
-(defn- create-cache
+(sm/register!
-  [{:keys [::wrk/executor] :as cfg}]
+ {:type ::connection
-  (letfn [(on-remove [key val cause]
+  :pred #(satisfies? IConnection %)
-            (l/trace :hint "evict connection (cache)" :key key :reason cause)
+  :type-properties
-            (some-> val d/close!))]
+  {:title "connection"
-    (cache/create :executor executor
+   :description "redis connection instance"}})
-                  :on-remove on-remove
+
-                  :keepalive "5m")))
+(sm/register!
+ {:type ::pubsub-connection
+  :pred #(satisfies? IPubSubConnection %)
+  :type-properties
+  {:title "connection"
+   :description "redis connection instance"}})
+
+(defn redis?
+  [o]
+  (satisfies? IRedis o))
+
+(sm/register!
+ {:type ::redis
+  :pred redis?})
+
+(def ^:private schema:script
+  [:map {:title "script"}
+   [::rscript/name qualified-keyword?]
+   [::rscript/path ::sm/text]
+   [::rscript/keys {:optional true} [:vector :any]]
+   [::rscript/vals {:optional true} [:vector :any]]])
+
+(def valid-script?
+  (sm/lazy-validator schema:script))
+
+(defmethod ig/expand-key ::redis
+  [k v]
+  (let [cpus    (px/get-available-processors)
+        threads (max 1 (int (* cpus 0.2)))]
+    {k (-> (d/without-nils v)
+           (assoc ::timeout (dt/duration "10s"))
+           (assoc ::io-threads (max 3 threads))
+           (assoc ::worker-threads (max 3 threads)))}))
+
+(def ^:private schema:redis-params
+  [:map {:title "redis-params"}
+   ::wrk/executor
+   ::mtx/metrics
+   [::uri ::sm/uri]
+   [::worker-threads ::sm/int]
+   [::io-threads ::sm/int]
+   [::timeout ::dt/duration]])
+
+(defmethod ig/assert-key ::redis
+  [_ params]
+  (assert (sm/check schema:redis-params params)))
+
+(defmethod ig/init-key ::redis
+  [_ params]
+  (initialize-resources params))
+
+(defmethod ig/halt-key! ::redis
+  [_ instance]
+  (d/close! instance))
 
 (defn- initialize-resources
   "Initialize redis connection resources"
-  [{:keys [::uri ::io-threads ::worker-threads ::connect?] :as cfg}]
+  [{:keys [::uri ::io-threads ::worker-threads ::wrk/executor ::mtx/metrics] :as params}]
-  (l/info :hint "initialize redis resources"
+
-          :uri uri
+  (l/inf :hint "initialize redis resources"
+         :uri (str uri)
          :io-threads io-threads
-          :worker-threads worker-threads
+         :worker-threads worker-threads)
-          :connect? connect?)
 
   (let [timer     (HashedWheelTimer.)
         resources (.. (DefaultClientResources/builder)
@@ -158,112 +155,89 @@
                       (timer ^Timer timer)
                       (build))
 
-        redis-uri (RedisURI/create ^String uri)
+        redis-uri (RedisURI/create ^String (str uri))
-        cfg       (-> cfg
-                      (assoc ::resources resources)
-                      (assoc ::timer timer)
-                      (assoc ::redis-uri redis-uri))]
 
-    (assoc cfg ::cache (create-cache cfg))))
+        shutdown  (fn [client conn]
+                    (ex/ignoring (.close ^StatefulConnection conn))
+                    (ex/ignoring (.close ^RedisClient client))
+                    (l/trc :hint "disconnect" :hid (hash client)))
 
-(defn- shutdown-resources
+        on-remove (fn [key val cause]
-  [{:keys [::resources ::cache ::timer]}]
+                    (l/trace :hint "evict connection (cache)" :key key :reason cause)
-  (cache/invalidate! cache)
+                    (some-> val d/close!))
 
-  (when resources
+        cache     (cache/create :executor executor
-    (.shutdown ^ClientResources resources))
+                                :on-remove on-remove
+                                :keepalive "5m")]
+    (reify
+      java.lang.AutoCloseable
+      (close [_]
+        (ex/ignoring (cache/invalidate! cache))
+        (ex/ignoring (.shutdown ^ClientResources resources))
+        (ex/ignoring (.stop ^Timer timer)))
 
-  (when timer
+      IRedis
-    (.stop ^Timer timer)))
+      (-get-or-connect [this key options]
+        (let [create (fn [_] (-connect this options))]
+          (cache/get cache key create)))
 
-(defn connect*
+      (-connect [_ options]
-  [{:keys [::resources ::redis-uri] :as state}
+        (let [timeout (or (:timeout options) (::timeout params))
-   {:keys [timeout codec type]
+              codec   (get options :codec default-codec)
-    :or {codec default-codec type :default}}]
+              type    (get options :type :default)
-
+              client  (RedisClient/create ^ClientResources resources
-  (us/assert! ::resources resources)
+                                          ^RedisURI redis-uri)]
-  (let [client  (RedisClient/create ^ClientResources resources ^RedisURI redis-uri)
-        timeout (or timeout (::timeout state))
-        conn    (case type
-                  :default (.connect ^RedisClient client ^RedisCodec codec)
-                  :pubsub  (.connectPubSub ^RedisClient client ^RedisCodec codec))]
 
           (l/trc :hint "connect" :hid (hash client))
-    (.setTimeout ^StatefulConnection conn ^Duration timeout)
+          (if (= type :pubsub)
+            (let [conn (.connectPubSub ^RedisClient client
+                                       ^RedisCodec codec)]
+              (.setTimeout ^StatefulConnection conn
+                           ^Duration timeout)
               (reify
-      IDeref
+                IPubSubConnection
-      (deref [_] conn)
+                (add-listener [_ listener]
+                  (assert (instance? RedisPubSubListener listener) "expected listener instance")
+                  (.addListener ^StatefulRedisPubSubConnection conn
+                                ^RedisPubSubListener listener))
 
-      AutoCloseable
+                (subscribe [_ topics]
-      (close [_]
-        (ex/ignoring (.close ^StatefulConnection conn))
-        (ex/ignoring (.shutdown ^RedisClient client))
-        (l/trc :hint "disconnect" :hid (hash client))))))
-
-(defn connect
-  [state & {:as opts}]
-  (let [connection (connect* state opts)]
-    (-> state
-        (assoc ::connection connection)
-        (dissoc ::cache)
-        (vary-meta assoc `d/close! (fn [_] (d/close! connection))))))
-
-(defn get-or-connect
-  [{:keys [::cache] :as state} key options]
-  (us/assert! ::redis state)
-  (let [create     (fn [_] (connect* state options))
-        connection (cache/get cache key create)]
-    (-> state
-        (dissoc ::cache)
-        (assoc ::connection connection))))
-
-(defn add-listener!
-  [{:keys [::connection] :as conn} listener]
-  (us/assert! ::pubsub-connection connection)
-  (us/assert! ::pubsub-listener listener)
-  (.addListener ^StatefulRedisPubSubConnection @connection
-                ^RedisPubSubListener listener)
-  conn)
-
-(defn publish!
-  [{:keys [::connection]} topic message]
-  (us/assert! ::us/string topic)
-  (us/assert! ::us/bytes message)
-  (us/assert! ::default-connection connection)
-
-  (let [pcomm (.async ^StatefulRedisConnection @connection)]
-    (.publish ^RedisAsyncCommands pcomm ^String topic ^bytes message)))
-
-(defn subscribe!
-  "Blocking operation, intended to be used on a thread/agent thread."
-  [{:keys [::connection]} & topics]
-  (us/assert! ::pubsub-connection connection)
                   (try
                     (let [topics (into-array String (map str topics))
-          cmd    (.sync ^StatefulRedisPubSubConnection @connection)]
+                          cmd    (.sync ^StatefulRedisPubSubConnection conn)]
                       (.subscribe ^RedisPubSubCommands cmd topics))
                     (catch RedisCommandInterruptedException cause
                       (throw (InterruptedException. (ex-message cause))))))
 
-(defn unsubscribe!
+                (unsubscribe [_ topics]
-  "Blocking operation, intended to be used on a thread/agent thread."
-  [{:keys [::connection]} & topics]
-  (us/assert! ::pubsub-connection connection)
                   (try
                     (let [topics (into-array String (map str topics))
-          cmd    (.sync ^StatefulRedisPubSubConnection @connection)]
+                          cmd    (.sync ^StatefulRedisPubSubConnection conn)]
                       (.unsubscribe ^RedisPubSubCommands cmd topics))
                     (catch RedisCommandInterruptedException cause
                       (throw (InterruptedException. (ex-message cause))))))
 
-(defn rpush!
+
-  [{:keys [::connection]} key payload]
+                AutoCloseable
-  (us/assert! ::default-connection connection)
+                (close [_] (shutdown client conn))))
-  (us/assert! (or (and (vector? payload)
+
+            (let [conn (.connect ^RedisClient client ^RedisCodec codec)]
+              (.setTimeout ^StatefulConnection conn ^Duration timeout)
+              (reify
+                IConnection
+                (publish [_ topic message]
+                  (assert (string? topic) "expected topic to be string")
+                  (assert (bytes? message) "expected message to be a byte array")
+
+                  (let [pcomm (.async ^StatefulRedisConnection conn)]
+                    (.publish ^RedisAsyncCommands pcomm ^String topic ^bytes message)))
+
+                (rpush [_ key payload]
+                  (assert (or (and (vector? payload)
                                    (every? bytes? payload))
                               (bytes? payload)))
                   (try
-    (let [cmd  (.sync ^StatefulRedisConnection @connection)
+                    (let [cmd  (.sync ^StatefulRedisConnection conn)
                           data (if (vector? payload) payload [payload])
                           vals (make-array (. Class (forName "[B")) (count data))]
 
@@ -279,12 +253,10 @@
                     (catch RedisCommandInterruptedException cause
                       (throw (InterruptedException. (ex-message cause))))))
 
-(defn blpop!
+                (blpop [_ timeout keys]
-  [{:keys [::connection]} timeout & keys]
-  (us/assert! ::default-connection connection)
                   (try
                     (let [keys    (into-array Object (map str keys))
-          cmd     (.sync ^StatefulRedisConnection @connection)
+                          cmd     (.sync ^StatefulRedisConnection conn)
                           timeout (/ (double (inst-ms timeout)) 1000.0)]
                       (when-let [res (.blpop ^RedisCommands cmd
                                              ^double timeout
@@ -295,10 +267,22 @@
                     (catch RedisCommandInterruptedException cause
                       (throw (InterruptedException. (ex-message cause))))))
 
-(defn open?
+                (eval [_ script]
-  [{:keys [::connection]}]
+                  (assert (valid-script? script) "expected valid script")
-  (us/assert! ::pubsub-connection connection)
+                  (impl-eval conn metrics script))
-  (.isOpen ^StatefulConnection @connection))
+
+                AutoCloseable
+                (close [_] (shutdown client conn))))))))))
+
+(defn connect
+  [instance & {:as opts}]
+  (assert (satisfies? IRedis instance) "expected valid redis instance")
+  (-connect instance opts))
+
+(defn get-or-connect
+  [instance key & {:as opts}]
+  (assert (satisfies? IRedis instance) "expected valid redis instance")
+  (-get-or-connect instance key opts))
 
 (defn pubsub-listener
   [& {:keys [on-message on-subscribe on-unsubscribe]}]
@@ -328,26 +312,10 @@
         (on-unsubscribe nil topic count)))))
 
 (def ^:private scripts-cache (atom {}))
-(def noop-fn (constantly nil))
 
-(s/def ::rscript/name qualified-keyword?)
+(defn- impl-eval
-(s/def ::rscript/path ::us/not-empty-string)
+  [^StatefulRedisConnection connection metrics script]
-(s/def ::rscript/keys (s/every any? :kind vector?))
+  (let [cmd   (.async ^StatefulRedisConnection connection)
-(s/def ::rscript/vals (s/every any? :kind vector?))
-
-(s/def ::rscript/script
-  (s/keys :req [::rscript/name
-                ::rscript/path]
-          :opt [::rscript/keys
-                ::rscript/vals]))
-
-(defn eval!
-  [{:keys [::mtx/metrics ::connection] :as state} script]
-  (us/assert! ::redis state)
-  (us/assert! ::default-connection connection)
-  (us/assert! ::rscript/script script)
-
-  (let [cmd   (.async ^StatefulRedisConnection @connection)
         keys  (into-array String (map str (::rscript/keys script)))
         vals  (into-array String (map str (::rscript/vals script)))
         sname (::rscript/name script)]

backend/src/app/rpc.clj

@@ -250,39 +250,49 @@
           'app.rpc.commands.projects
           'app.rpc.commands.search
           'app.rpc.commands.teams
+          'app.rpc.commands.teams-invitations
           'app.rpc.commands.verify-token
           'app.rpc.commands.viewer
           'app.rpc.commands.webhooks)
          (map (partial process-method cfg))
          (into {}))))
 
-(defmethod ig/pre-init-spec ::methods [_]
+(def ^:private schema:methods-params
-  (s/keys :req [::session/manager
+  [:map {:title "methods-params"}
+   ::session/manager
    ::http.client/client
    ::db/pool
    ::mbus/msgbus
-                ::ldap/provider
    ::sto/storage
    ::mtx/metrics
-                ::setup/props]
+   [::ldap/provider [:maybe ::ldap/provider]]
-          :opt [::climit
+   [::climit [:maybe ::climit]]
-                ::rlimit]))
+   [::rlimit [:maybe ::rlimit]]
+   ::setup/props])
+
+(defmethod ig/assert-key ::methods
+  [_ params]
+  (assert (sm/check schema:methods-params params)))
 
 (defmethod ig/init-key ::methods
   [_ cfg]
   (let [cfg (d/without-nils cfg)]
     (resolve-command-methods cfg)))
 
-(s/def ::methods
+(def ^:private schema:methods
-  (s/map-of keyword? (s/tuple map? fn?)))
+  [:map-of :keyword [:tuple :map ::sm/fn]])
 
-(s/def ::routes vector?)
+(sm/register! ::methods schema:methods)
 
-(defmethod ig/pre-init-spec ::routes [_]
+(def ^:private valid-methods?
-  (s/keys :req [::methods
+  (sm/validator schema:methods))
-                ::db/pool
+
-                ::setup/props
+(defmethod ig/assert-key ::routes
-                ::session/manager]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expect valid database pool")
+  (assert (some? (::setup/props params)))
+  (assert (session/manager? (::session/manager params)) "expect valid session manager")
+  (assert (valid-methods? (::methods params)) "expect valid methods map"))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [::methods] :as cfg}]

backend/src/app/rpc/climit.clj

@@ -10,18 +10,15 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
-   [app.config :as cf]
    [app.metrics :as mtx]
    [app.rpc :as-alias rpc]
-   [app.rpc.climit.config :as-alias config]
    [app.util.cache :as cache]
    [app.util.services :as-alias sv]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
    [clojure.edn :as edn]
    [clojure.set :as set]
-   [clojure.spec.alpha :as s]
    [datoteka.fs :as fs]
    [integrant.core :as ig]
    [promesa.exec :as px]
@@ -32,6 +29,62 @@
 
 (set! *warn-on-reflection* true)
 
+(declare ^:private impl-invoke)
+(declare ^:private id->str)
+(declare ^:private create-cache)
+
+(defprotocol IConcurrencyLimiter
+  (^:private get-config [_ limit-id] "get a config for a key")
+  (^:private invoke [_ config handler] "invoke a handler for a config"))
+
+(sm/register!
+ {:type ::rpc/climit
+  :pred #(satisfies? IConcurrencyLimiter %)})
+
+(def ^:private schema:config
+  [:map-of :keyword
+   [:map
+    [::id {:optional true} :keyword]
+    [::key {:optional true} :any]
+    [::label {:optional true} ::sm/text]
+    [::params {:optional true} :map]
+    [::permits {:optional true} ::sm/int]
+    [::queue {:optional true} ::sm/int]
+    [::timeout {:optional true} ::sm/int]]])
+
+(def ^:private check-config
+  (sm/check-fn schema:config))
+
+(def ^:private schema:climit-params
+  [:map
+   ::mtx/metrics
+   ::wrk/executor
+   [::enabled {:optional true} ::sm/boolean]
+   [::config {:optional true} ::fs/path]])
+
+(defmethod ig/assert-key ::rpc/climit
+  [_ params]
+  (assert (sm/valid? schema:climit-params params)))
+
+(defmethod ig/init-key ::rpc/climit
+  [_ {:keys [::config ::enabled ::mtx/metrics] :as cfg}]
+  (when enabled
+    (when-let [params (some->> config slurp edn/read-string check-config)]
+      (l/inf :hint "initializing concurrency limit" :config (str config))
+      (let [params (reduce-kv (fn [result k v]
+                                (assoc result k (assoc v ::id k)))
+                              params
+                              params)
+            cache  (create-cache cfg)]
+
+        (reify
+          IConcurrencyLimiter
+          (get-config [_ id]
+            (get params id))
+
+          (invoke [_ config handler]
+            (impl-invoke metrics cache config handler)))))))
+
 (defn- id->str
   ([id]
    (-> (str id)
@@ -41,59 +94,23 @@
      (str (-> (str id) (subs 1)) "/" key)
      (id->str id))))
 
-(defn- create-cache
-  [{:keys [::wrk/executor]}]
-  (letfn [(on-remove [key _ cause]
-            (let [[id skey] key]
-              (l/trc :hint "disposed" :id (id->str id skey) :reason (str cause))))]
-    (cache/create :executor executor
-                  :on-remove on-remove
-                  :keepalive "5m")))
-
-(s/def ::config/permits ::us/integer)
-(s/def ::config/queue ::us/integer)
-(s/def ::config/timeout ::us/integer)
-(s/def ::config
-  (s/map-of keyword?
-            (s/keys :opt-un [::config/permits
-                             ::config/queue
-                             ::config/timeout])))
-
-(defmethod ig/prep-key ::rpc/climit
-  [_ cfg]
-  (assoc cfg ::path (cf/get :rpc-climit-config)))
-
-(s/def ::path ::fs/path)
-(defmethod ig/pre-init-spec ::rpc/climit [_]
-  (s/keys :req [::mtx/metrics ::wrk/executor ::path]))
-
-(defmethod ig/init-key ::rpc/climit
-  [_ {:keys [::path ::mtx/metrics] :as cfg}]
-  (when (contains? cf/flags :rpc-climit)
-    (when-let [params (some->> path slurp edn/read-string)]
-      (l/inf :hint "initializing concurrency limit" :config (str path))
-      (us/verify! ::config params)
-      {::cache (create-cache cfg)
-       ::config params
-       ::mtx/metrics metrics})))
-
-(s/def ::cache cache/cache?)
-(s/def ::instance
-  (s/keys :req [::cache ::config]))
-
-(s/def ::rpc/climit
-  (s/nilable ::instance))
-
 (defn- create-limiter
-  [config [id skey]]
+  [config id]
-  (l/trc :hint "created" :id (id->str id skey))
+  (l/trc :hint "created" :id id)
   (pbh/create :permits (or (:permits config) (:concurrency config))
               :queue (or (:queue config) (:queue-size config))
               :timeout (:timeout config)
               :type :semaphore))
 
+(defn- create-cache
+  [{:keys [::wrk/executor]}]
+  (letfn [(on-remove [id _ cause]
+            (l/trc :hint "disposed" :id id :reason (str cause)))]
+    (cache/create :executor executor
+                  :on-remove on-remove
+                  :keepalive "5m")))
 
-(defn measure!
+(defn- measure
   [metrics mlabels stats elapsed]
   (let [mpermits (:max-permits stats)
         permits  (:permits stats)
@@ -117,8 +134,14 @@
                 :val (inst-ms elapsed)
                 :labels mlabels))))
 
-(defn log!
+(defn- prepare-params-for-debug
-  [action req-id stats limit-id limit-label params elapsed]
+  [params]
+  (-> (select-keys params [::rpc/profile-id :file-id :profile-id])
+      (set/rename-keys {::rpc/profile-id :profile-id})
+      (update-vals str)))
+
+(defn- log
+  [action req-id stats limit-id limit-label limit-params elapsed]
   (let [mpermits (:max-permits stats)
         queue    (:queue stats)
         queue    (- queue mpermits)
@@ -132,37 +155,42 @@
            :label limit-label
            :queue queue
            :elapsed (some-> elapsed dt/format-duration)
-           :params (-> (select-keys params [::rpc/profile-id :file-id :profile-id])
+           :params @limit-params)))
-                       (set/rename-keys {::rpc/profile-id :profile-id})
-                       (update-vals str)))))
 
 (def ^:private idseq (AtomicLong. 0))
 
-(defn- invoke
+(defn- impl-invoke
-  [limiter metrics limit-id limit-key limit-label handler params]
+  [metrics cache config handler]
-  (let [tpoint    (dt/tpoint)
+  (let [limit-id     (::id config)
+        limit-key    (::key config)
+        limit-label  (::label config)
+        limit-params (delay
+                       (prepare-params-for-debug
+                        (::params config)))
+
         mlabels     (into-array String [(id->str limit-id)])
         limit-id    (id->str limit-id limit-key)
-        stats     (pbh/get-stats limiter)
+        limiter     (cache/get cache limit-id (partial create-limiter config))
+        tpoint      (dt/tpoint)
         req-id      (.incrementAndGet ^AtomicLong idseq)]
-
     (try
-      (measure! metrics mlabels stats nil)
+      (let [stats (pbh/get-stats limiter)]
-      (log! "enqueued" req-id stats limit-id limit-label params nil)
+        (measure metrics mlabels stats nil)
+        (log "enqueued" req-id stats limit-id limit-label limit-params nil))
+
       (px/invoke! limiter (fn []
                             (let [elapsed (tpoint)
                                   stats   (pbh/get-stats limiter)]
-
+                              (measure metrics mlabels stats elapsed)
-                              (measure! metrics mlabels stats elapsed)
+                              (log "acquired" req-id stats limit-id limit-label limit-params elapsed)
-                              (log! "acquired" req-id stats limit-id limit-label params elapsed)
+                              (handler))))
-
-                              (handler params))))
 
       (catch ExceptionInfo cause
         (let [{:keys [type code]} (ex-data cause)]
           (if (= :bulkhead-error type)
-            (let [elapsed (tpoint)]
+            (let [elapsed (tpoint)
-              (log! "rejected" req-id stats limit-id limit-label params elapsed)
+                  stats   (pbh/get-stats limiter)]
+              (log "rejected" req-id stats limit-id limit-label limit-params elapsed)
               (ex/raise :type :concurrency-limit
                         :code code
                         :hint "concurrency limit reached"
@@ -173,8 +201,8 @@
         (let [elapsed (tpoint)
               stats (pbh/get-stats limiter)]
 
-          (measure! metrics mlabels stats nil)
+          (measure metrics mlabels stats nil)
-          (log! "finished" req-id stats limit-id limit-label params elapsed))))))
+          (log "finished" req-id stats limit-id limit-label limit-params elapsed))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MIDDLEWARE
@@ -204,14 +232,10 @@
       (throw (IllegalArgumentException. "unable to normalize limit")))))
 
 (defn wrap
-  [{:keys [::rpc/climit ::mtx/metrics]} handler mdata]
+  [cfg handler {label ::sv/name :as mdata}]
-  (let [cache  (::cache climit)
+  (if-let [climit (::rpc/climit cfg)]
-        config (::config climit)
-        label  (::sv/name mdata)]
-
-    (if climit
     (reduce (fn [handler [limit-id key-fn]]
-                (if-let [config (get config limit-id)]
+              (if-let [config (get-config climit limit-id)]
                 (let [key-fn (or key-fn noop-fn)]
                   (l/trc :hint "instrumenting method"
                          :method label
@@ -219,7 +243,7 @@
                          :timeout (:timeout config)
                          :permits (:permits config)
                          :queue (:queue config)
-                           :keyed (not= key-fn noop-fn))
+                         :keyed (not= key-fn nil))
 
                   (if (and (= key-fn ::rpc/profile-id)
                            (false? (::rpc/auth mdata true)))
@@ -229,46 +253,49 @@
                     handler
 
                     (fn [cfg params]
-                        (let [limit-key  (key-fn params)
+                      (let [config (-> config
-                              cache-key  [limit-id limit-key]
+                                       (assoc ::key (key-fn params))
-                              limiter    (cache/get cache cache-key (partial create-limiter config))
+                                       (assoc ::label label)
-                              handler    (partial handler cfg)]
+                                       ;; NOTE: only used for debugging output
-                          (invoke limiter metrics limit-id limit-key label handler params)))))
+                                       (assoc ::params params))]
+                        (invoke climit config (partial handler cfg params))))))
 
                 (do
                   (l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
                   handler)))
-
             handler
             (concat global-limits (get-limits mdata)))
-      handler)))
+
+    handler))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; PUBLIC API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn- build-exec-chain
-  [{:keys [::label ::rpc/climit ::mtx/metrics] :as cfg} f]
+  [{:keys [::label ::rpc/climit] :as cfg} f]
-  (let [config (get climit ::config)
+  (reduce (fn [handler [limit-id limit-key]]
-        cache  (get climit ::cache)]
+            (if-let [config (get-config climit limit-id)]
-    (reduce (fn [handler [limit-id limit-key :as ckey]]
+              (let [config (-> config
-              (if-let [config (get config limit-id)]
+                               (assoc ::key limit-key)
+                               (assoc ::label label))]
                 (fn [cfg params]
-                  (let [limiter (cache/get cache ckey (partial create-limiter config))
+                  (let [config (assoc config ::params params)]
-                        handler (partial handler cfg)]
+                    (invoke climit config (partial handler cfg params)))))
-                    (invoke limiter metrics limit-id limit-key label handler params)))
               (do
                 (l/wrn :hint "config not found" :label label :id limit-id)
                 f)))
           f
-            (get-limits cfg))))
+          (get-limits cfg)))
 
 (defn invoke!
   "Run a function in context of climit.
   Intended to be used in virtual threads."
-  [{:keys [::executor] :as cfg} f params]
+  [{:keys [::executor ::rpc/climit] :as cfg} f params]
+  (let [f (if climit
             (let [f (if (some? executor)
                       (fn [cfg params] (px/await! (px/submit! executor (fn [] (f cfg params)))))
-            f)
+                      f)]
-        f (build-exec-chain cfg f)]
+              (build-exec-chain cfg f))
+            f)]
     (f cfg params)))

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

@@ -383,7 +383,9 @@
         invitation (when-let [token (:invitation-token params)]
                      (tokens/verify (::setup/props cfg) {:token token :iss :team-invitation}))
 
-        props      (audit/profile->props profile)
+        props      (-> (audit/profile->props profile)
+                       (assoc :from-invitation (some? invitation)))
+
 
         create-welcome-file-when-needed
         (fn []

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

@@ -36,7 +36,8 @@
    [app.util.services :as sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [cuerdas.core :as str]))
+   [cuerdas.core :as str]
+   [promesa.exec :as px]))
 
 ;; --- FEATURES
 
@@ -245,16 +246,16 @@
       file)))
 
 (defn get-file
-  [{:keys [::db/conn] :as cfg} id & {:keys [project-id
+  [{:keys [::db/conn ::wrk/executor] :as cfg} id
+   & {:keys [project-id
              migrate?
              include-deleted?
              lock-for-update?]
       :or {include-deleted? false
            lock-for-update? false
            migrate? true}}]
-  (dm/assert!
+
-   "expected cfg with valid connection"
+  (assert (db/connection? conn) "expected cfg with valid connection")
-   (db/connection-map? cfg))
 
   (let [params (merge {:id id}
                       (when (some? project-id)
@@ -263,8 +264,14 @@
                             {::db/check-deleted (not include-deleted?)
                              ::db/remove-deleted (not include-deleted?)
                              ::sql/for-update lock-for-update?})
-                    (feat.fdata/resolve-file-data cfg)
+                    (feat.fdata/resolve-file-data cfg))
-                    (decode-row))]
+
+        ;; NOTE: we perform the file decoding in a separate thread
+        ;; because it has heavy and synchronous operations for
+        ;; decoding file body that are not very friendly with virtual
+        ;; threads.
+        file   (px/invoke! executor #(decode-row file))]
+
     (if (and migrate? (fmg/need-migration? file))
       (migrate-file cfg file)
       file)))

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

@@ -118,11 +118,12 @@
         ;; feature on frontend and make it permanent on file
         features (-> (:features params #{})
                      (set/intersection cfeat/no-migration-features)
+                     (set/difference cfeat/frontend-only-features)
                      (set/union features))
 
         params   (-> params
                      (assoc :profile-id profile-id)
-                     (assoc :features features))]
+                     (assoc :features (set/difference features cfeat/frontend-only-features)))]
 
     (quotes/check! cfg {::quotes/id ::quotes/files-per-project
                         ::quotes/team-id team-id

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

@@ -147,7 +147,7 @@
 
                           params   (-> params
                                        (assoc :profile-id profile-id)
-                                       (assoc :features features)
+                                       (assoc :features (set/difference features cfeat/frontend-only-features))
                                        (assoc :team team)
                                        (assoc :file file)
                                        (assoc :changes changes))

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

@@ -10,7 +10,6 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.features :as cfeat]
-   [app.common.logging :as l]
    [app.common.schema :as sm]
    [app.common.types.team :as tt]
    [app.common.uuid :as uuid]
@@ -25,17 +24,14 @@
    [app.rpc :as-alias rpc]
    [app.rpc.commands.profile :as profile]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
    [app.rpc.permissions :as perms]
    [app.rpc.quotes :as quotes]
    [app.setup :as-alias setup]
    [app.storage :as sto]
-   [app.tokens :as tokens]
-   [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [cuerdas.core :as str]))
+   [clojure.set :as set]))
 
 ;; --- Helpers & Specs
 
@@ -84,7 +80,9 @@
   (cond-> row
     (some? features) (assoc :features (db/decode-pgarray features #{}))))
 
-(defn- check-profile-muted
+;; FIXME: move
+
+(defn check-profile-muted
   "Check if the member's email is part of the global bounce report"
   [conn member]
   (let [email (profile/clean-email (:email member))]
@@ -94,7 +92,7 @@
                 :email email
                 :hint "the profile has reported repeatedly as spam or has bounces"))))
 
-(defn- check-email-bounce
+(defn check-email-bounce
   "Check if the email is part of the global complain report"
   [conn email show?]
   (when (eml/has-bounce-reports? conn email)
@@ -103,7 +101,7 @@
               :email (if show? email "private")
               :hint "this email has been repeatedly reported as bounce")))
 
-(defn- check-email-spam
+(defn check-email-spam
   "Check if the member email is part of the global complain report"
   [conn email show?]
   (when (eml/has-complaint-reports? conn email)
@@ -267,6 +265,8 @@
    [:fn #(or (contains? % :team-id)
              (contains? % :file-id))]])
 
+;; FIXME: split in two separated requests
+
 (sv/defmethod ::get-team-users
   "Get team users by team-id or by file-id"
   {::doc/added "1.17"
@@ -304,20 +304,29 @@
     inner join project as p on (f.project_id = p.id)
     where p.team_id = ?")
 
-(def sql:team-by-file
-  "select p.team_id as id
-     from project as p
-     join file as f on (p.id = f.project_id)
-    where f.id = ?")
-
 (defn get-users
   [conn team-id]
   (db/exec! conn [sql:team-users team-id team-id team-id]))
 
+(def sql:get-team-by-file
+  "SELECT t.*
+     FROM team AS t
+     JOIN project AS p ON (p.team_id = t.id)
+     JOIN file AS f ON (f.project_id = p.id)
+    WHERE f.id = ?")
+
 (defn get-team-for-file
   [conn file-id]
-  (->> [sql:team-by-file file-id]
+  (let [team (->> (db/exec! conn [sql:get-team-by-file file-id])
-       (db/exec-one! conn)))
+                  (remove db/is-row-deleted?)
+                  (map decode-row)
+                  (first))]
+    (when-not team
+      (ex/raise :type :not-found
+                :code :object-not-found
+                :hint "database object not found"))
+
+    team))
 
 ;; --- Query: Team Stats
 
@@ -408,6 +417,7 @@
                       ::quotes/profile-id profile-id})
 
   (let [features (-> (cfeat/get-enabled-features cf/flags)
+                     (set/difference cfeat/frontend-only-features)
                      (cfeat/check-client-features! (:features params)))
         params   (-> params
                      (assoc :profile-id profile-id)
@@ -505,8 +515,6 @@
 
 ;; --- Mutation: Leave Team
 
-(declare role->params)
-
 (defn leave-team
   [conn {:keys [profile-id id reassign-to]}]
   (let [perms   (get-permissions conn profile-id id)
@@ -536,7 +544,7 @@
 
         ;; assign owner role to new profile
         (db/update! conn :team-profile-rel
-                    (role->params :owner)
+                    (get tt/permissions-for-role :owner)
                     {:team-id id :profile-id reassign-to}))
 
       ;; and finally, if all other conditions does not match and the
@@ -607,16 +615,6 @@
       nil)))
 
 ;; --- Mutation: Team Update Role
-(def schema:role
-  [::sm/one-of tt/valid-roles])
-
-(defn role->params
-  [role]
-  (case role
-    :admin  {:is-owner false :is-admin true :can-edit true}
-    :editor {:is-owner false :is-admin false :can-edit true}
-    :owner  {:is-owner true  :is-admin true :can-edit true}
-    :viewer {:is-owner false :is-admin false :can-edit false}))
 
 (defn update-team-member-role
   [{:keys [::db/conn ::mbus/msgbus]} {:keys [profile-id team-id member-id role] :as params}]
@@ -657,7 +655,7 @@
                          :team-id team-id
                          :role role})
 
-    (let [params (role->params role)]
+    (let [params (get tt/permissions-for-role role)]
       ;; Only allow single owner on team
       (when (= role :owner)
         (db/update! conn :team-profile-rel
@@ -675,7 +673,7 @@
   [:map {:title "update-team-member-role"}
    [:team-id ::sm/uuid]
    [:member-id ::sm/uuid]
-   [:role schema:role]])
+   [:role ::tt/role]])
 
 (sv/defmethod ::update-team-member-role
   {::doc/added "1.17"
@@ -755,535 +753,3 @@
                   {:id team-id})
 
       (assoc team :photo-id (:id photo)))))
-
-;; --- Mutation: Create Team Invitation
-
-(def sql:upsert-team-invitation
-  "insert into team_invitation(id, team_id, email_to, role, valid_until)
-   values (?, ?, ?, ?, ?)
-       on conflict(team_id, email_to) do
-          update set role = ?, valid_until = ?, updated_at = now()
-   returning *")
-
-(defn- create-invitation-token
-  [cfg {:keys [profile-id valid-until team-id member-id member-email role]}]
-  (tokens/generate (::setup/props cfg)
-                   {:iss :team-invitation
-                    :exp valid-until
-                    :profile-id profile-id
-                    :role role
-                    :team-id team-id
-                    :member-email member-email
-                    :member-id member-id}))
-
-(defn- create-profile-identity-token
-  [cfg profile-id]
-
-  (dm/assert!
-   "expected valid uuid for profile-id"
-   (uuid? profile-id))
-
-  (tokens/generate (::setup/props cfg)
-                   {:iss :profile-identity
-                    :profile-id profile-id
-                    :exp (dt/in-future {:days 30})}))
-
-(def ^:private schema:create-invitation
-  [:map {:title "params:create-invitation"}
-   [::rpc/profile-id ::sm/uuid]
-   [:team
-    [:map
-     [:id ::sm/uuid]
-     [:name :string]]]
-   [:profile
-    [:map
-     [:id ::sm/uuid]
-     [:fullname :string]]]
-   [:role [::sm/one-of tt/valid-roles]]
-   [:email ::sm/email]])
-
-(def ^:private check-create-invitation-params!
-  (sm/check-fn schema:create-invitation))
-
-(defn- create-invitation
-  [{:keys [::db/conn] :as cfg} {:keys [team profile role email] :as params}]
-
-  (dm/assert!
-   "expected valid connection on cfg parameter"
-   (db/connection? conn))
-
-  (dm/assert!
-   "expected valid params for `create-invitation` fn"
-   (check-create-invitation-params! params))
-
-  (let [email  (profile/clean-email email)
-        member (profile/get-profile-by-email conn email)]
-
-    (check-profile-muted conn member)
-    (check-email-bounce conn email true)
-    (check-email-spam conn email true)
-
-    ;; When we have email verification disabled and invitation user is
-    ;; already present in the database, we proceed to add it to the
-    ;; team as-is, without email roundtrip.
-
-    ;; TODO: if member does not exists and email verification is
-    ;; disabled, we should proceed to create the profile (?)
-    (if (and (not (contains? cf/flags :email-verification))
-             (some? member))
-      (let [params (merge {:team-id (:id team)
-                           :profile-id (:id member)}
-                          (role->params role))]
-
-        ;; Insert the invited member to the team
-        (db/insert! conn :team-profile-rel params
-                    {::db/on-conflict-do-nothing? true})
-
-        ;; If profile is not yet verified, mark it as verified because
-        ;; accepting an invitation link serves as verification.
-        (when-not (:is-active member)
-          (db/update! conn :profile
-                      {:is-active true}
-                      {:id (:id member)}))
-
-        nil)
-
-      (let [id         (uuid/next)
-            expire     (dt/in-future "168h") ;; 7 days
-            invitation (db/exec-one! conn [sql:upsert-team-invitation id
-                                           (:id team) (str/lower email)
-                                           (name role) expire
-                                           (name role) expire])
-            updated?   (not= id (:id invitation))
-            profile-id (:id profile)
-            tprops     {:profile-id profile-id
-                        :invitation-id (:id invitation)
-                        :valid-until expire
-                        :team-id (:id team)
-                        :member-email (:email-to invitation)
-                        :member-id (:id member)
-                        :role role}
-            itoken     (create-invitation-token cfg tprops)
-            ptoken     (create-profile-identity-token cfg profile-id)]
-
-        (when (contains? cf/flags :log-invitation-tokens)
-          (l/info :hint "invitation token" :token itoken))
-
-        (let [props  (-> (dissoc tprops :profile-id)
-                         (audit/clean-props))
-              evname (if updated?
-                       "update-team-invitation"
-                       "create-team-invitation")
-              event (-> (audit/event-from-rpc-params params)
-                        (assoc ::audit/name evname)
-                        (assoc ::audit/props props))]
-          (audit/submit! cfg event))
-
-        (eml/send! {::eml/conn conn
-                    ::eml/factory eml/invite-to-team
-                    :public-uri (cf/get :public-uri)
-                    :to email
-                    :invited-by (:fullname profile)
-                    :team (:name team)
-                    :token itoken
-                    :extra-data ptoken})
-
-        itoken))))
-
-(defn- add-user-to-team
-  [conn profile team role email]
-
-  (let [team-id (:id team)
-        member  (db/get* conn :profile
-                         {:email (str/lower email)}
-                         {::sql/columns [:id :email]})
-        params  (merge
-                 {:team-id team-id
-                  :profile-id (:id member)}
-                 (role->params role))]
-
-      ;; Do not allow blocked users to join teams.
-    (when (:is-blocked member)
-      (ex/raise :type :restriction
-                :code :profile-blocked))
-
-    (quotes/check!
-     {::db/conn conn
-      ::quotes/id ::quotes/profiles-per-team
-      ::quotes/profile-id (:id member)
-      ::quotes/team-id team-id})
-
-    ;; Insert the member to the team
-    (db/insert! conn :team-profile-rel params {::db/on-conflict-do-nothing? true})
-
-    ;; Delete any request
-    (db/delete! conn :team-access-request
-                {:team-id team-id :requester-id (:id member)})
-
-    ;; Delete any invitation
-    (db/delete! conn :team-invitation
-                {:team-id team-id :email-to (:email member)})
-
-    (eml/send! {::eml/conn conn
-                ::eml/factory eml/join-team
-                :public-uri (cf/get :public-uri)
-                :to email
-                :invited-by (:fullname profile)
-                :team (:name team)
-                :team-id (:id team)})))
-
-(def sql:valid-requests-email
-  "SELECT p.email
-     FROM team_access_request AS tr
-     JOIN profile AS p ON (tr.requester_id = p.id)
-    WHERE tr.team_id = ?
-      AND tr.auto_join_until > now()")
-
-(defn- get-valid-requests-email
-  [conn team-id]
-  (db/exec! conn [sql:valid-requests-email team-id]))
-
-(def ^:private xf:map-email
-  (map :email))
-
-(defn- create-team-invitations
-  [{:keys [::db/conn] :as cfg} {:keys [profile team role emails] :as params}]
-  (let [join-requests    (into #{} xf:map-email
-                               (get-valid-requests-email conn (:id team)))
-        team-members     (into #{} xf:map-email
-                               (get-team-members conn (:id team)))
-
-        invitations      (into #{}
-                               (comp
-                                ;;  We don't re-send inviation to
-                                ;;  already existing members
-                                (remove team-members)
-                                ;; We don't send invitations to
-                                ;; join-requested members
-                                (remove join-requests)
-                                (map (fn [email] (assoc params :email email)))
-                                (keep (partial create-invitation cfg)))
-                               emails)]
-
-    ;; For requested invitations, do not send invitation emails, add
-    ;; the user directly to the team
-    (->> (filter join-requests emails)
-         (run! (partial add-user-to-team conn profile team role)))
-
-    invitations))
-
-(def ^:private schema:create-team-invitations
-  [:map {:title "create-team-invitations"}
-   [:team-id ::sm/uuid]
-   [:role schema:role]
-   [:emails [::sm/set ::sm/email]]])
-
-(def ^:private max-invitations-by-request-threshold
-  "The number of invitations can be sent in a single rpc request"
-  25)
-
-(sv/defmethod ::create-team-invitations
-  "A rpc call that allow to send a single or multiple invitations to
-  join the team."
-  {::doc/added "1.17"
-   ::sm/params schema:create-team-invitations}
-  [cfg {:keys [::rpc/profile-id team-id emails] :as params}]
-  (let [perms    (get-permissions cfg profile-id team-id)
-        profile  (db/get-by-id cfg :profile profile-id)
-        emails   (into #{} (map profile/clean-email) emails)]
-
-    (when-not (:is-admin perms)
-      (ex/raise :type :validation
-                :code :insufficient-permissions))
-
-    (when (> (count emails) max-invitations-by-request-threshold)
-      (ex/raise :type :validation
-                :code :max-invitations-by-request
-                :hint "the maximum of invitation on single request is reached"
-                :threshold max-invitations-by-request-threshold))
-
-    (-> cfg
-        (assoc ::quotes/profile-id profile-id)
-        (assoc ::quotes/team-id team-id)
-        (assoc ::quotes/incr (count emails))
-        (quotes/check! {::quotes/id ::quotes/invitations-per-team}
-                       {::quotes/id ::quotes/profiles-per-team}))
-
-    ;; Check if the current profile is allowed to send emails
-    (check-profile-muted cfg profile)
-
-    (let [team        (db/get-by-id cfg :team team-id)
-          ;; NOTE: Is important pass RPC method params down to the
-          ;; `create-team-invitations` because it uses the implicit
-          ;; RPC properties from params for fill necessary data on
-          ;; emiting an entry to the audit-log
-          invitations (db/tx-run! cfg create-team-invitations
-                                  (-> params
-                                      (assoc :profile profile)
-                                      (assoc :team team)
-                                      (assoc :emails emails)))]
-
-      (with-meta {:total (count invitations)
-                  :invitations invitations}
-        {::audit/props {:invitations (count invitations)}}))))
-
-;; --- Mutation: Create Team & Invite Members
-
-(def ^:private schema:create-team-with-invitations
-  [:map {:title "create-team-with-invitations"}
-   [:name [:string {:max 250}]]
-   [:features {:optional true} ::cfeat/features]
-   [:id {:optional true} ::sm/uuid]
-   [:emails [::sm/set ::sm/email]]
-   [:role schema:role]])
-
-(sv/defmethod ::create-team-with-invitations
-  {::doc/added "1.17"
-   ::sm/params schema:create-team-with-invitations
-   ::db/transaction true}
-  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id emails role name] :as params}]
-  (let [features (-> (cfeat/get-enabled-features cf/flags)
-                     (cfeat/check-client-features! (:features params)))
-
-        params   (-> params
-                     (assoc :profile-id profile-id)
-                     (assoc :features features))
-
-        team     (create-team cfg params)
-        emails   (into #{} (map profile/clean-email) emails)]
-
-    (-> cfg
-        (assoc ::quotes/profile-id profile-id)
-        (assoc ::quotes/team-id (:id team))
-        (assoc ::quotes/incr (count emails))
-        (quotes/check! {::quotes/id ::quotes/teams-per-profile}
-                       {::quotes/id ::quotes/invitations-per-team}
-                       {::quotes/id ::quotes/profiles-per-team}))
-
-    (when (> (count emails) max-invitations-by-request-threshold)
-      (ex/raise :type :validation
-                :code :max-invitations-by-request
-                :hint "the maximum of invitation on single request is reached"
-                :threshold max-invitations-by-request-threshold))
-
-    (let [props {:name name :features features}
-          event (-> (audit/event-from-rpc-params params)
-                    (assoc ::audit/name "create-team")
-                    (assoc ::audit/props props))]
-      (audit/submit! cfg event))
-
-    ;; Create invitations for all provided emails.
-    (let [profile     (db/get-by-id conn :profile profile-id)
-          params      (-> params
-                          (assoc :team team)
-                          (assoc :profile profile)
-                          (assoc :role role))
-          invitations (->> emails
-                           (map (fn [email] (assoc params :email email)))
-                           (map (partial create-invitation cfg)))]
-
-      (vary-meta team assoc ::audit/props {:invitations (count invitations)}))))
-
-;; --- Query: get-team-invitation-token
-
-(def ^:private schema:get-team-invitation-token
-  [:map {:title "get-team-invitation-token"}
-   [:team-id ::sm/uuid]
-   [:email ::sm/email]])
-
-(sv/defmethod ::get-team-invitation-token
-  {::doc/added "1.17"
-   ::sm/params schema:get-team-invitation-token}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
-  (check-read-permissions! pool profile-id team-id)
-  (let [email (profile/clean-email email)
-        invit (-> (db/get pool :team-invitation
-                          {:team-id team-id
-                           :email-to email})
-                  (update :role keyword))
-
-        member (profile/get-profile-by-email pool (:email-to invit))
-        token  (create-invitation-token cfg {:team-id (:team-id invit)
-                                             :profile-id profile-id
-                                             :valid-until (:valid-until invit)
-                                             :role (:role invit)
-                                             :member-id (:id member)
-                                             :member-email (or (:email member)
-                                                               (profile/clean-email (:email-to invit)))})]
-    {:token token}))
-
-;; --- Mutation: Update invitation role
-
-(def ^:private schema:update-team-invitation-role
-  [:map {:title "update-team-invitation-role"}
-   [:team-id ::sm/uuid]
-   [:email ::sm/email]
-   [:role schema:role]])
-
-(sv/defmethod ::update-team-invitation-role
-  {::doc/added "1.17"
-   ::sm/params schema:update-team-invitation-role}
-  [{: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)]
-
-      (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 (profile/clean-email email)})
-
-      nil)))
-
-;; --- Mutation: Delete invitation
-
-(def ^:private schema:delete-team-invition
-  [:map {:title "delete-team-invitation"}
-   [:team-id ::sm/uuid]
-   [:email ::sm/email]])
-
-(sv/defmethod ::delete-team-invitation
-  {::doc/added "1.17"
-   ::sm/params schema:delete-team-invition}
-  [{: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)]
-
-      (when-not (:is-admin perms)
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
-
-      (let [invitation (db/delete! conn :team-invitation
-                                   {:team-id team-id
-                                    :email-to (profile/clean-email email)}
-                                   {::db/return-keys true})]
-        (rph/wrap nil {::audit/props {:invitation-id (:id invitation)}})))))
-
-
-
-
-;; --- Mutation: Request Team Invitation
-
-(def sql:upsert-team-access-request
-  "INSERT INTO team_access_request (id, team_id, requester_id, valid_until, auto_join_until)
-   VALUES (?, ?, ?, ?, ?)
-       ON conflict(id)
-       DO UPDATE SET valid_until = ?, auto_join_until = ?, updated_at = now()
-   RETURNING *")
-
-
-(def sql:team-access-request
-  "SELECT id, (valid_until < now()) AS expired
-     FROM team_access_request
-    WHERE team_id = ?
-      AND requester_id = ?")
-
-(def sql:team-owner
-  "SELECT profile_id
-     FROM team_profile_rel
-    WHERE team_id = ?
-      AND is_owner = true")
-
-
-(defn- create-team-access-request
-  [{:keys [::db/conn] :as cfg} {:keys [team requester team-owner file is-viewer] :as params}]
-  (let [old-request (->> (db/exec-one! conn [sql:team-access-request (:id team) (:id requester)])
-                         (decode-row))]
-    (when (false? (:expired old-request))
-      (ex/raise :type :validation
-                :code :request-already-sent
-                :hint "you have already made a request to join this team less than 24 hours ago"))
-
-    (let [id              (or (:id old-request) (uuid/next))
-          valid_until     (dt/in-future "24h")
-          auto_join_until (dt/in-future "168h") ;; 7 days
-          request         (db/exec-one! conn [sql:upsert-team-access-request
-                                              id (:id team) (:id requester) valid_until auto_join_until
-                                              valid_until auto_join_until])
-          factory         (cond
-                            (and (some? file) (:is-default team) is-viewer)
-                            eml/request-file-access-yourpenpot-view
-                            (and (some? file) (:is-default team))
-                            eml/request-file-access-yourpenpot
-                            (some? file)
-                            eml/request-file-access
-                            :else
-                            eml/request-team-access)
-          page-id         (when (some? file)
-                            (-> file :data :pages first))]
-
-      ;; TODO needs audit?
-
-      (eml/send! {::eml/conn conn
-                  ::eml/factory factory
-                  :public-uri (cf/get :public-uri)
-                  :to (:email team-owner)
-                  :requested-by (:fullname requester)
-                  :requested-by-email (:email requester)
-                  :team-name (:name team)
-                  :team-id (:id team)
-                  :file-name (:name file)
-                  :file-id (:id file)
-                  :page-id page-id})
-
-      request)))
-
-
-(def ^:private schema:create-team-access-request
-  [:and
-   [:map {:title "create-team-access-request"}
-    [:file-id {:optional true} ::sm/uuid]
-    [:team-id {:optional true} ::sm/uuid]
-    [:is-viewer {:optional true} ::sm/boolean]]
-
-   [:fn (fn [params]
-          (or (contains? params :file-id)
-              (contains? params :team-id)))]])
-
-
-(sv/defmethod ::create-team-access-request
-  "A rpc call that allow to request for an invitations to join the team."
-  {::doc/added "2.2.0"
-   ::sm/params schema:create-team-access-request}
-  [cfg {:keys [::rpc/profile-id file-id team-id is-viewer] :as params}]
-
-  (db/tx-run! cfg
-              (fn [{:keys [::db/conn] :as cfg}]
-
-                (let [requester     (db/get-by-id conn :profile profile-id)
-                      team-id       (if (some? team-id)
-                                      team-id
-                                      (:id (get-team-for-file conn file-id)))
-                      team          (db/get-by-id conn :team team-id)
-                      owner-id      (->> (db/exec! conn [sql:team-owner (:id team)])
-                                         (map decode-row)
-                                         (first)
-                                         :profile-id)
-                      team-owner    (db/get-by-id conn :profile owner-id)
-                      file          (when (some? file-id)
-                                      (db/get* conn :file
-                                               {:id file-id}
-                                               {::sql/columns [:id :name :data]}))
-                      file          (when (some? file)
-                                      (assoc file :data (blob/decode (:data file))))]
-
-                  ;;TODO needs quotes?
-
-                  (when (or (nil? requester) (nil? team) (nil? team-owner) (and (some? file-id) (nil? file)))
-                    (ex/raise :type :validation
-                              :code :invalid-parameters))
-
-                  ;; Check that the requester is not muted
-                  (check-profile-muted conn requester)
-
-                  ;; Check that the owner is not marked as bounce nor spam
-                  (check-email-bounce conn (:email team-owner) false)
-                  (check-email-spam conn (:email team-owner) true)
-
-                  (let [request (create-team-access-request
-                                 cfg {:team team :requester requester :team-owner team-owner :file file :is-viewer is-viewer})]
-                    (when request
-                      (with-meta {:request request}
-                        {::audit/props {:request 1}})))))))

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

@@ -0,0 +1,576 @@
+;; 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.teams-invitations
+  (:require
+   [app.common.data.macros :as dm]
+   [app.common.exceptions :as ex]
+   [app.common.features :as cfeat]
+   [app.common.logging :as l]
+   [app.common.schema :as sm]
+   [app.common.types.team :as types.team]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.db.sql :as sql]
+   [app.email :as eml]
+   [app.loggers.audit :as audit]
+   [app.main :as-alias main]
+   [app.rpc :as-alias rpc]
+   [app.rpc.commands.files :as files]
+   [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.quotes :as quotes]
+   [app.setup :as-alias setup]
+   [app.tokens :as tokens]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [cuerdas.core :as str]))
+
+;; --- Mutation: Create Team Invitation
+
+
+(def sql:upsert-team-invitation
+  "insert into team_invitation(id, team_id, email_to, created_by, role, valid_until)
+   values (?, ?, ?, ?, ?, ?)
+       on conflict(team_id, email_to) do
+          update set role = ?, valid_until = ?, updated_at = now()
+   returning *")
+
+(defn- create-invitation-token
+  [cfg {:keys [profile-id valid-until team-id member-id member-email role]}]
+  (tokens/generate (::setup/props cfg)
+                   {:iss :team-invitation
+                    :exp valid-until
+                    :profile-id profile-id
+                    :role role
+                    :team-id team-id
+                    :member-email member-email
+                    :member-id member-id}))
+
+(defn- create-profile-identity-token
+  [cfg profile-id]
+
+  (dm/assert!
+   "expected valid uuid for profile-id"
+   (uuid? profile-id))
+
+  (tokens/generate (::setup/props cfg)
+                   {:iss :profile-identity
+                    :profile-id profile-id
+                    :exp (dt/in-future {:days 30})}))
+
+(def ^:private schema:create-invitation
+  [:map {:title "params:create-invitation"}
+   [::rpc/profile-id ::sm/uuid]
+   [:team
+    [:map
+     [:id ::sm/uuid]
+     [:name :string]]]
+   [:profile
+    [:map
+     [:id ::sm/uuid]
+     [:fullname :string]]]
+   [:role ::types.team/role]
+   [:email ::sm/email]])
+
+(def ^:private check-create-invitation-params!
+  (sm/check-fn schema:create-invitation))
+
+(defn- create-invitation
+  [{:keys [::db/conn] :as cfg} {:keys [team profile role email] :as params}]
+
+  (dm/assert!
+   "expected valid connection on cfg parameter"
+   (db/connection? conn))
+
+  (dm/assert!
+   "expected valid params for `create-invitation` fn"
+   (check-create-invitation-params! params))
+
+  (let [email  (profile/clean-email email)
+        member (profile/get-profile-by-email conn email)]
+
+    (teams/check-profile-muted conn member)
+    (teams/check-email-bounce conn email true)
+    (teams/check-email-spam conn email true)
+
+    ;; When we have email verification disabled and invitation user is
+    ;; already present in the database, we proceed to add it to the
+    ;; team as-is, without email roundtrip.
+
+    ;; TODO: if member does not exists and email verification is
+    ;; disabled, we should proceed to create the profile (?)
+    (if (and (not (contains? cf/flags :email-verification))
+             (some? member))
+      (let [params (merge {:team-id (:id team)
+                           :profile-id (:id member)}
+                          (get types.team/permissions-for-role role))]
+
+        ;; Insert the invited member to the team
+        (db/insert! conn :team-profile-rel params
+                    {::db/on-conflict-do-nothing? true})
+
+        ;; If profile is not yet verified, mark it as verified because
+        ;; accepting an invitation link serves as verification.
+        (when-not (:is-active member)
+          (db/update! conn :profile
+                      {:is-active true}
+                      {:id (:id member)}))
+
+        nil)
+
+      (let [id         (uuid/next)
+            expire     (dt/in-future "168h") ;; 7 days
+            invitation (db/exec-one! conn [sql:upsert-team-invitation id
+                                           (:id team) (str/lower email)
+                                           (:id profile)
+                                           (name role) expire
+                                           (name role) expire])
+            updated?   (not= id (:id invitation))
+            profile-id (:id profile)
+            tprops     {:profile-id profile-id
+                        :invitation-id (:id invitation)
+                        :valid-until expire
+                        :team-id (:id team)
+                        :member-email (:email-to invitation)
+                        :member-id (:id member)
+                        :role role}
+            itoken     (create-invitation-token cfg tprops)
+            ptoken     (create-profile-identity-token cfg profile-id)]
+
+        (when (contains? cf/flags :log-invitation-tokens)
+          (l/info :hint "invitation token" :token itoken))
+
+        (let [props  (-> (dissoc tprops :profile-id)
+                         (audit/clean-props))
+              evname (if updated?
+                       "update-team-invitation"
+                       "create-team-invitation")
+              event (-> (audit/event-from-rpc-params params)
+                        (assoc ::audit/name evname)
+                        (assoc ::audit/props props))]
+          (audit/submit! cfg event))
+
+        (eml/send! {::eml/conn conn
+                    ::eml/factory eml/invite-to-team
+                    :public-uri (cf/get :public-uri)
+                    :to email
+                    :invited-by (:fullname profile)
+                    :team (:name team)
+                    :token itoken
+                    :extra-data ptoken})
+
+        itoken))))
+
+(defn- add-user-to-team
+  [conn profile team role email]
+
+  (let [team-id (:id team)
+        member  (db/get* conn :profile
+                         {:email (str/lower email)}
+                         {::sql/columns [:id :email]})
+        params  (merge
+                 {:team-id team-id
+                  :profile-id (:id member)}
+                 (get types.team/permissions-for-role role))]
+
+      ;; Do not allow blocked users to join teams.
+    (when (:is-blocked member)
+      (ex/raise :type :restriction
+                :code :profile-blocked))
+
+    (quotes/check!
+     {::db/conn conn
+      ::quotes/id ::quotes/profiles-per-team
+      ::quotes/profile-id (:id member)
+      ::quotes/team-id team-id})
+
+    ;; Insert the member to the team
+    (db/insert! conn :team-profile-rel params {::db/on-conflict-do-nothing? true})
+
+    ;; Delete any request
+    (db/delete! conn :team-access-request
+                {:team-id team-id :requester-id (:id member)})
+
+    ;; Delete any invitation
+    (db/delete! conn :team-invitation
+                {:team-id team-id :email-to (:email member)})
+
+    (eml/send! {::eml/conn conn
+                ::eml/factory eml/join-team
+                :public-uri (cf/get :public-uri)
+                :to email
+                :invited-by (:fullname profile)
+                :team (:name team)
+                :team-id (:id team)})))
+
+(def sql:valid-requests-email
+  "SELECT p.email
+     FROM team_access_request AS tr
+     JOIN profile AS p ON (tr.requester_id = p.id)
+    WHERE tr.team_id = ?
+      AND tr.auto_join_until > now()")
+
+(defn- get-valid-requests-email
+  [conn team-id]
+  (db/exec! conn [sql:valid-requests-email team-id]))
+
+(def ^:private xf:map-email
+  (map :email))
+
+(defn- create-team-invitations
+  [{:keys [::db/conn] :as cfg} {:keys [profile team role emails] :as params}]
+  (let [join-requests    (into #{} xf:map-email
+                               (get-valid-requests-email conn (:id team)))
+        team-members     (into #{} xf:map-email
+                               (teams/get-team-members conn (:id team)))
+
+        invitations      (into #{}
+                               (comp
+                                ;;  We don't re-send inviation to
+                                ;;  already existing members
+                                (remove team-members)
+                                ;; We don't send invitations to
+                                ;; join-requested members
+                                (remove join-requests)
+                                (map (fn [email] (assoc params :email email)))
+                                (keep (partial create-invitation cfg)))
+                               emails)]
+
+    ;; For requested invitations, do not send invitation emails, add
+    ;; the user directly to the team
+    (->> (filter join-requests emails)
+         (run! (partial add-user-to-team conn profile team role)))
+
+    invitations))
+
+(def ^:private schema:create-team-invitations
+  [:map {:title "create-team-invitations"}
+   [:team-id ::sm/uuid]
+   [:role ::types.team/role]
+   [:emails [::sm/set ::sm/email]]])
+
+(def ^:private max-invitations-by-request-threshold
+  "The number of invitations can be sent in a single rpc request"
+  25)
+
+(sv/defmethod ::create-team-invitations
+  "A rpc call that allow to send a single or multiple invitations to
+  join the team."
+  {::doc/added "1.17"
+   ::doc/module :teams
+   ::sm/params schema:create-team-invitations}
+  [cfg {:keys [::rpc/profile-id team-id emails] :as params}]
+  (let [perms    (teams/get-permissions cfg profile-id team-id)
+        profile  (db/get-by-id cfg :profile profile-id)
+        emails   (into #{} (map profile/clean-email) emails)]
+
+    (when-not (:is-admin perms)
+      (ex/raise :type :validation
+                :code :insufficient-permissions))
+
+    (when (> (count emails) max-invitations-by-request-threshold)
+      (ex/raise :type :validation
+                :code :max-invitations-by-request
+                :hint "the maximum of invitation on single request is reached"
+                :threshold max-invitations-by-request-threshold))
+
+    (-> cfg
+        (assoc ::quotes/profile-id profile-id)
+        (assoc ::quotes/team-id team-id)
+        (assoc ::quotes/incr (count emails))
+        (quotes/check! {::quotes/id ::quotes/invitations-per-team}
+                       {::quotes/id ::quotes/profiles-per-team}))
+
+    ;; Check if the current profile is allowed to send emails
+    (teams/check-profile-muted cfg profile)
+
+    (let [team        (db/get-by-id cfg :team team-id)
+          ;; NOTE: Is important pass RPC method params down to the
+          ;; `create-team-invitations` because it uses the implicit
+          ;; RPC properties from params for fill necessary data on
+          ;; emiting an entry to the audit-log
+          invitations (db/tx-run! cfg create-team-invitations
+                                  (-> params
+                                      (assoc :profile profile)
+                                      (assoc :team team)
+                                      (assoc :emails emails)))]
+
+      (with-meta {:total (count invitations)
+                  :invitations invitations}
+        {::audit/props {:invitations (count invitations)}}))))
+
+;; --- Mutation: Create Team & Invite Members
+
+(def ^:private schema:create-team-with-invitations
+  [:map {:title "create-team-with-invitations"}
+   [:name [:string {:max 250}]]
+   [:features {:optional true} ::cfeat/features]
+   [:id {:optional true} ::sm/uuid]
+   [:emails [::sm/set ::sm/email]]
+   [:role ::types.team/role]])
+
+(sv/defmethod ::create-team-with-invitations
+  {::doc/added "1.17"
+   ::doc/module :teams
+   ::sm/params schema:create-team-with-invitations
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id emails role name] :as params}]
+  (let [features (-> (cfeat/get-enabled-features cf/flags)
+                     (cfeat/check-client-features! (:features params)))
+
+        params   (-> params
+                     (assoc :profile-id profile-id)
+                     (assoc :features features))
+
+        team     (teams/create-team cfg params)
+        emails   (into #{} (map profile/clean-email) emails)]
+
+    (-> cfg
+        (assoc ::quotes/profile-id profile-id)
+        (assoc ::quotes/team-id (:id team))
+        (assoc ::quotes/incr (count emails))
+        (quotes/check! {::quotes/id ::quotes/teams-per-profile}
+                       {::quotes/id ::quotes/invitations-per-team}
+                       {::quotes/id ::quotes/profiles-per-team}))
+
+    (when (> (count emails) max-invitations-by-request-threshold)
+      (ex/raise :type :validation
+                :code :max-invitations-by-request
+                :hint "the maximum of invitation on single request is reached"
+                :threshold max-invitations-by-request-threshold))
+
+    (let [props {:name name :features features}
+          event (-> (audit/event-from-rpc-params params)
+                    (assoc ::audit/name "create-team")
+                    (assoc ::audit/props props))]
+      (audit/submit! cfg event))
+
+    ;; Create invitations for all provided emails.
+    (let [profile     (db/get-by-id conn :profile profile-id)
+          params      (-> params
+                          (assoc :team team)
+                          (assoc :profile profile)
+                          (assoc :role role))
+          invitations (->> emails
+                           (map (fn [email] (assoc params :email email)))
+                           (map (partial create-invitation cfg)))]
+
+      (vary-meta team assoc ::audit/props {:invitations (count invitations)}))))
+
+;; --- Query: get-team-invitation-token
+
+(def ^:private schema:get-team-invitation-token
+  [:map {:title "get-team-invitation-token"}
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]])
+
+(sv/defmethod ::get-team-invitation-token
+  {::doc/added "1.17"
+   ::doc/module :teams
+   ::sm/params schema:get-team-invitation-token}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
+  (teams/check-read-permissions! pool profile-id team-id)
+  (let [email (profile/clean-email email)
+        invit (-> (db/get pool :team-invitation
+                          {:team-id team-id
+                           :email-to email})
+                  (update :role keyword))
+
+        member (profile/get-profile-by-email pool (:email-to invit))
+        token  (create-invitation-token cfg {:team-id (:team-id invit)
+                                             :profile-id profile-id
+                                             :valid-until (:valid-until invit)
+                                             :role (:role invit)
+                                             :member-id (:id member)
+                                             :member-email (or (:email member)
+                                                               (profile/clean-email (:email-to invit)))})]
+    {:token token}))
+
+;; --- Mutation: Update invitation role
+
+(def ^:private schema:update-team-invitation-role
+  [:map {:title "update-team-invitation-role"}
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]
+   [:role ::types.team/role]])
+
+(sv/defmethod ::update-team-invitation-role
+  {::doc/added "1.17"
+   ::doc/module :teams
+   ::sm/params schema:update-team-invitation-role}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email role] :as params}]
+  (db/with-atomic [conn pool]
+    (let [perms (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 (profile/clean-email email)})
+
+      nil)))
+
+;; --- Mutation: Delete invitation
+
+(def ^:private schema:delete-team-invition
+  [:map {:title "delete-team-invitation"}
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]])
+
+(sv/defmethod ::delete-team-invitation
+  {::doc/added "1.17"
+   ::sm/params schema:delete-team-invition}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
+  (db/with-atomic [conn pool]
+    (let [perms (teams/get-permissions conn profile-id team-id)]
+
+      (when-not (:is-admin perms)
+        (ex/raise :type :validation
+                  :code :insufficient-permissions))
+
+      (let [invitation (db/delete! conn :team-invitation
+                                   {:team-id team-id
+                                    :email-to (profile/clean-email email)}
+                                   {::db/return-keys true})]
+        (rph/wrap nil {::audit/props {:invitation-id (:id invitation)}})))))
+
+
+;; --- Mutation: Request Team Invitation
+
+(def ^:private sql:get-team-owner
+  "SELECT p.*
+     FROM profile AS p
+     JOIN team_profile_rel AS tpr ON (tpr.profile_id = p.id)
+    WHERE tpr.team_id = ?
+      AND tpr.is_owner IS TRUE")
+
+(defn- get-team-owner
+  "Return a complete profile of the team owner"
+  [conn team-id]
+  (->> (db/exec! conn [sql:get-team-owner team-id])
+       (remove db/is-row-deleted?)
+       (map profile/decode-row)
+       (first)))
+
+(defn- check-existing-team-access-request
+  "Checks if an existing team access request is still valid"
+  [conn team-id profile-id]
+  (when-let [request (db/get* conn :team-access-request
+                              {:team-id team-id
+                               :requester-id profile-id})]
+    (when (dt/is-after? (:valid-until request) (dt/now))
+      (ex/raise :type :validation
+                :code :request-already-sent
+                :hint "you have already made a request to join this team less than 24 hours ago"))))
+
+(def ^:private sql:upsert-team-access-request
+  "INSERT INTO team_access_request (id, team_id, requester_id, valid_until, auto_join_until)
+   VALUES (?, ?, ?, ?, ?)
+       ON CONFLICT (team_id, requester_id)
+       DO UPDATE SET valid_until = ?, auto_join_until = ?, updated_at = now()
+   RETURNING *")
+
+(defn- upsert-team-access-request
+  "Create or update team access request for provided team and profile-id"
+  [conn team-id requester-id]
+  (check-existing-team-access-request conn team-id requester-id)
+  (let [valid-until     (dt/in-future {:hours 24})
+        auto-join-until (dt/in-future {:days 7})
+        request-id      (uuid/next)]
+    (db/exec-one! conn [sql:upsert-team-access-request
+                        request-id team-id requester-id
+                        valid-until auto-join-until
+                        valid-until auto-join-until])))
+
+(defn- get-file-for-team-access-request
+  "A specific method for obtain a file with name and page-id used for
+  team request access procediment"
+  [cfg file-id]
+  (let [file (files/get-file cfg file-id :migrate? false)]
+    (-> file
+        (dissoc :data)
+        (dissoc :deleted-at)
+        (assoc :page-id (-> file :data :pages first)))))
+
+(def ^:private schema:create-team-access-request
+  [:and
+   [:map {:title "create-team-access-request"}
+    [:file-id {:optional true} ::sm/uuid]
+    [:team-id {:optional true} ::sm/uuid]
+    [:is-viewer {:optional true} ::sm/boolean]]
+
+   [:fn (fn [params]
+          (or (contains? params :file-id)
+              (contains? params :team-id)))]])
+
+(sv/defmethod ::create-team-access-request
+  "A rpc call that allow to request for an invitations to join the team."
+  {::doc/added "2.2.0"
+   ::doc/module :teams
+   ::sm/params schema:create-team-access-request
+   ::db/transaction true}
+  [{:keys [::db/conn] :as cfg}
+   {:keys [::rpc/profile-id file-id team-id is-viewer] :as params}]
+
+  (let [requester  (profile/get-profile conn profile-id)
+        team       (if team-id
+                     (->> (db/get-by-id conn :team team-id)
+                          (teams/decode-row))
+                     (teams/get-team-for-file conn file-id))
+
+        team-id    (:id team)
+
+        team-owner (get-team-owner conn team-id)
+
+        file       (when (some? file-id)
+                     (get-file-for-team-access-request cfg file-id))]
+
+    (-> cfg
+        (assoc ::quotes/profile-id profile-id)
+        (assoc ::quotes/team-id team-id)
+        (quotes/check! {::quotes/id ::quotes/team-access-requests-per-team}
+                       {::quotes/id ::quotes/team-access-requests-per-requester}))
+
+    (teams/check-profile-muted conn requester)
+    (teams/check-email-bounce conn (:email team-owner) false)
+    (teams/check-email-spam conn (:email team-owner) true)
+
+    (let [request (upsert-team-access-request conn team-id profile-id)
+          factory (cond
+                    (and (some? file) (:is-default team) is-viewer)
+                    eml/request-file-access-yourpenpot-view
+
+                    (and (some? file) (:is-default team))
+                    eml/request-file-access-yourpenpot
+
+                    (some? file)
+                    eml/request-file-access
+
+                    :else
+                    eml/request-team-access)]
+
+      (eml/send! {::eml/conn conn
+                  ::eml/factory factory
+                  :public-uri (cf/get :public-uri)
+                  :to (:email team-owner)
+                  :requested-by (:fullname requester)
+                  :requested-by-email (:email requester)
+                  :team-name (:name team)
+                  :team-id team-id
+                  :file-name (:name file)
+                  :file-id file-id
+                  :page-id (:page-id file)})
+
+      (with-meta {:request request}
+        {::audit/props {:request 1}}))))
+
+

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

@@ -8,6 +8,7 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.schema :as sm]
+   [app.common.types.team :as types.team]
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as-alias sql]
@@ -16,7 +17,6 @@
    [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.quotes :as quotes]
@@ -92,7 +92,7 @@
         params (merge
                 {:team-id team-id
                  :profile-id (:id member)}
-                (teams/role->params role))]
+                (get types.team/permissions-for-role role))]
 
     ;; Do not allow blocked users accept invitations.
     (when (:is-blocked member)
@@ -128,7 +128,7 @@
    [:iss :keyword]
    [:exp ::dt/instant]
    [:profile-id ::sm/uuid]
-   [:role teams/schema:role]
+   [:role ::types.team/role]
    [:team-id ::sm/uuid]
    [:member-email ::sm/email]
    [:member-id {:optional true} ::sm/uuid]])
@@ -167,12 +167,24 @@
         (let [props {:team-id (:team-id claims)
                      :role (:role claims)
                      :invitation-id (:id invitation)}
-              event (-> (audit/event-from-rpc-params params)
+
+              accept-invitation-event
+              (-> (audit/event-from-rpc-params params)
                   (assoc ::audit/name "accept-team-invitation")
-                        (assoc ::audit/props props))]
+                  (assoc ::audit/props props))
+
+              accept-invitation-from-event
+              (-> (audit/event-from-rpc-params params)
+                  (assoc ::audit/profile-id (:created-by invitation))
+                  (assoc ::audit/name "accept-team-invitation-from")
+                  (assoc ::audit/props (assoc props
+                                              :profile-id (:id profile)
+                                              :email (:email profile))))]
+
+          (audit/submit! cfg accept-invitation-event)
+          (audit/submit! cfg accept-invitation-from-event)
 
           (accept-invitation cfg claims invitation profile)
-          (audit/submit! cfg event)
           (assoc claims :state :created))
 
         (ex/raise :type :validation

backend/src/app/rpc/doc.clj

@@ -202,10 +202,9 @@
 ;; MODULE INIT
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::routes vector?)
+(defmethod ig/assert-key ::routes
-
+  [_ params]
-(defmethod ig/pre-init-spec ::routes [_]
+  (assert (sm/valid? ::rpc/methods (::rpc/methods params)) "expected valid methods"))
-  (s/keys :req-un [::rpc/methods]))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [methods] :as cfg}]

backend/src/app/rpc/permissions.clj

@@ -8,11 +8,10 @@
   "A permission checking helper factories."
   (:require
    [app.common.exceptions :as ex]
-   [app.common.schema :as sm]
+   [app.common.schema :as sm]))
-   [app.common.spec :as us]
-   [clojure.spec.alpha :as s]))
 
-(sm/register! ::permissions
+(sm/register!
+ ^{::sm/type ::permissions}
  [:map {:title "Permissions"}
   [:type {:gen/elements [:membership :share-link]} :keyword]
   [:is-owner ::sm/boolean]
@@ -21,12 +20,12 @@
   [:can-read ::sm/boolean]
   [:is-logged ::sm/boolean]])
 
-
+(def valid-roles
-(s/def ::role #{:admin :owner :editor :viewer})
+  #{:admin :owner :editor :viewer})
 
 (defn assign-role-flags
   [params role]
-  (us/verify ::role role)
+  (assert (contains? valid-roles role) "expected a valid role")
   (cond-> params
     (= role :owner)
     (assoc :is-owner true
@@ -51,7 +50,7 @@
 (defn make-admin-predicate-fn
   "A simple factory for admin permission predicate functions."
   [qfn]
-  (us/assert fn? qfn)
+  (assert (fn? qfn) "expected a function")
   (fn check
     ([perms] (:is-admin perms))
     ([conn & args] (check (apply qfn conn args)))))
@@ -59,7 +58,7 @@
 (defn make-edition-predicate-fn
   "A simple factory for edition permission predicate functions."
   [qfn]
-  (us/assert fn? qfn)
+  (assert (fn? qfn) "expected a function")
   (fn check
     ([perms] (:can-edit perms))
     ([conn & args] (check (apply qfn conn args)))))
@@ -67,7 +66,7 @@
 (defn make-read-predicate-fn
   "A simple factory for read permission predicate functions."
   [qfn]
-  (us/assert fn? qfn)
+  (assert (fn? qfn) "expected a function")
   (fn check
     ([perms] (:can-read perms))
     ([conn & args] (check (apply qfn conn args)))))
@@ -75,7 +74,7 @@
 (defn make-comment-predicate-fn
   "A simple factory for comment permission predicate functions."
   [qfn]
-  (us/assert fn? qfn)
+  (assert (fn? qfn) "expected a function")
   (fn check
     ([perms]
      (and (:is-logged perms) (= (:who-comment perms) "all")))

backend/src/app/rpc/quotes.clj

@@ -442,7 +442,7 @@
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: SNAPSHOTS-PER-FILE
+;; QUOTE: SNAPSHOTS-PER-TEAM
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def ^:private schema:snapshots-per-team
@@ -472,6 +472,57 @@
       (assoc ::count-sql [sql:get-snapshots-per-team team-id])
       (generic-check!)))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; QUOTE: TEAM-ACCESS-REQUESTS-PER-TEAM
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private schema:team-access-requests-per-team
+  [:map
+   [::profile-id ::sm/uuid]
+   [::team-id ::sm/uuid]])
+
+(def ^:private valid-team-access-requests-per-team-quote?
+  (sm/lazy-validator schema:team-access-requests-per-team))
+
+(def ^:private sql:get-team-access-requests-per-team
+  "SELECT count(*) AS total
+     FROM team_access_request AS tar
+    WHERE tar.team_id = ?")
+
+(defmethod check-quote ::team-access-requests-per-team
+  [{:keys [::profile-id ::team-id ::target] :as quote}]
+  (assert (valid-team-access-requests-per-team-quote? quote) "invalid quote parameters")
+  (-> quote
+      (assoc ::default (cf/get :quotes-team-access-requests-per-team Integer/MAX_VALUE))
+      (assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
+      (assoc ::count-sql [sql:get-team-access-requests-per-team team-id])
+      (generic-check!)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; QUOTE: TEAM-ACCESS-REQUESTS-PER-REQUESTER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private schema:team-access-requests-per-requester
+  [:map
+   [::profile-id ::sm/uuid]])
+
+(def ^:private valid-team-access-requests-per-requester-quote?
+  (sm/lazy-validator schema:team-access-requests-per-requester))
+
+(def ^:private sql:get-team-access-requests-per-requester
+  "SELECT count(*) AS total
+     FROM team_access_request AS tar
+    WHERE tar.requester_id = ?")
+
+(defmethod check-quote ::team-access-requests-per-requester
+  [{:keys [::profile-id ::target] :as quote}]
+  (assert (valid-team-access-requests-per-requester-quote? quote) "invalid quote parameters")
+  (-> quote
+      (assoc ::default (cf/get :quotes-team-access-requests-per-requester Integer/MAX_VALUE))
+      (assoc ::quote-sql [sql:get-quotes-1 target profile-id])
+      (assoc ::count-sql [sql:get-team-access-requests-per-requester profile-id])
+      (generic-check!)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: DEFAULT
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/app/rpc/rlimit.clj

@@ -46,7 +46,7 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uri :as uri]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -61,7 +61,6 @@
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.edn :as edn]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.fs :as fs]
    [integrant.core :as ig]
@@ -95,9 +94,46 @@
 (defmulti parse-limit   (fn [[_ strategy _]] strategy))
 (defmulti process-limit (fn [_ _ _ o] (::strategy o)))
 
+(sm/register!
+ {:type ::rpc/rlimit
+  :pred #(instance? clojure.lang.Agent %)})
+
+(def ^:private schema:strategy
+  [:enum :window :bucket])
+
+(def ^:private schema:limit-tuple
+  [:tuple :keyword schema:strategy :string])
+
+(def ^:private schema:limit
+  [:and
+   [:map
+    [::name :any]
+    [::strategy schema:strategy]
+    [::key :string]
+    [::opts :string]]
+   [:or
+    [:map
+     [::capacity ::sm/int]
+     [::rate ::sm/int]
+     [::internal ::dt/duration]
+     [::params [::sm/vec :any]]]
+    [:map
+     [::nreq ::sm/int]
+     [::unit [:enum :days :hours :minutes :seconds :weeks]]]]])
+
+(def ^:private schema:limits
+  [:map-of :keyword [::sm/vec schema:limit]])
+
+(def ^:private valid-limit-tuple?
+  (sm/lazy-validator schema:limit-tuple))
+
+(def ^:private valid-rlimit-instance?
+  (sm/lazy-validator ::rpc/rlimit))
+
 (defmethod parse-limit :window
   [[name strategy opts :as vlimit]]
-  (us/assert! ::limit-tuple vlimit)
+  (assert (valid-limit-tuple? vlimit) "expected valid limit tuple")
+
   (merge
    {::name name
     ::strategy strategy}
@@ -118,7 +154,8 @@
 
 (defmethod parse-limit :bucket
   [[name strategy opts :as vlimit]]
-  (us/assert! ::limit-tuple vlimit)
+  (assert (valid-limit-tuple? vlimit) "expected valid limit tuple")
+
   (if-let [[_ capacity rate interval] (re-find bucket-opts-re opts)]
     (let [interval (dt/duration interval)
           rate     (parse-long rate)
@@ -140,7 +177,7 @@
   (let [script    (-> bucket-rate-limit-script
                       (assoc ::rscript/keys [(str key "." service "." user-id)])
                       (assoc ::rscript/vals (conj params (dt/->seconds now))))
-        result    (rds/eval! redis script)
+        result    (rds/eval redis script)
         allowed?  (boolean (nth result 0))
         remaining (nth result 1)
         reset     (* (/ (inst-ms interval) rate)
@@ -164,7 +201,7 @@
         script    (-> window-rate-limit-script
                       (assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))])
                       (assoc ::rscript/vals [nreq (dt/->seconds ttl)]))
-        result    (rds/eval! redis script)
+        result    (rds/eval redis script)
         allowed?  (boolean (nth result 0))
         remaining (nth result 1)]
     (l/trace :hint "limit processed"
@@ -245,8 +282,8 @@
 
 (defn wrap
   [{:keys [::rpc/rlimit ::rds/redis] :as cfg} f mdata]
-  (us/assert! ::rpc/rlimit rlimit)
+  (assert (rds/redis? redis) "expected a valid redis instance")
-  (us/assert! ::rds/redis redis)
+  (assert (or (nil? rlimit) (valid-rlimit-instance? rlimit)) "expected a valid rlimit instance")
 
   (if rlimit
     (let [skey  (keyword (::rpc/type cfg) (->> mdata ::sv/spec name))
@@ -275,42 +312,19 @@
 ;; CONFIG WATCHER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::strategy (s/and ::us/keyword #{:window :bucket}))
+(def ^:private schema:config
-(s/def ::capacity ::us/integer)
+  [:map-of
-(s/def ::rate ::us/integer)
+   [:or :keyword [:set :keyword]]
-(s/def ::interval ::dt/duration)
+   [:vector schema:limit-tuple]])
-(s/def ::key ::us/string)
-(s/def ::opts ::us/string)
-(s/def ::params vector?)
-(s/def ::unit #{:days :hours :minutes :seconds :weeks})
-(s/def ::nreq ::us/integer)
-(s/def ::refresh ::dt/duration)
 
-(s/def ::limit-tuple
+(def ^:private check-config
-  (s/tuple ::us/keyword ::strategy string?))
+  (sm/check-fn schema:config))
 
-(s/def ::limits
+(def ^:private check-refresh
-  (s/map-of keyword? (s/every ::limit :kind vector?)))
+  (sm/check-fn ::dt/duration))
 
-(s/def ::limit
+(def ^:private check-limits
-  (s/and
+  (sm/check-fn schema:limits))
-   (s/keys :req [::name ::strategy ::key ::opts])
-   (s/or :bucket
-         (s/keys :req [::capacity
-                       ::rate
-                       ::interval
-                       ::params])
-         :window
-         (s/keys :req [::nreq
-                       ::unit]))))
-
-(s/def ::rpc/rlimit
-  (s/nilable
-   #(instance? clojure.lang.Agent %)))
-
-(s/def ::config
-  (s/map-of (s/or :kw keyword? :set set?)
-            (s/every ::limit-tuple :kind vector?)))
 
 (defn read-config
   [path]
@@ -336,13 +350,9 @@
                          {}
                          config)))]
 
-    (when-let [config (some->> path slurp edn/read-string)]
+    (when-let [config (some->> path slurp edn/read-string check-config)]
-      (us/verify! ::config config)
+      (let [refresh (->> config meta :refresh dt/duration check-refresh)
-      (let [refresh (->> config meta :refresh dt/duration)
+            limits  (->> config compile-pass-1 compile-pass-2 check-limits)]
-            limits  (->> config compile-pass-1 compile-pass-2)]
-
-        (us/verify! ::limits limits)
-        (us/verify! ::refresh refresh)
 
         {::refresh refresh
          ::limits limits}))))
@@ -385,8 +395,9 @@
   (when-let [path (cf/get :rpc-rlimit-config)]
     (and (fs/exists? path) (fs/regular-file? path) path)))
 
-(defmethod ig/pre-init-spec :app.rpc/rlimit [_]
+(defmethod ig/assert-key :app.rpc/rlimit
-  (s/keys :req [::wrk/executor]))
+  [_ {:keys [::wrk/executor]}]
+  (assert (sm/valid? ::wrk/executor executor) "expect valid executor"))
 
 (defmethod ig/init-key ::rpc/rlimit
   [_ {:keys [::wrk/executor] :as cfg}]

backend/src/app/setup.clj

@@ -9,7 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.main :as-alias main]
@@ -17,7 +17,6 @@
    [app.setup.templates]
    [buddy.core.codecs :as bc]
    [buddy.core.nonce :as bn]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (defn- generate-random-key
@@ -73,12 +72,10 @@
     (db/run! system (fn [{:keys [::db/conn]}]
                       (db/exec-one! conn [sql:add-prop prop value false value false])))))
 
-(s/def ::key ::us/string)
+(defmethod ig/assert-key ::props
-(s/def ::props (s/map-of ::us/keyword some?))
+  [_ params]
-
+  (assert (db/pool? (::db/pool params)) "expected valid database pool")
-(defmethod ig/pre-init-spec ::props [_]
+  (assert (string? (::key params)) "expected valid key string"))
-  (s/keys :req [::db/pool]
-          :opt [::key]))
 
 (defmethod ig/init-key ::props
   [_ {:keys [::db/pool ::key] :as cfg}]
@@ -94,3 +91,7 @@
           (assoc :secret-key secret)
           (assoc :tokens-key (keys/derive secret :salt "tokens"))
           (update :instance-id handle-instance-id conn (db/read-only? pool))))))
+
+
+;; FIXME
+(sm/register! ::props :any)

backend/src/app/srepl.clj

@@ -8,7 +8,6 @@
   "Server Repl."
   (:require
    [app.common.logging :as l]
-   [app.common.spec :as us]
    [app.config :as cf]
    [app.srepl.cli]
    [app.srepl.main]
@@ -16,7 +15,6 @@
    [app.util.locks :as locks]
    [clojure.core.server :as ccs]
    [clojure.main :as cm]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (defn- repl-init
@@ -44,16 +42,14 @@
 
 ;; --- State initialization
 
-(s/def ::port ::us/integer)
+(defmethod ig/assert-key ::server
-(s/def ::host ::us/not-empty-string)
+  [_ params]
+  (assert (int? (::port params)) "expected valid port")
+  (assert (string? (::host params)) "expected valid host"))
 
-(defmethod ig/pre-init-spec ::server
+(defmethod ig/expand-key ::server
-  [_]
+  [[type :as k] v]
-  (s/keys :req [::host ::port]))
+  {k (assoc v ::flag (keyword (str (name type) "-server")))})
-
-(defmethod ig/prep-key ::server
-  [[type _] cfg]
-  (assoc cfg ::flag (keyword (str (name type) "-server"))))
 
 (defmethod ig/init-key ::server
   [[type _] {:keys [::flag ::port ::host] :as cfg}]

backend/src/app/storage.clj

@@ -11,7 +11,7 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
@@ -19,7 +19,6 @@
    [app.storage.impl :as impl]
    [app.storage.s3 :as ss3]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.fs :as fs]
    [integrant.core :as ig])
@@ -48,19 +47,29 @@
 ;; Storage Module State
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::id #{:assets-fs :assets-s3 :fs :s3})
+(def ^:private schema:backends
-(s/def ::s3 ::ss3/backend)
+  [:map-of :keyword
-(s/def ::fs ::sfs/backend)
+   [:maybe
-(s/def ::type #{:fs :s3})
+    [:or ::ss3/backend ::sfs/backend]]])
 
-(s/def ::backends
+(def ^:private valid-backends?
-  (s/map-of ::us/keyword
+  (sm/validator schema:backends))
-            (s/nilable
-             (s/or :s3 ::ss3/backend
-                   :fs ::sfs/backend))))
 
-(defmethod ig/pre-init-spec ::storage [_]
+(def ^:private schema:storage
-  (s/keys :req [::db/pool ::backends]))
+  [:map {:title "storage"}
+   [::backends schema:backends]
+   [::backend [:enum :s3 :fs]]
+   ::db/connectable])
+
+(def valid-storage?
+  (sm/validator schema:storage))
+
+(sm/register! ::storage schema:storage)
+
+(defmethod ig/assert-key ::storage
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected valid database pool")
+  (assert (valid-backends? (::backends params)) "expected valid backends map"))
 
 (defmethod ig/init-key ::storage
   [_ {:keys [::backends ::db/pool] :as cfg}]
@@ -78,14 +87,6 @@
         (assoc ::backend backend)
         (assoc ::db/connectable pool))))
 
-(s/def ::backend keyword?)
-(s/def ::storage
-  (s/keys :req [::backends ::db/pool ::db/connectable]
-          :opt [::backend]))
-
-(s/def ::storage-with-backend
-  (s/and ::storage #(contains? % ::backend)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Database Objects
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -201,14 +202,15 @@
 
 (defn get-object
   [{:keys [::db/connectable] :as storage}  id]
-  (us/assert! ::storage storage)
+  (assert (valid-storage? storage))
   (retrieve-database-object connectable id))
 
 (defn put-object!
   "Creates a new object with the provided content."
   [{:keys [::backend] :as storage} {:keys [::content] :as params}]
-  (us/assert! ::storage-with-backend storage)
+  (assert (valid-storage? storage))
-  (us/assert! ::impl/content content)
+  (assert (impl/content? content) "expected an instance of content")
+
   (let [object (create-database-object storage params)]
     (if (::created? (meta object))
       ;; Store the data finally on the underlying storage subsystem.
@@ -219,7 +221,7 @@
 (defn touch-object!
   "Mark object as touched."
   [{:keys [::db/connectable] :as storage} object-or-id]
-  (us/assert! ::storage storage)
+  (assert (valid-storage? storage))
   (let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id)]
     (-> (db/update! connectable :storage-object
                     {:touched-at (dt/now)}
@@ -231,7 +233,7 @@
   "Return an input stream instance of the object content."
   ^InputStream
   [storage object]
-  (us/assert! ::storage storage)
+  (assert (valid-storage? storage))
   (when (or (nil? (:expired-at object))
             (dt/is-after? (:expired-at object) (dt/now)))
     (-> (impl/resolve-backend storage (:backend object))
@@ -240,7 +242,7 @@
 (defn get-object-bytes
   "Returns a byte array of object content."
   [storage object]
-  (us/assert! ::storage storage)
+  (assert (valid-storage? storage))
   (when (or (nil? (:expired-at object))
             (dt/is-after? (:expired-at object) (dt/now)))
     (-> (impl/resolve-backend storage (:backend object))
@@ -250,7 +252,7 @@
   ([storage object]
    (get-object-url storage object nil))
   ([storage object options]
-   (us/assert! ::storage storage)
+   (assert (valid-storage? storage))
    (when (or (nil? (:expired-at object))
              (dt/is-after? (:expired-at object) (dt/now)))
      (-> (impl/resolve-backend storage (:backend object))
@@ -260,7 +262,7 @@
   "Get the Path to the object. Only works with `:fs` type of
   storages."
   [storage object]
-  (us/assert! ::storage storage)
+  (assert (valid-storage? storage))
   (let [backend (impl/resolve-backend storage (:backend object))]
     (when (and (= :fs (::type backend))
                (or (nil? (:expired-at object))
@@ -269,7 +271,7 @@
 
 (defn del-object!
   [{:keys [::db/connectable] :as storage} object-or-id]
-  (us/assert! ::storage storage)
+  (assert (valid-storage? storage))
   (let [id  (if (impl/object? object-or-id) (:id object-or-id) object-or-id)
         res (db/update! connectable :storage-object
                         {:deleted-at (dt/now)}
@@ -282,6 +284,7 @@
 
 (defn configure
   [storage connectable]
+  (assert (valid-storage? storage))
   (assoc storage ::db/connectable connectable))
 
 (defn resolve

backend/src/app/storage/fs.clj

@@ -7,11 +7,10 @@
 (ns app.storage.fs
   (:require
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uri :as u]
    [app.storage :as-alias sto]
    [app.storage.impl :as impl]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.fs :as fs]
    [datoteka.io :as io]
@@ -26,10 +25,10 @@
 
 ;; --- BACKEND INIT
 
-(s/def ::directory ::us/string)
+(defmethod ig/assert-key ::backend
-
+  [_ params]
-(defmethod ig/pre-init-spec ::backend [_]
+  ;; FIXME:  path (?)
-  (s/keys :opt [::directory]))
+  (assert (string? (::directory params))))
 
 (defmethod ig/init-key ::backend
   [_ cfg]
@@ -42,18 +41,22 @@
              ::directory (str dir)
              ::uri (u/uri (str "file://" dir))))))
 
-(s/def ::uri u/uri?)
+(def ^:private schema:backend
-(s/def ::backend
+  [:map {:title "fs-backend"}
-  (s/keys :req [::directory
+   [::directory :string]
-                ::uri]
+   [::uri ::sm/uri]
-          :opt [::sto/type
+   [::sto/type [:= :fs]]])
-                ::sto/id]))
+
+(sm/register! ::backend schema:backend)
+
+(def ^:private valid-backend?
+  (sm/validator schema:backend))
 
 ;; --- API IMPL
 
 (defmethod impl/put-object :fs
   [backend {:keys [id] :as object} content]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (let [base (fs/path (::directory backend))
         path (fs/path (impl/id->path id))
         full (fs/normalize (fs/join base path))]
@@ -69,7 +72,7 @@
 
 (defmethod impl/get-object-data :fs
   [backend {:keys [id] :as object}]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (let [^Path base (fs/path (::directory backend))
         ^Path path (fs/path (impl/id->path id))
         ^Path full (fs/normalize (fs/join base path))]
@@ -86,7 +89,7 @@
 
 (defmethod impl/get-object-url :fs
   [{:keys [::uri] :as backend} {:keys [id] :as object} _]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (update uri :path
           (fn [existing]
             (if (str/ends-with? existing "/")
@@ -95,7 +98,7 @@
 
 (defmethod impl/del-object :fs
   [backend {:keys [id] :as object}]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (let [base (fs/path (::directory backend))
         path (fs/path (impl/id->path id))
         path (fs/join base path)]
@@ -103,7 +106,7 @@
 
 (defmethod impl/del-objects-in-bulk :fs
   [backend ids]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (let [base (fs/path (::directory backend))]
     (doseq [id ids]
       (let [path (fs/path (impl/id->path id))

backend/src/app/storage/gc_deleted.clj

@@ -16,10 +16,9 @@
    [app.common.data :as d]
    [app.common.logging :as l]
    [app.db :as db]
-   [app.storage :as-alias sto]
+   [app.storage :as sto]
    [app.storage.impl :as impl]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private sql:lock-sobjects
@@ -100,13 +99,14 @@
           0
           (get-buckets conn min-age)))
 
+(defmethod ig/assert-key ::handler
+  [_ params]
+  (assert (sto/valid-storage? (::sto/storage params)) "expect valid storage")
+  (assert (db/pool? (::db/pool params)) "expect valid storage"))
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/expand-key ::handler
-  (s/keys :req [::sto/storage ::db/pool]))
+  [k v]
-
+  {k (assoc v ::min-age (dt/duration {:hours 2}))})
-(defmethod ig/prep-key ::handler
-  [_ cfg]
-  (assoc cfg ::min-age (dt/duration {:hours 2})))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::min-age] :as cfg}]

backend/src/app/storage/gc_touched.clj

@@ -25,7 +25,6 @@
    [app.db :as db]
    [app.storage :as-alias sto]
    [app.storage.impl :as impl]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private sql:has-team-font-variant-refs
@@ -226,8 +225,9 @@
 ;; HANDLER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expect valid storage"))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/storage/impl.clj

@@ -14,7 +14,6 @@
    [buddy.core.codecs :as bc]
    [buddy.core.hash :as bh]
    [clojure.java.io :as jio]
-   [clojure.spec.alpha :as s]
    [datoteka.io :as io])
   (:import
    java.nio.ByteBuffer
@@ -234,7 +233,3 @@
   [v]
   (satisfies? IContentObject v))
 
-(s/def ::object object?)
-(s/def ::content content?)
-
-

backend/src/app/storage/s3.clj

@@ -11,7 +11,7 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uri :as u]
    [app.storage :as-alias sto]
    [app.storage.impl :as impl]
@@ -19,7 +19,6 @@
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
    [clojure.java.io :as io]
-   [clojure.spec.alpha :as s]
    [datoteka.fs :as fs]
    [integrant.core :as ig]
    [promesa.core :as p]
@@ -86,61 +85,68 @@
 
 ;; --- BACKEND INIT
 
-(s/def ::region ::us/keyword)
+(def ^:private schema:config
-(s/def ::bucket ::us/string)
+  [:map {:title "s3-backend-config"}
-(s/def ::prefix ::us/string)
+   ::wrk/executor
-(s/def ::endpoint ::us/string)
+   [::region {:optional true} :keyword]
-(s/def ::io-threads ::us/integer)
+   [::bucket {:optional true} ::sm/text]
+   [::prefix {:optional true} ::sm/text]
+   [::endpoint {:optional true} ::sm/uri]
+   [::io-threads {:optional true} ::sm/int]])
 
-(defmethod ig/pre-init-spec ::backend [_]
+(defmethod ig/expand-key ::backend
-  (s/keys :opt [::region ::bucket ::prefix ::endpoint ::io-threads ::wrk/executor]))
+  [k v]
+  {k (merge {::region :eu-central-1} (d/without-nils v))})
 
-(defmethod ig/prep-key ::backend
+(defmethod ig/assert-key ::backend
-  [_ {:keys [::prefix ::region] :as cfg}]
+  [_ params]
-  (cond-> (d/without-nils cfg)
+  (assert (sm/check schema:config params)))
-    (some? prefix) (assoc ::prefix prefix)
-    (nil? region)  (assoc ::region :eu-central-1)))
 
 (defmethod ig/init-key ::backend
-  [_ cfg]
+  [_ params]
-  ;; Return a valid backend data structure only if all optional
+  (when (and (contains? params ::region)
-  ;; parameters are provided.
+             (contains? params ::bucket))
-  (when (and (contains? cfg ::region)
+    (let [client    (build-s3-client params)
-             (string? (::bucket cfg)))
+          presigner (build-s3-presigner params)]
-    (let [client    (build-s3-client cfg)
+      (assoc params
-          presigner (build-s3-presigner cfg)]
-      (assoc cfg
              ::sto/type :s3
              ::client @client
              ::presigner presigner
              ::close-fn #(.close ^java.lang.AutoCloseable client)))))
 
+(defmethod ig/resolve-key ::backend
+  [_ params]
+  (dissoc params ::close-fn))
+
 (defmethod ig/halt-key! ::backend
   [_ {:keys [::close-fn]}]
   (when (fn? close-fn)
     (px/run! close-fn)))
 
-(s/def ::client #(instance? S3AsyncClient %))
+(def ^:private schema:backend
-(s/def ::presigner #(instance? S3Presigner %))
+  [:map {:title "s3-backend"}
-(s/def ::backend
+   ;; [::region :keyword]
-  (s/keys :req [::region
+   ;; [::bucket ::sm/text]
-                ::bucket
+   [::client [:fn #(instance? S3AsyncClient %)]]
-                ::client
+   [::presigner [:fn #(instance? S3Presigner %)]]
-                ::presigner]
+   [::prefix {:optional true} ::sm/text]
-          :opt [::prefix
+   #_[::sto/type [:= :s3]]])
-                ::sto/id]))
+
+(sm/register! ::backend schema:backend)
+
+(def ^:private valid-backend?
+  (sm/validator schema:backend))
 
 ;; --- API IMPL
 
 (defmethod impl/put-object :s3
   [backend object content]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (p/await! (put-object backend object content)))
 
 (defmethod impl/get-object-data :s3
   [backend object]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
-
   (loop [result (get-object-data backend object)
          retryn 0]
 
@@ -167,22 +173,21 @@
 
 (defmethod impl/get-object-bytes :s3
   [backend object]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (p/await! (get-object-bytes backend object)))
 
 (defmethod impl/get-object-url :s3
   [backend object options]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (get-object-url backend object options))
 
 (defmethod impl/del-object :s3
   [backend object]
-  (us/assert! ::backend backend)
   (p/await! (del-object backend object)))
 
 (defmethod impl/del-objects-in-bulk :s3
   [backend ids]
-  (us/assert! ::backend backend)
+  (assert (valid-backend? backend) "expected a valid backend instance")
   (p/await! (del-object-in-bulk backend ids)))
 
 ;; --- HELPERS
@@ -221,7 +226,7 @@
                        builder (.region ^S3AsyncClientBuilder builder (lookup-region region))
                        builder (cond-> ^S3AsyncClientBuilder builder
                                  (some? endpoint)
-                                 (.endpointOverride (URI. endpoint)))]
+                                 (.endpointOverride (URI. (str endpoint))))]
                    (.build ^S3AsyncClientBuilder builder))]
 
     (reify
@@ -240,7 +245,7 @@
                    (.build))]
 
     (-> (S3Presigner/builder)
-        (cond-> (some? endpoint) (.endpointOverride (URI. endpoint)))
+        (cond-> (some? endpoint) (.endpointOverride (URI. (str endpoint))))
         (.region (lookup-region region))
         (.serviceConfiguration ^S3Configuration config)
         (.build))))
@@ -337,7 +342,8 @@
 
 (defn- get-object-url
   [{:keys [::presigner ::bucket ::prefix]} {:keys [id]} {:keys [max-age] :or {max-age default-max-age}}]
-  (us/assert dt/duration? max-age)
+  (assert (dt/duration? max-age) "expected valid duration instance")
+
   (let [gor  (.. (GetObjectRequest/builder)
                  (bucket bucket)
                  (key (dm/str prefix (impl/id->path id)))

backend/src/app/storage/tmp.clj

@@ -11,10 +11,10 @@
   permanently delete these files (look at systemd-tempfiles)."
   (:require
    [app.common.logging :as l]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
    [datoteka.fs :as fs]
    [integrant.core :as ig]
    [promesa.exec :as px]
@@ -29,12 +29,13 @@
 
 (defonce queue (sp/chan :buf 128))
 
-(defmethod ig/pre-init-spec ::cleaner [_]
+(defmethod ig/assert-key ::cleaner
-  (s/keys :req [::wrk/executor]))
+  [_ {:keys [::wrk/executor]}]
+  (assert (sm/valid? ::wrk/executor executor)))
 
-(defmethod ig/prep-key ::cleaner
+(defmethod ig/expand-key ::cleaner
-  [_ cfg]
+  [k v]
-  (assoc cfg ::min-age (dt/duration "60m")))
+  {k (assoc v ::min-age (dt/duration "60m"))})
 
 (defmethod ig/init-key ::cleaner
   [_ cfg]

backend/src/app/tasks/delete_object.clj

@@ -12,7 +12,6 @@
    [app.rpc.commands.files :as files]
    [app.rpc.commands.profile :as profile]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:dynamic *team-deletion* false)
@@ -113,8 +112,9 @@
   [_cfg props]
   (l/wrn :hint "not implementation found" :rel (:object props)))
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool"))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/tasks/file_gc.clj

@@ -27,7 +27,6 @@
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.set :as set]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (declare ^:private get-file)
@@ -315,8 +314,10 @@
 ;; HANDLER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool ::sto/storage]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool")
+  (assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided"))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/tasks/file_gc_scheduler.clj

@@ -12,7 +12,6 @@
    [app.db :as db]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private
@@ -43,12 +42,13 @@
 
     {:processed total}))
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool"))
 
-(defmethod ig/prep-key ::handler
+(defmethod ig/expand-key ::handler
-  [_ cfg]
+  [k v]
-  (assoc cfg ::min-age (cf/get-deletion-delay)))
+  {k (assoc v ::min-age (cf/get-deletion-delay))})
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/tasks/file_xlog_gc.clj

@@ -9,7 +9,6 @@
    [app.common.logging :as l]
    [app.config :as cf]
    [app.db :as db]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 ;; Get the latest available snapshots without exceeding the total
@@ -51,8 +50,9 @@
              :current (count snapshots)
              :deleted (db/get-update-count result)))))
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool"))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/tasks/objects_gc.clj

@@ -13,7 +13,6 @@
    [app.db :as db]
    [app.storage :as sto]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private sql:get-profiles
@@ -318,14 +317,16 @@
         (recur (+ total result))
         total))))
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool ::sto/storage]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool")
+  (assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided"))
 
-(defmethod ig/prep-key ::handler
+(defmethod ig/expand-key ::handler
-  [_ cfg]
+  [k v]
-  (assoc cfg
+  {k (assoc v
             ::min-age (cf/get-deletion-delay)
-         ::chunk-size 50))
+            ::chunk-size 50)})
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/tasks/offload_file_data.clj

@@ -13,7 +13,6 @@
    [app.db :as db]
    [app.db.sql :as-alias sql]
    [app.storage :as sto]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (defn- offload-file-data!
@@ -109,8 +108,10 @@
 ;; HANDLER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool ::sto/storage]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool")
+  (assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided"))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/tasks/tasks_gc.clj

@@ -11,19 +11,19 @@
    [app.common.logging :as l]
    [app.config :as cf]
    [app.db :as db]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private
   sql:delete-completed-tasks
   "DELETE FROM task WHERE scheduled_at < now() - ?::interval")
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::db/pool]))
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool"))
 
-(defmethod ig/prep-key ::handler
+(defmethod ig/expand-key ::handler
-  [_ cfg]
+  [k v]
-  (assoc cfg ::min-age (cf/get-deletion-delay)))
+  {k (assoc v ::min-age (cf/get-deletion-delay))})
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::db/pool ::min-age] :as cfg}]

backend/src/app/tasks/telemetry.clj

@@ -17,7 +17,6 @@
    [app.main :as-alias main]
    [app.setup :as-alias setup]
    [app.util.json :as json]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.exec :as px]))
 
@@ -205,10 +204,11 @@
 ;; TASK ENTRY POINT
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/pre-init-spec ::handler [_]
+(defmethod ig/assert-key ::handler
-  (s/keys :req [::http/client
+  [_ params]
-                ::db/pool
+  (assert (http/client? (::http/client params)) "expected a valid http client")
-                ::setup/props]))
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool")
+  (assert (some? (::setup/props params)) "expected setup props to be available"))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::db/pool ::setup/props] :as cfg}]

backend/src/app/util/cache.clj

@@ -8,6 +8,7 @@
   "In-memory cache backed by Caffeine"
   (:refer-clojure :exclude [get])
   (:require
+   [app.common.schema :as sm]
    [app.util.time :as dt]
    [promesa.exec :as px])
   (:import
@@ -77,3 +78,9 @@
 (defn cache?
   [o]
   (satisfies? ICache o))
+
+(sm/register!
+ {:type ::cache
+  :pred cache?
+  :type-properties
+  {:title "cache instance"}})

backend/src/app/util/overrides.clj

@@ -25,7 +25,7 @@
                clojure.lang.IPersistentMap
                clojure.lang.IDeref)
 
-(sm/register! ::fs/path
+(sm/register!
  {:type ::fs/path
   :pred fs/path?
   :type-properties

backend/src/app/util/time.clj

@@ -158,6 +158,7 @@
      :iso8601 (Instant/from (.parse DateTimeFormatter/ISO_INSTANT ^String s)))))
 
 (defn is-after?
+  "Analgous to: da > db"
   [da db]
   (.isAfter ^Instant da ^Instant db))
 
@@ -369,7 +370,7 @@
   (let [p1 (System/nanoTime)]
     #(duration {:nanos (- (System/nanoTime) p1)})))
 
-(sm/register! ::instant
+(sm/register!
  {:type ::instant
   :pred instant?
   :type-properties
@@ -383,8 +384,8 @@
    ::oapi/type "string"
    ::oapi/format "iso"}})
 
-(sm/register! ::duration
+(sm/register!
-  {:type :durations
+ {:type ::duration
   :pred duration?
   :type-properties
   {:error/message "should be a duration"

backend/src/app/worker.clj

@@ -8,16 +8,13 @@
   "Async tasks abstraction (impl)."
   (:require
    [app.common.data :as d]
-   [app.common.data.macros :as dm]
    [app.common.logging :as l]
    [app.common.schema :as sm]
-   [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.metrics :as mtx]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]))
 
@@ -27,6 +24,9 @@
 ;; TASKS REGISTRY
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defprotocol IRegistry
+  (get-task [_ name]))
+
 (defn- wrap-with-metrics
   [f metrics tname]
   (let [labels (into-array String [tname])]
@@ -40,21 +40,37 @@
                        :val (inst-ms (tp))
                        :labels labels})))))))
 
-(s/def ::registry (s/map-of ::us/string fn?))
+(def ^:private schema:tasks
-(s/def ::tasks (s/map-of keyword? fn?))
+  [:map-of :keyword ::sm/fn])
 
-(defmethod ig/pre-init-spec ::registry [_]
+(def ^:private valid-tasks?
-  (s/keys :req [::mtx/metrics ::tasks]))
+  (sm/validator schema:tasks))
+
+(defmethod ig/assert-key ::registry
+  [_ params]
+  (assert (mtx/metrics? (::mtx/metrics params)) "expected valid metrics instance")
+  (assert (valid-tasks? (::tasks params)) "expected a valid map of tasks"))
 
 (defmethod ig/init-key ::registry
   [_ {:keys [::mtx/metrics ::tasks]}]
   (l/inf :hint "registry initialized" :tasks (count tasks))
-  (reduce-kv (fn [registry k f]
+  (let [tasks (reduce-kv (fn [registry k f]
                            (let [tname (name k)]
                              (l/trc :hint "register task" :name tname)
                              (assoc registry tname (wrap-with-metrics f metrics tname))))
                          {}
-             tasks))
+                         tasks)]
+    (reify
+      clojure.lang.Counted
+      (count [_] (count tasks))
+
+      IRegistry
+      (get-task [_ name]
+        (get tasks (d/name name))))))
+
+(sm/register!
+ {:type ::registry
+  :pred #(satisfies? IRegistry %)})
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SUBMIT API
@@ -124,5 +140,6 @@
   [{:keys [::task ::params] :as cfg}]
   (assert (contains? cfg :app.worker/registry)
           "missing worker registry on `cfg`")
-  (let [task-fn (dm/get-in cfg [:app.worker/registry (name task)])]
+  (let [registry (get cfg ::registry)
+        task-fn  (get-task registry task)]
     (task-fn {:props params})))

backend/src/app/worker/cron.clj

@@ -9,11 +9,11 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
+   [app.common.schema :as sm]
    [app.db :as db]
    [app.util.time :as dt]
-   [app.worker :as-alias wrk]
+   [app.worker :as wrk]
    [app.worker.runner :refer [get-error-context]]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.core :as p]
@@ -82,7 +82,7 @@
 
 (defn- ms-until-valid
   [cron]
-  (s/assert dt/cron? cron)
+  (assert (dt/cron? cron) "expected cron instance")
   (let [now  (dt/now)
         next (dt/next-valid-instant-from cron now)]
     (dt/diff now next)))
@@ -98,21 +98,22 @@
 
     (swap! running #(into #{ft} (filter p/pending?) %))))
 
+(def ^:private schema:params
+  [:map
+   [::wrk/entries
+    [:vector
+     [:maybe
+      [:map
+       [:cron [:fn dt/cron?]]
+       [:task :keyword]
+       [:props {:optional true} :map]
+       [:id {:optional true} :keyword]]]]]
+   ::wrk/registry
+   ::db/pool])
 
-(s/def ::fn (s/or :var var? :fn fn?))
+(defmethod ig/assert-key ::wrk/cron
-(s/def ::id keyword?)
+  [_ params]
-(s/def ::cron dt/cron?)
+  (assert (sm/check schema:params params)))
-(s/def ::props (s/nilable map?))
-(s/def ::task keyword?)
-
-(s/def ::task-item
-  (s/keys :req-un [::cron ::task]
-          :opt-un [::props ::id]))
-
-(s/def ::wrk/entries (s/coll-of (s/nilable ::task-item)))
-
-(defmethod ig/pre-init-spec ::wrk/cron [_]
-  (s/keys :req [::db/pool ::wrk/entries ::wrk/registry]))
 
 (defmethod ig/init-key ::wrk/cron
   [_ {:keys [::wrk/entries ::wrk/registry ::db/pool] :as cfg}]
@@ -129,7 +130,7 @@
                        (map (fn [item]
                               (update item :task d/name)))
                        (map (fn [{:keys [task] :as item}]
-                              (let [f (get registry task)]
+                              (let [f (wrk/get-task registry task)]
                                 (when-not f
                                   (ex/raise :type :internal
                                             :code :task-not-found

backend/src/app/worker/dispatcher.clj

@@ -9,28 +9,36 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.logging :as l]
+   [app.common.schema :as sm]
    [app.common.transit :as t]
-   [app.config :as cf]
    [app.db :as db]
    [app.metrics :as mtx]
    [app.redis :as rds]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.exec :as px]))
 
 (set! *warn-on-reflection* true)
 
-(defmethod ig/pre-init-spec ::wrk/dispatcher [_]
+(def ^:private schema:dispatcher
-  (s/keys :req [::mtx/metrics ::db/pool ::rds/redis]))
+  [:map
+   [::wrk/tenant ::sm/text]
+   ::mtx/metrics
+   ::db/pool
+   ::rds/redis])
 
-(defmethod ig/prep-key ::wrk/dispatcher
+(defmethod ig/expand-key ::wrk/dispatcher
+  [k v]
+  {k (-> (d/without-nils v)
+         (assoc ::timeout (dt/duration "10s"))
+         (assoc ::batch-size 100)
+         (assoc ::wait-duration (dt/duration "5s")))})
+
+(defmethod ig/assert-key ::wrk/dispatcher
   [_ cfg]
-  (merge {::batch-size 100
+  (assert (sm/check schema:dispatcher cfg)))
-          ::wait-duration (dt/duration "5s")}
-         (d/without-nils cfg)))
 
 (def ^:private sql:select-next-tasks
   "select id, queue from task as t
@@ -42,15 +50,15 @@
       for update skip locked")
 
 (defmethod ig/init-key ::wrk/dispatcher
-  [_ {:keys [::db/pool ::rds/redis ::batch-size] :as cfg}]
+  [_ {:keys [::db/pool ::rds/redis ::wrk/tenant ::batch-size ::timeout] :as cfg}]
   (letfn [(get-tasks [conn]
-            (let [prefix (str (cf/get :tenant) ":%")]
+            (let [prefix (str tenant ":%")]
               (seq (db/exec! conn [sql:select-next-tasks prefix batch-size]))))
 
           (push-tasks! [conn rconn [queue tasks]]
             (let [ids (mapv :id tasks)
                   key (str/ffmt "taskq:%" queue)
-                  res (rds/rpush! rconn key (mapv t/encode ids))
+                  res (rds/rpush rconn key (mapv t/encode ids))
                   sql [(str "update task set status = 'scheduled'"
                             " where id = ANY(?)")
                        (db/create-array conn "uuid" ids)]]
@@ -75,17 +83,17 @@
                   (rds/exception? cause)
                   (do
                     (l/wrn :hint "redis exception (will retry in an instant)" :cause cause)
-                    (px/sleep (::rds/timeout rconn)))
+                    (px/sleep timeout))
 
                   (db/sql-exception? cause)
                   (do
                     (l/wrn :hint "database exception (will retry in an instant)" :cause cause)
-                    (px/sleep (::rds/timeout rconn)))
+                    (px/sleep timeout))
 
                   :else
                   (do
                     (l/err :hint "unhandled exception (will retry in an instant)" :cause cause)
-                    (px/sleep (::rds/timeout rconn)))))))
+                    (px/sleep timeout))))))
 
           (dispatcher []
             (l/inf :hint "started")

backend/src/app/worker/executor.clj

@@ -9,11 +9,10 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.metrics :as mtx]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
-   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.exec :as px])
   (:import
@@ -21,15 +20,17 @@
 
 (set! *warn-on-reflection* true)
 
-(s/def ::wrk/executor #(instance? ThreadPoolExecutor %))
+(sm/register!
+ {:type ::wrk/executor
+  :pred #(instance? ThreadPoolExecutor %)
+  :type-properties
+  {:title "executor"
+   :description "Instance of ThreadPoolExecutor"}})
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; EXECUTOR
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/pre-init-spec ::wrk/executor [_]
-  (s/keys :req []))
-
 (defmethod ig/init-key ::wrk/executor
   [_ _]
   (let [factory  (px/thread-factory :prefix "penpot/default/")
@@ -51,15 +52,10 @@
    :running (.getActiveCount ^ThreadPoolExecutor executor)
    :completed (.getCompletedTaskCount ^ThreadPoolExecutor executor)})
 
-(s/def ::name ::us/keyword)
+(defmethod ig/expand-key ::wrk/monitor
-
+  [k v]
-(defmethod ig/pre-init-spec ::wrk/monitor [_]
+  {k (-> (d/without-nils v)
-  (s/keys :req [::wrk/name ::wrk/executor ::mtx/metrics]))
+         (assoc ::interval (dt/duration "2s")))})
-
-(defmethod ig/prep-key ::wrk/monitor
-  [_ cfg]
-  (merge {::interval (dt/duration "2s")}
-         (d/without-nils cfg)))
 
 (defmethod ig/init-key ::wrk/monitor
   [_ {:keys [::wrk/executor ::mtx/metrics ::interval ::wrk/name]}]

backend/src/app/worker/runner.clj

@@ -11,14 +11,13 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
+   [app.common.schema :as sm]
    [app.common.transit :as t]
-   [app.config :as cf]
    [app.db :as db]
    [app.metrics :as mtx]
    [app.redis :as rds]
    [app.util.time :as dt]
-   [app.worker :as-alias wrk]
+   [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.exec :as px]))
@@ -51,7 +50,7 @@
            :runner-id id
            :retry (:retry-num task))
     (let [tpoint  (dt/tpoint)
-          task-fn (get registry (:name task))
+          task-fn (wrk/get-task registry (:name task))
           result  (if task-fn
                     (task-fn task)
                     {:status :completed :task task})
@@ -92,7 +91,7 @@
               {:status :retry :task task :error cause})))))))
 
 (defn- run-task!
-  [{:keys [::rds/rconn ::id] :as cfg} task-id]
+  [{:keys [::id ::timeout] :as cfg} task-id]
   (loop [task (get-task cfg task-id)]
     (cond
       (ex/exception? task)
@@ -102,13 +101,13 @@
           (l/wrn :hint "connection error on retrieving task from database (retrying in some instants)"
                  :id id
                  :cause task)
-          (px/sleep (::rds/timeout rconn))
+          (px/sleep timeout)
           (recur (get-task cfg task-id)))
         (do
           (l/err :hint "unhandled exception on retrieving task from database (retrying in some instants)"
                  :id id
                  :cause task)
-          (px/sleep (::rds/timeout rconn))
+          (px/sleep timeout)
           (recur (get-task cfg task-id))))
 
       (nil? task)
@@ -182,17 +181,17 @@
                   (do
                     (l/wrn :hint "database exeption on processing task result (retrying in some instants)"
                            :cause cause)
-                    (px/sleep (::rds/timeout rconn))
+                    (px/sleep timeout)
                     (recur result))
                   (do
                     (l/err :hint "unhandled exception on processing task result (retrying in some instants)"
                            :cause cause)
-                    (px/sleep (::rds/timeout rconn))
+                    (px/sleep timeout)
                     (recur result))))))]
 
     (try
-      (let [queue       (str/ffmt "taskq:%" queue)
+      (let [key       (str/ffmt "taskq:%" queue)
-            [_ payload] (rds/blpop! rconn timeout queue)]
+            [_ payload] (rds/blpop rconn timeout [key])]
         (some-> payload
                 decode-payload
                 run-task-loop))
@@ -211,16 +210,15 @@
           (l/err :hint "unhandled exception" :cause cause))))))
 
 (defn- start-thread!
-  [{:keys [::rds/redis ::id ::queue] :as cfg}]
+  [{:keys [::rds/redis ::id ::queue ::wrk/tenant] :as cfg}]
   (px/thread
     {:name (format "penpot/worker/runner:%s" id)}
     (l/inf :hint "started" :id id :queue queue)
     (try
       (dm/with-open [rconn (rds/connect redis)]
-        (let [tenant (cf/get :tenant "main")
+        (let [cfg    (-> cfg
-              cfg    (-> cfg
-                         (assoc ::queue (str/ffmt "%:%" tenant queue))
                          (assoc ::rds/rconn rconn)
+                         (assoc ::queue (str/ffmt "%:%" tenant queue))
                          (assoc ::timeout (dt/duration "5s")))]
           (loop []
             (when (px/interrupted?)
@@ -243,20 +241,23 @@
                :id id
                :queue queue)))))
 
-(s/def ::wrk/queue keyword?)
+(def ^:private schema:params
-
+  [:map
-(defmethod ig/pre-init-spec ::runner [_]
+   [::wrk/parallelism {:optional true} ::sm/int]
-  (s/keys :req [::wrk/parallelism
+   [::wrk/queue :keyword]
+   [::wrk/tenant ::sm/text]
+   ::wrk/registry
    ::mtx/metrics
    ::db/pool
-                ::rds/redis
+   ::rds/redis])
-                ::wrk/queue
-                ::wrk/registry]))
 
-(defmethod ig/prep-key ::wrk/runner
+(defmethod ig/assert-key ::wrk/runner
-  [_ cfg]
+  [_ params]
-  (merge {::wrk/parallelism 1}
+  (assert (sm/check schema:params params)))
-         (d/without-nils cfg)))
+
+(defmethod ig/expand-key ::wrk/runner
+  [k v]
+  {k (merge {::wrk/parallelism 1} (d/without-nils v))})
 
 (defmethod ig/init-key ::wrk/runner
   [_ {:keys [::db/pool ::wrk/queue ::wrk/parallelism] :as cfg}]

backend/test/backend_tests/helpers.clj

@@ -123,7 +123,7 @@
                              [:app.main/default :app.worker/runner]
                              [:app.main/webhook :app.worker/runner]))
           _      (ig/load-namespaces system)
-          system (-> (ig/prep system)
+          system (-> (ig/expand system)
                      (ig/init))]
       (try
         (binding [*system* system
@@ -400,7 +400,11 @@
   (db/tx-run! *system* (fn [{:keys [::db/conn] :as cfg}]
                          (let [tasks (->> (db/exec! conn [sql:pending-tasks])
                                           (map #'app.worker.runner/decode-task-row))]
-                           (run! (partial #'app.worker.runner/run-task cfg) tasks)))))
+                           (doseq [task tasks]
+                             (let [cfg (-> cfg
+                                           (assoc :app.worker.runner/queue (:queue task))
+                                           (assoc :app.worker.runner/id 0))]
+                               (#'app.worker.runner/run-task cfg task)))))))
 
 ;; --- UTILS
 

backend/test/backend_tests/storage_test.clj

@@ -27,12 +27,8 @@
 (defn configure-storage-backend
   "Given storage map, returns a storage configured with the appropriate
   backend for assets."
-  ([storage]
+  [storage]
-   (assoc storage ::sto/backend :assets-fs))
+  (assoc storage ::sto/backend :fs))
-  ([storage conn]
-   (-> storage
-       (assoc ::db/pool-or-conn conn)
-       (assoc ::sto/backend :assets-fs))))
 
 (t/deftest put-and-retrieve-object
   (let [storage (-> (:app.storage/storage th/*system*)
@@ -46,7 +42,7 @@
     (t/is (fs/path? (sto/get-object-path storage object)))
 
     (t/is (nil? (:expired-at object)))
-    (t/is (= :assets-fs (:backend object)))
+    (t/is (= :fs (:backend object)))
     (t/is (= "data" (:other (meta object))))
     (t/is (= "text/plain" (:content-type (meta object))))
     (t/is (= "content" (slurp (sto/get-object-data storage object))))
@@ -91,12 +87,13 @@
     ;; marked as deleted/expired.
     (t/is (nil? (sto/get-object storage (:id object))))))
 
-(t/deftest test-deleted-gc-task
+(t/deftest deleted-gc-task
   (let [storage (-> (:app.storage/storage th/*system*)
                     (configure-storage-backend))
         content1 (sto/content "content1")
         content2 (sto/content "content2")
         content3 (sto/content "content3")
+
         object1  (sto/put-object! storage {::sto/content content1
                                            ::sto/expired-at (dt/now)
                                            :content-type "text/plain"})
@@ -116,7 +113,7 @@
     (let [res (th/db-exec-one! ["select count(*) from storage_object;"])]
       (t/is (= 2 (:count res))))))
 
-(t/deftest test-touched-gc-task-1
+(t/deftest touched-gc-task-1
   (let [storage (-> (:app.storage/storage th/*system*)
                     (configure-storage-backend))
         prof    (th/create-profile* 1)
@@ -186,7 +183,7 @@
         (t/is (= 0 (:count res)))))))
 
 
-(t/deftest test-touched-gc-task-2
+(t/deftest touched-gc-task-2
   (let [storage (-> (:app.storage/storage th/*system*)
                     (configure-storage-backend))
         prof    (th/create-profile* 1 {:is-active true})
@@ -265,7 +262,7 @@
         (let [res (th/db-exec-one! ["select count(*) from storage_object where deleted_at is not null"])]
           (t/is (= 3 (:count res))))))))
 
-(t/deftest test-touched-gc-task-3
+(t/deftest touched-gc-task-3
   (let [storage (-> (:app.storage/storage th/*system*)
                     (configure-storage-backend))
         prof    (th/create-profile* 1)

common/deps.edn

@@ -25,7 +25,7 @@
   com.cognitect/transit-clj {:mvn/version "1.0.333"}
   com.cognitect/transit-cljs {:mvn/version "0.8.280"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
-  integrant/integrant {:mvn/version "0.8.1"}
+  integrant/integrant {:mvn/version "0.13.1"}
 
   funcool/tubax {:mvn/version "2021.05.20-0"}
   funcool/cuerdas {:mvn/version "2023.11.09-407"}

common/package.json

@@ -1,11 +1,11 @@
 {
   "name": "common",
   "version": "1.0.0",
-  "main": "index.js",
   "license": "MPL-2.0",
   "author": "Kaleidos INC",
   "private": true,
   "packageManager": "yarn@4.3.1",
+  "type": "module",
   "repository": {
     "type": "git",
     "url": "https://github.com/penpot/penpot"
@@ -15,6 +15,8 @@
     "sax": "^1.4.1"
   },
   "devDependencies": {
+    "concurrently": "^9.0.1",
+    "nodemon": "^3.1.7",
     "shadow-cljs": "2.28.18",
     "source-map-support": "^0.5.21",
     "ws": "^8.17.0"
@@ -23,9 +25,9 @@
     "fmt:clj:check": "cljfmt check --parallel=false src/ test/",
     "fmt:clj": "cljfmt fix --parallel=true src/ test/",
     "lint:clj": "clj-kondo --parallel=true --lint src/",
-    "test:watch": "clojure -M:dev:shadow-cljs watch test",
+    "lint": "yarn run lint:clj",
-    "test:compile": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
+    "watch:test": "concurrently \"clojure -M:dev:shadow-cljs watch test\" \"nodemon -C -d 2 -w target/tests/ --exec 'node target/tests/test.js'\"",
-    "test:run": "node target/test.js",
+    "build:test": "clojure -M:dev:shadow-cljs compile test",
-    "test": "yarn run test:compile && yarn run test:run"
+    "test": "yarn run build:test && node target/tests/test.js"
   }
 }

common/shadow-cljs.edn

@@ -1,19 +1,15 @@
 {:deps {:aliases [:dev]}
  :builds
  {:test
-  {:target :node-test
+  {:target :esm
-   :output-to "target/test.js"
+   :output-dir "target/tests"
-   :output-dir "target/test/"
+   :runtime :node
-   :ns-regexp "^common-tests.*-test$"
+   :js-options {:js-provider :import}
-   :autorun true
 
-   :compiler-options
+
-   {:output-feature-set :es-next
+   :modules
-    :output-wrapper false
+   {:test {:init-fn common-tests.runner/-main
-    :source-map true
+           :prepend-js "globalThis.navigator = {userAgent: \"\"}"}}}
-    :source-map-include-sources-content true
-    :source-map-detail-level :all
-    :warnings {:fn-deprecated false}}}
 
   :bench
   {:target :node-script

common/src/app/common/colors.cljc

@@ -478,3 +478,63 @@
         a (+ (* ah 100) (* av 10))
         b (+ (* bh 100) (* bv 10))]
     (compare a b)))
+
+(defn interpolate-color
+  [c1 c2 offset]
+  (cond
+    (<= offset (:offset c1)) (assoc c1 :offset offset)
+    (>= offset (:offset c2)) (assoc c2 :offset offset)
+
+    :else
+    (let [tr-offset (/ (- offset (:offset c1)) (- (:offset c2) (:offset c1)))
+          [r1 g1 b1] (hex->rgb (:color c1))
+          [r2 g2 b2] (hex->rgb (:color c2))
+          a1 (:opacity c1)
+          a2 (:opacity c2)
+          r (+ r1 (* (- r2 r1) tr-offset))
+          g (+ g1 (* (- g2 g1) tr-offset))
+          b (+ b1 (* (- b2 b1) tr-offset))
+          a (+ a1 (* (- a2 a1) tr-offset))]
+      {:color (rgb->hex [r g b])
+       :opacity a
+       :r r
+       :g g
+       :b b
+       :alpha a
+       :offset offset})))
+
+(defn- offset-spread
+  [from to num]
+  (->> (range 0 num)
+       (map #(mth/precision (+ from (* (/ (- to from) (dec num)) %)) 2))))
+
+(defn uniform-spread?
+  "Checks if the gradient stops are spread uniformly"
+  [stops]
+  (let [cs          (count stops)
+        from        (first stops)
+        to          (last stops)
+        expect-vals (offset-spread (:offset from) (:offset to) cs)
+
+        calculate-expected
+        (fn [expected-offset stop]
+          (and (mth/close? (:offset stop) expected-offset)
+               (let [ec (interpolate-color from to expected-offset)]
+                 (and (= (:color ec) (:color stop))
+                      (= (:opacity ec) (:opacity stop))))))]
+    (->> (map calculate-expected expect-vals stops)
+         (every? true?))))
+
+(defn uniform-spread
+  "Assign an uniform spread to the offset values for the gradient"
+  [from to num-stops]
+  (->> (offset-spread (:offset from) (:offset to) num-stops)
+       (mapv (fn [offset]
+               (interpolate-color from to offset)))))
+
+(defn interpolate-gradient
+  [stops offset]
+  (let [idx   (d/index-of-pred stops #(<= offset (:offset %)))
+        start (if (= idx 0) (first stops) (get stops (dec idx)))
+        end   (if (nil? idx) (last stops) (get stops idx))]
+    (interpolate-color start end offset)))

common/src/app/common/features.cljc

@@ -51,14 +51,16 @@
     "layout/grid"
     "plugins/runtime"
     "design-tokens/v1"
-    "text-editor/v2"})
+    "text-editor/v2"
+    "render-wasm/v1"})
 
 ;; A set of features enabled by default
 (def default-features
   #{"fdata/shape-data-type"
     "styles/v2"
     "layout/grid"
-    "components/v2"})
+    "components/v2"
+    "plugins/runtime"})
 
 ;; A set of features which only affects on frontend and can be enabled
 ;; and disabled freely by the user any time. This features does not
@@ -67,7 +69,8 @@
 (def frontend-only-features
   #{"styles/v2"
     "plugins/runtime"
-    "text-editor/v2"})
+    "text-editor/v2"
+    "render-wasm/v1"})
 
 ;; Features that are mainly backend only or there are a proper
 ;; fallback when frontend reports no support for it
@@ -84,12 +87,11 @@
         "fdata/pointer-map"
         "layout/grid"
         "fdata/shape-data-type"
-        "plugins/runtime"
+        "design-tokens/v1"}
-        "design-tokens/v1"
-        "text-editor/v2"}
       (into frontend-only-features)))
 
-(sm/register! ::features
+(sm/register!
+ ^{::sm/type ::features}
  [:schema
   {:title "FileFeatures"
    ::smdj/inline true
@@ -108,6 +110,7 @@
     :feature-plugins "plugins/runtime"
     :feature-design-tokens "design-tokens/v1"
     :feature-text-editor-v2 "text-editor/v2"
+    :feature-render-wasm "render-wasm/v1"
     nil))
 
 (defn migrate-legacy-features
@@ -152,6 +155,7 @@
         team-features    (into #{} xf-remove-ephimeral (:features team))]
     (-> enabled-features
         (set/intersection no-migration-features)
+        (set/difference frontend-only-features)
         (set/union team-features))))
 
 (defn check-client-features!

common/src/app/common/files/changes.cljc

@@ -550,7 +550,8 @@
    (when verify?
      (check-changes! items))
 
-   (binding [*touched-changes* (volatile! #{})]
+   (binding [*touched-changes* (volatile! #{})
+             cts/*wasm-sync* true]
      (let [result (reduce #(or (process-change %1 %2) %1) data items)
            result (reduce process-touched-change result @*touched-changes*)]
        ;; Validate result shapes (only on the backend)

common/src/app/common/files/changes_builder.cljc

@@ -25,7 +25,8 @@
 
 ;; Auxiliary functions to help create a set of changes (undo + redo)
 
-(sm/register! ::changes
+(sm/register!
+ ^{::sm/type ::changes}
  [:map {:title "changes"}
   [:redo-changes vector?]
   [:undo-changes seq?]

common/src/app/common/flags.cljc

@@ -12,6 +12,7 @@
 (def default
   "A common flags that affects both: backend and frontend."
   [:enable-registration
+   :enable-export-file-v3
    :enable-login-with-password])
 
 (defn parse

common/src/app/common/geom/point.cljc

@@ -87,7 +87,7 @@
 
 ;; FIXME: make like matrix
 (def schema:point
-  {:type :map
+  {:type ::point
    :pred valid-point?
    :type-properties
    {:title "point"
@@ -102,7 +102,7 @@
     :encode/json point->json
     :encode/string point->str}})
 
-(sm/register! ::point schema:point)
+(sm/register! schema:point)
 
 (defn point-like?
   [{:keys [x y] :as v}]

common/src/app/common/geom/shapes/points.cljc

@@ -74,7 +74,7 @@
        (-> p2 (gpt/add right-v) (gpt/add bottom-v))
        (-> p3 (gpt/add left-v)  (gpt/add bottom-v))])))
 
-(defn- project-t
+(defn project-t
   "Given a point and a line returns the parametric t the cross point with the line going through the other axis projected"
   [point [start end] other-axis-vec]
 

common/src/app/common/logging.cljc

@@ -48,9 +48,8 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.pprint :as pp]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [promesa.exec :as px]
    [promesa.util :as pu])
@@ -203,17 +202,19 @@
         (map vec)
         (remove (fn [[k _]] (contains? reserved-props k)))))
 
-(s/def ::id ::us/uuid)
+(def ^:private schema:record
-(s/def ::props any? #_d/ordered-map?)
+  [:map
-(s/def ::context (s/nilable (s/map-of keyword? any?)))
+   [::id ::sm/uuid]
-(s/def ::level #{:trace :debug :info :warn :error :fatal})
+   [::props :any]
-(s/def ::logger string?)
+   [::logger :string]
-(s/def ::timestamp ::us/integer)
+   [::timestamp ::sm/int]
-(s/def ::cause (s/nilable ex/exception?))
+   [::level [:enum :trace :debug :info :warn :error :fatal]]
-(s/def ::message delay?)
+   [::message [:fn delay?]]
-(s/def ::record
+   [::cause {:optional true} [:maybe [:fn ex/exception?]]]
-  (s/keys :req [::id ::props ::logger ::level]
+   [::context {:optional true} [:maybe [:map-of :keyword :any]]]])
-          :opt [::cause ::context]))
+
+(def valid-record?
+  (sm/validator schema:record))
 
 (defn current-timestamp
   []

common/src/app/common/logic/shapes.cljc

@@ -391,13 +391,14 @@
           (-> (pcb/update-shapes
                [parent-id]
                (fn [frame objects]
+                 (let [[row column] cell]
                    (-> frame
                        ;; Assign the cell when pushing into a specific grid cell
                        (cond-> (some? cell)
                          (-> (ctl/free-cell-shapes ids)
-                           (ctl/push-into-cell ids (:row cell) (:column cell))
+                             (ctl/push-into-cell ids row column)
                              (ctl/assign-cells objects)))
-                     (ctl/assign-cell-positions objects)))
+                       (ctl/assign-cell-positions objects))))
                {:with-objects? true})
               (pcb/reorder-grid-children [parent-id])))
 

common/src/app/common/schema.cljc

@@ -5,7 +5,7 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.common.schema
-  (:refer-clojure :exclude [deref merge parse-uuid parse-long parse-double parse-boolean])
+  (:refer-clojure :exclude [deref merge parse-uuid parse-long parse-double parse-boolean type])
   #?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
   (:require
    [app.common.data :as d]
@@ -38,6 +38,10 @@
   [o]
   (m/schema? o))
 
+(defn type
+  [s]
+  (m/-type s))
+
 (defn properties
   [s]
   (m/properties s))
@@ -52,12 +56,21 @@
 
 (defn schema
   [s]
-  (m/schema s default-options))
+  (if (schema? s)
+    s
+    (m/schema s default-options)))
 
 (defn validate
   [s value]
   (m/validate s value default-options))
 
+(defn valid?
+  [s value]
+  (try
+    (m/validate s value default-options)
+    (catch #?(:clj Throwable :cljs :default) _cause
+      false)))
+
 (defn explain
   [s value]
   (m/explain s value default-options))
@@ -178,7 +191,8 @@
 
 (defn lazy-validator
   [s]
-  (let [vfn (delay (validator (if (delay? s) (deref s) s)))]
+  (let [s   (schema s)
+        vfn (delay (validator s))]
     (fn [v] (@vfn v))))
 
 (defn lazy-explainer
@@ -236,7 +250,7 @@
   ([s] (lookup sr/default-registry s))
   ([registry s] (schema (mr/schema registry s))))
 
-(defn- fast-check!
+(defn- fast-check
   "A fast path for checking process, assumes the ILazySchema protocol
   implemented on the provided `s` schema. Sould not be used directly."
   [s type code hint value]
@@ -257,9 +271,9 @@
         hint   (or ^boolean hint "check error")
         type   (or ^boolean type :assertion)
         code   (or ^boolean code :data-validation)]
-    (partial fast-check! schema type code hint)))
+    (partial fast-check schema type code hint)))
 
-(defn check!
+(defn check
   "A helper intended to be used on assertions for validate/check the
   schema over provided data. Raises an assertion exception."
   [s value & {:keys [hint type code]}]
@@ -267,70 +281,103 @@
         hint   (or ^boolean hint "check error")
         type   (or ^boolean type :assertion)
         code   (or ^boolean code :data-validation)]
-    (fast-check! s type code hint value)))
+    (fast-check s type code hint value)))
 
-(defn register! [type s]
+(defn type-schema
-  (let [s (if (map? s)
+  [& {:as params}]
+  (m/-simple-schema params))
+
+(defn coll-schema
+  [& {:as params}]
+  (m/-collection-schema params))
+
+(defn register!
+  ([params]
    (cond
-              (= :set (:type s))
+     (map? params)
-              (m/-collection-schema s)
+     (let [type (get params :type)]
-
+       (assert (qualified-keyword? type) "expected qualified keyword for `type`")
-              (= :vector (:type s))
+       (let [s (m/-simple-schema params)]
-              (m/-collection-schema s)
-
-              :else
-              (m/-simple-schema s))
-            s)]
-
          (swap! sr/registry assoc type s)
          nil))
 
+     (vector? params)
+     (let [mdata (meta params)
+           type  (or (get mdata ::id)
+                     (get mdata ::type))]
+       (assert (qualified-keyword? type) "expected qualified keyword to be on metadata")
+       (swap! sr/registry assoc type params)
+       nil)
+
+     (m/into-schema? params)
+     (let [type (m/-type params)]
+       (swap! sr/registry assoc type params))
+
+     :else
+     (throw (ex-info "Invalid Arguments" {}))))
+
+  ([type params]
+   (let [s (if (map? params)
+             (cond
+               (= :set (:type params))
+               (m/-collection-schema params)
+
+               (= :vector (:type params))
+               (m/-collection-schema params)
+
+               :else
+               (m/-simple-schema params))
+             params)]
+
+     (swap! sr/registry assoc type s)
+     nil)))
+
 (defn- lazy-schema
   "Create ans instance of ILazySchema"
   [s]
-  (let [schema      (delay (schema s))
+  (let [schema      (schema s)
-        validator   (delay (m/validator @schema))
+        validator   (delay (m/validator schema))
-        explainer   (delay (m/explainer @schema))]
+        explainer   (delay (m/explainer schema))]
 
     (reify
       m/AST
-      (-to-ast [_ options] (m/-to-ast @schema options))
+      (-to-ast [_ options] (m/-to-ast schema options))
 
       m/EntrySchema
-      (-entries [_] (m/-entries @schema))
+      (-entries [_] (m/-entries schema))
-      (-entry-parser [_] (m/-entry-parser @schema))
+      (-entry-parser [_] (m/-entry-parser schema))
 
       m/Cached
-      (-cache [_] (m/-cache @schema))
+      (-cache [_] (m/-cache schema))
 
       m/LensSchema
-      (-keep [_] (m/-keep @schema))
+      (-keep [_] (m/-keep schema))
-      (-get [_ key default] (m/-get @schema key default))
+      (-get [_ key default] (m/-get schema key default))
-      (-set [_ key value] (m/-set @schema key value))
+      (-set [_ key value] (m/-set schema key value))
 
       m/Schema
       (-validator [_]
-        (m/-validator @schema))
+        (m/-validator schema))
       (-explainer [_ path]
-        (m/-explainer @schema path))
+        (m/-explainer schema path))
       (-parser [_]
-        (m/-parser @schema))
+        (m/-parser schema))
       (-unparser [_]
-        (m/-unparser @schema))
+        (m/-unparser schema))
       (-transformer [_ transformer method options]
-        (m/-transformer @schema transformer method options))
+        (m/-transformer schema transformer method options))
       (-walk [_ walker path options]
-        (m/-walk @schema walker path options))
+        (m/-walk schema walker path options))
       (-properties [_]
-        (m/-properties @schema))
+        (m/-properties schema))
       (-options [_]
-        (m/-options @schema))
+        (m/-options schema))
       (-children [_]
-        (m/-children @schema))
+        (m/-children schema))
       (-parent [_]
-        (m/-parent @schema))
+        (m/-parent schema))
       (-form [_]
-        (m/-form @schema))
+        (m/-form schema))
 
       ILazySchema
       (-validate [_ o]
@@ -352,7 +399,7 @@
     (some->> (re-matches uuid-rx s) uuid/uuid)
     s))
 
-(register! ::uuid
+(register!
  {:type ::uuid
   :pred uuid?
   :type-properties
@@ -380,8 +427,8 @@
   (and (string? s)
        (re-seq email-re s)))
 
-(register! ::email
+(register!
-  {:type :string
+ {:type ::email
   :pred email-string?
   :property-pred
   (fn [{:keys [max] :as props}]
@@ -408,8 +455,9 @@
 
 ;; NOTE: this is general purpose set spec and should be used over the other
 
-(def type:set
+(register!
-  {:type :set
+ (coll-schema
+  :type ::set
   :min 0
   :max 1
   :compile
@@ -451,9 +499,18 @@
 
           decode
           (fn [v]
-             (if (string? v)
+            (cond
+              (string? v)
               (let [v  (str/split v #"[\s,]+")]
                 (into #{} xf:filter-word-strings v))
+
+              (set? v)
+              v
+
+              (coll? v)
+              (into #{} v)
+
+              :else
               v))
 
           encode-string-child
@@ -479,12 +536,11 @@
         ::oapi/type "array"
         ::oapi/format "set"
         ::oapi/items {:type "string"}
-         ::oapi/unique-items true}}))})
+        ::oapi/unique-items true}}))))
 
-(register! ::set type:set)
+(register!
-
+ (coll-schema
-(register! ::vec
+  :type ::vec
-  {:type :vector
   :min 0
   :max 1
   :compile
@@ -525,9 +581,18 @@
 
           decode
           (fn [v]
-             (if (string? v)
+            (cond
+              (string? v)
               (let [v (str/split v #"[\s,]+")]
-                 (into #{} xf:filter-word-strings v))
+                (into [] xf:filter-word-strings v))
+
+              (vector? v)
+              v
+
+              (coll? v)
+              (into [] v)
+
+              :else
               v))
 
           encode-string-child
@@ -552,9 +617,9 @@
         ::oapi/type "array"
         ::oapi/format "set"
         ::oapi/items {:type "string"}
-         ::oapi/unique-items true}}))})
+        ::oapi/unique-items true}}))))
 
-(register! ::set-of-strings
+(register!
  {:type ::set-of-strings
   :pred #(and (set? %) (every? string? %))
   :type-properties
@@ -570,7 +635,7 @@
    ::oapi/items {:type "string"}
    ::oapi/unique-items true}})
 
-(register! ::set-of-keywords
+(register!
  {:type ::set-of-keywords
   :pred #(and (set? %) (every? keyword? %))
   :type-properties
@@ -586,7 +651,7 @@
    ::oapi/items {:type "string" :format "keyword"}
    ::oapi/unique-items true}})
 
-(register! ::set-of-uuid
+(register!
  {:type ::set-of-uuid
   :pred #(and (set? %) (every? uuid? %))
   :type-properties
@@ -602,8 +667,8 @@
    ::oapi/items {:type "string" :format "uuid"}
    ::oapi/unique-items true}})
 
-(register! ::coll-of-uuid
+(register!
-  {:type ::set-of-uuid
+ {:type ::coll-of-uuid
   :pred (partial every? uuid?)
   :type-properties
   {:title "[uuid]"
@@ -618,11 +683,12 @@
    ::oapi/items {:type "string" :format "uuid"}
    ::oapi/unique-items false}})
 
-(register! ::one-of
+(register!
  {:type ::one-of
   :min 1
   :max 1
-   :compile (fn [props children _]
+  :compile
+  (fn [props children _]
     (let [options (into #{} (last children))
           format  (:format props "keyword")
           decode  (if (= format "keyword")
@@ -651,8 +717,8 @@
          v))
       v))
 
-(def type:int
+(register!
-  {:type :int
+ {:type ::int
   :min 0
   :max 0
   :compile
@@ -660,8 +726,8 @@
     (let [pred int?
           pred (if (some? min)
                  (fn [v]
-                    (and (>= v min)
+                   (and (pred v)
-                         (pred v)))
+                        (>= v min)))
                  pred)
           pred (if (some? max)
                  (fn [v]
@@ -689,17 +755,15 @@
          v))
       v))
 
-(def type:double
+(register!
-  {:type :double
+ {:type ::double
-   :min 0
-   :max 0
   :compile
   (fn [{:keys [max min] :as props} _ _]
     (let [pred double?
           pred (if (some? min)
                  (fn [v]
-                    (and (>= v min)
+                   (and (pred v)
-                         (pred v)))
+                        (>= v min)))
                  pred)
           pred (if (some? max)
                  (fn [v]
@@ -719,17 +783,15 @@
         ::oapi/type "number"
         ::oapi/format "double"}}))})
 
-(def type:number
+(register!
-  {:type :number
+ {:type ::number
-   :min 0
-   :max 0
   :compile
   (fn [{:keys [max min] :as props} _ _]
     (let [pred number?
           pred (if (some? min)
                  (fn [v]
-                    (and (>= v min)
+                   (and (pred v)
-                         (pred v)))
+                        (>= v min)))
                  pred)
           pred (if (some? max)
                  (fn [v]
@@ -752,10 +814,6 @@
         :decode/json parse-double
         ::oapi/type "number"}}))})
 
-(register! ::int type:int)
-(register! ::double type:double)
-(register! ::number type:number)
-
 (register! ::safe-int [::int {:max max-safe-int :min min-safe-int}])
 (register! ::safe-double [::double {:max max-safe-int :min min-safe-int}])
 (register! ::safe-number [::number {:max max-safe-int :min min-safe-int}])
@@ -769,8 +827,8 @@
       v)
     v))
 
-(def type:boolean
+(register!
-  {:type :boolean
+ {:type ::boolean
   :pred boolean?
   :type-properties
   {:title "boolean"
@@ -783,9 +841,7 @@
    :encode/string str
    ::oapi/type "boolean"}})
 
-(register! ::boolean type:boolean)
+(register!
-
-(def type:contains-any
  {:type ::contains-any
   :min 1
   :max 1
@@ -803,9 +859,7 @@
                 {:title "contains"
                  :description "contains predicate"}}))})
 
-(register! ::contains-any type:contains-any)
+(register!
-
-(def type:inst
  {:type ::inst
   :pred inst?
   :type-properties
@@ -822,13 +876,13 @@
    ::oapi/type "string"
    ::oapi/format "iso"}})
 
-(register! ::inst type:inst)
+(register!
-
+ {:type ::fn
-(register! ::fn [:schema fn?])
+  :pred fn?})
 
 ;; FIXME: deprecated, replace with ::text
 
-(register! ::word-string
+(register!
  {:type ::word-string
   :pred #(and (string? %) (not (str/blank? %)))
   :property-pred (m/-min-max-pred count)
@@ -840,14 +894,13 @@
    ::oapi/type "string"
    ::oapi/format "string"}})
 
-
 (defn decode-uri
   [val]
   (if (u/uri? val)
     val
     (-> val str/trim u/uri)))
 
-(register! ::uri
+(register!
  {:type ::uri
   :pred u/uri?
   :property-pred
@@ -887,8 +940,8 @@
    ::oapi/type "string"
    ::oapi/format "uri"}})
 
-(register! ::text
+(register!
-  {:type :string
+ {:type ::text
   :pred #(and (string? %) (not (str/blank? %)))
   :property-pred
   (fn [{:keys [min max] :as props}]
@@ -929,8 +982,8 @@
               (str/blank? value))
          "errors.field-not-all-whitespace")))}})
 
-(register! ::password
+(register!
-  {:type :string
+ {:type ::password
   :pred
   (fn [value]
     (and (string? value)
@@ -944,6 +997,13 @@
    ::oapi/type "string"
    ::oapi/format "password"}})
 
+#?(:clj
+   (register!
+    {:type ::agent
+     :pred #(instance? clojure.lang.Agent %)
+     :type-properties
+     {:title "agent"
+      :description "instance of clojure agent"}}))
 
 ;; ---- PREDICATES
 

common/src/app/common/time.cljc

@@ -27,10 +27,22 @@
   #?(:clj (Instant/now)
      :cljs (.local ^js DateTime)))
 
-#?(:clj
+(defn is-after?
-   (defn is-after?
+  "Analgous to: da > db"
-     [one other]
+  [da db]
-     (.isAfter one other)))
+  (let [result (compare da db)]
+    (cond
+      (neg? result) false
+      (zero? result) false
+      :else true)))
+
+(defn is-before?
+  [da db]
+  (let [result (compare da db)]
+    (cond
+      (neg? result)   true
+      (zero? result)  false
+      :else false)))
 
 (defn instant?
   [o]

common/src/app/common/transit.cljc

@@ -115,6 +115,7 @@
     {:id "n"
      :rfn (fn [value]
             (js/parseInt value 10))})
+
  #?(:cljs
     {:id "u"
      :rfn parse-uuid})

common/src/app/common/types/component.cljc

@@ -10,7 +10,6 @@
    [app.common.schema :as sm]
    [app.common.types.page :as ctp]
    [app.common.types.plugins :as ctpg]
-   [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -236,7 +235,7 @@
 
 (defn group->swap-slot
   [group]
-  (uuid/uuid (subs (name group) 10)))
+  (parse-uuid (subs (name group) 10)))
 
 (defn get-swap-slot
   "If the shape has a :touched group in the form :swap-slot-<uuid>, get the id."
@@ -326,7 +325,7 @@
 (defn valid-touched-group?
   [group]
   (try
-    (or ((all-touched-groups) group)
+    (or (contains? (all-touched-groups) group)
         (and (swap-slot? group)
              (some? (group->swap-slot group))))
     (catch #?(:clj Throwable :cljs :default) _

common/src/app/common/types/container.cljc

@@ -27,7 +27,8 @@
 (def valid-container-types
   #{:page :component})
 
-(sm/register! ::container
+(sm/register!
+ ^{::sm/type ::container}
  [:map
   [:id ::sm/uuid]
   [:type {:optional true}

common/src/app/common/types/modifiers.cljc

@@ -529,13 +529,6 @@
   (or (d/not-empty? (dm/get-prop modifiers :geometry-child))
       (d/not-empty? (dm/get-prop modifiers :structure-child))))
 
-(defn only-move?
-  "Returns true if there are only move operations"
-  [modifiers]
-  (let [move-op? #(= :move (dm/get-prop % :type))]
-    (and (every? move-op? (dm/get-prop modifiers :geometry-child))
-         (every? move-op? (dm/get-prop modifiers :geometry-parent)))))
-
 (defn has-geometry?
   [modifiers]
   (or (d/not-empty? (dm/get-prop modifiers :geometry-parent))
@@ -550,6 +543,14 @@
   [modifiers]
   (d/not-empty? (dm/get-prop modifiers :structure-child)))
 
+(defn only-move?
+  "Returns true if there are only move operations"
+  [modifiers]
+  (let [move-op? #(= :move (dm/get-prop % :type))]
+    (and (not (has-structure? modifiers))
+         (every? move-op? (dm/get-prop modifiers :geometry-child))
+         (every? move-op? (dm/get-prop modifiers :geometry-parent)))))
+
 ;; Extract subsets of modifiers
 
 (defn select-child

common/src/app/common/types/shape.cljc

@@ -6,6 +6,7 @@
 
 (ns app.common.types.shape
   (:require
+   #?(:clj [app.common.fressian :as fres])
    [app.common.colors :as clr]
    [app.common.data :as d]
    [app.common.geom.matrix :as gmt]
@@ -13,15 +14,16 @@
    [app.common.geom.proportions :as gpr]
    [app.common.geom.rect :as grc]
    [app.common.geom.shapes :as gsh]
+   [app.common.record :as cr]
    [app.common.schema :as sm]
    [app.common.schema.generators :as sg]
+   [app.common.transit :as t]
    [app.common.types.color :as ctc]
    [app.common.types.grid :as ctg]
    [app.common.types.plugins :as ctpg]
    [app.common.types.shape.attrs :refer [default-color]]
    [app.common.types.shape.blur :as ctsb]
    [app.common.types.shape.export :as ctse]
-   [app.common.types.shape.impl :as impl]
    [app.common.types.shape.interactions :as ctsi]
    [app.common.types.shape.layout :as ctsl]
    [app.common.types.shape.path :as ctsp]
@@ -31,9 +33,31 @@
    [app.common.uuid :as uuid]
    [clojure.set :as set]))
 
+(defonce ^:dynamic *wasm-sync* false)
+
+(defonce wasm-enabled? false)
+(defonce wasm-create-shape (constantly nil))
+
+;; Marker protocol
+(defprotocol IShape)
+
+(cr/defrecord Shape [id name type x y width height rotation selrect points
+                     transform transform-inverse parent-id frame-id flip-x flip-y]
+  IShape)
+
 (defn shape?
   [o]
-  (impl/shape? o))
+  #?(:cljs (implements? IShape o)
+     :clj  (instance? Shape o)))
+
+(defn create-shape
+  "A low level function that creates a Shape data structure
+  from a attrs map without performing other transformations"
+  [attrs]
+  #?(:cljs (if ^boolean wasm-enabled?
+             (^function wasm-create-shape attrs)
+             (map->Shape attrs))
+     :clj  (map->Shape attrs)))
 
 (def stroke-caps-line #{:round :square})
 (def stroke-caps-marker #{:line-arrow :triangle-arrow :square-marker :circle-marker :diamond-marker})
@@ -242,7 +266,7 @@
 (defn- decode-shape
   [o]
   (if (map? o)
-    (impl/map->Shape o)
+    (create-shape o)
     o))
 
 (defn- shape-generator
@@ -266,7 +290,7 @@
                             (= type :bool))
                       (merge attrs1 shape attrs3)
                       (merge attrs1 shape attrs2 attrs3)))))
-       (sg/fmap impl/map->Shape)))
+       (sg/fmap create-shape)))
 
 (def schema:shape
   [:and {:title "Shape"
@@ -453,12 +477,6 @@
     ;; NOTE: used for create ephimeral shapes for multiple selection
     :multiple minimal-multiple-attrs))
 
-(defn create-shape
-  "A low level function that creates a Shape data structure
-  from a attrs map without performing other transformations"
-  [attrs]
-  (impl/create-shape attrs))
-
 (defn- make-minimal-shape
   [type]
   (let [type  (if (= type :curve) :path type)
@@ -476,7 +494,7 @@
                    (assoc :parent-id uuid/zero)
                    (assoc :rotation 0))]
 
-    (impl/create-shape attrs)))
+    (create-shape attrs)))
 
 (defn setup-rect
   "Initializes the selrect and points for a shape."
@@ -531,3 +549,17 @@
           (assoc :transform-inverse (gmt/matrix)))
         (gpr/setup-proportions))))
 
+;; --- SHAPE SERIALIZATION
+
+(t/add-handlers!
+ {:id "shape"
+  :class Shape
+  :wfn #(into {} %)
+  :rfn create-shape})
+
+#?(:clj
+   (fres/add-handlers!
+    {:name "penpot/shape"
+     :class Shape
+     :wfn fres/write-map-like
+     :rfn (comp map->Shape fres/read-map-like)}))

common/src/app/common/types/shape/blur.cljc

@@ -26,7 +26,8 @@
 ;; SCHEMA
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(sm/register! ::blur
+(sm/register!
+ ^{::sm/type ::blur}
  [:map {:title "Blur"}
   [:id ::sm/uuid]
   [:type [:= :layer-blur]]

common/src/app/common/types/shape/impl.cljc

@@ -1,227 +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.common.types.shape.impl
-  (:require
-   #?(:clj [app.common.fressian :as fres])
-   #?(:cljs [app.common.data.macros :as dm])
-   #?(:cljs [app.common.geom.rect :as grc])
-   #?(:cljs [cuerdas.core :as str])
-   [app.common.record :as cr]
-   [app.common.transit :as t]
-   [clojure.core :as c]))
-
-(def enabled-wasm-ready-shape false)
-
-#?(:cljs
-   (do
-     (def ArrayBuffer js/ArrayBuffer)
-     (def Float32Array js/Float32Array)))
-
-(cr/defrecord Shape [id name type x y width height rotation selrect points
-                     transform transform-inverse parent-id frame-id flip-x flip-y])
-
-(declare ^:private clone-f32-array)
-(declare ^:private impl-assoc)
-(declare ^:private impl-conj)
-(declare ^:private impl-dissoc)
-(declare ^:private read-selrect)
-(declare ^:private write-selrect)
-
-;; TODO: implement lazy MapEntry
-
-#?(:cljs
-   (deftype ShapeWithBuffer [buffer delegate]
-     Object
-     (toString [coll]
-       (str "{" (str/join ", " (for [[k v] coll] (str k " " v))) "}"))
-
-     (equiv [this other]
-       (-equiv this other))
-
-       ;; ICloneable
-       ;; (-clone [_]
-       ;;   (let [bf32 (clone-float32-array buffer)]
-       ;;     (ShapeWithBuffer. bf32 delegate)))
-
-     IWithMeta
-     (-with-meta [_ meta]
-       (ShapeWithBuffer. buffer (with-meta delegate meta)))
-
-     IMeta
-     (-meta [_] (meta delegate))
-
-     ICollection
-     (-conj [coll entry]
-       (impl-conj coll entry))
-
-     IEquiv
-     (-equiv [coll other]
-       (c/equiv-map coll other))
-
-     IHash
-     (-hash [coll] (hash (into {} coll)))
-
-     ISequential
-
-     ISeqable
-     (-seq [coll]
-       (cons (find coll :selrect)
-             (seq delegate)))
-
-     ICounted
-     (-count [_]
-       (+ 1 (count delegate)))
-
-     ILookup
-     (-lookup [coll k]
-       (-lookup coll k nil))
-
-     (-lookup [_ k not-found]
-       (if (= k :selrect)
-         (read-selrect buffer)
-         (c/-lookup delegate k not-found)))
-
-     IFind
-     (-find [_ k]
-       (if (= k :selrect)
-         (c/MapEntry. k (read-selrect buffer) nil) ; Replace with lazy MapEntry
-         (c/-find delegate k)))
-
-     IAssociative
-     (-assoc [coll k v]
-       (impl-assoc coll k v))
-
-     (-contains-key? [_ k]
-       (or (= k :selrect)
-           (contains? delegate k)))
-
-     IMap
-     (-dissoc [coll k]
-       (impl-dissoc coll k))
-
-     IFn
-     (-invoke [coll k]
-       (-lookup coll k))
-
-     (-invoke [coll k not-found]
-       (-lookup coll k not-found))
-
-     IPrintWithWriter
-     (-pr-writer [_ writer _]
-       (-write writer (str "#penpot/shape " (:id delegate))))))
-
-(defn shape?
-  [o]
-  #?(:clj (instance? Shape o)
-     :cljs (or (instance? Shape o)
-               (instance? ShapeWithBuffer o))))
-
-;; --- SHAPE IMPL
-
-#?(:cljs
-   (defn- clone-f32-array
-     [^Float32Array src]
-     (let [copy (new Float32Array (.-length src))]
-       (.set copy src)
-       copy)))
-
-#?(:cljs
-   (defn- write-selrect
-     "Write the selrect into the buffer"
-     [data selrect]
-     (assert (instance? Float32Array data) "expected instance of float32array")
-
-     (aset data 0 (dm/get-prop selrect :x1))
-     (aset data 1 (dm/get-prop selrect :y1))
-     (aset data 2 (dm/get-prop selrect :x2))
-     (aset data 3 (dm/get-prop selrect :y2))))
-
-#?(:cljs
-   (defn- read-selrect
-     "Read selrect from internal buffer"
-     [^Float32Array buffer]
-     (let [x1 (aget buffer 0)
-           y1 (aget buffer 1)
-           x2 (aget buffer 2)
-           y2 (aget buffer 3)]
-       (grc/make-rect x1 y1
-                      (- x2 x1)
-                      (- y2 y1)))))
-
-#?(:cljs
-   (defn- impl-assoc
-     [coll k v]
-     (if (= k :selrect)
-       (let [buffer (clone-f32-array (.-buffer coll))]
-         (write-selrect buffer v)
-         (ShapeWithBuffer. buffer (.-delegate ^ShapeWithBuffer coll)))
-
-       (let [delegate  (.-delegate ^ShapeWithBuffer coll)
-             delegate' (assoc delegate k v)]
-         (if (identical? delegate' delegate)
-           coll
-           (let [buffer (clone-f32-array (.-buffer coll))]
-             (ShapeWithBuffer. buffer delegate')))))))
-
-#?(:cljs
-   (defn- impl-dissoc
-     [coll k]
-     (let [delegate  (.-delegate ^ShapeWithBuffer coll)
-           delegate' (dissoc delegate k)]
-       (if (identical? delegate delegate')
-         coll
-         (let [buffer (clone-f32-array (.-buffer coll))]
-           (ShapeWithBuffer. buffer delegate'))))))
-
-#?(:cljs
-   (defn- impl-conj
-     [coll entry]
-     (if (vector? entry)
-       (-assoc coll (-nth entry 0) (-nth entry 1))
-       (loop [ret coll es (seq entry)]
-         (if (nil? es)
-           ret
-           (let [e (first es)]
-             (if (vector? e)
-               (recur (-assoc ret (-nth e 0) (-nth e 1))
-                      (next es))
-               (throw (js/Error. "conj on a map takes map entries or seqables of map entries")))))))))
-
-(defn create-shape
-  "Instanciate a shape from a map"
-  [attrs]
-  #?(:cljs
-     (if enabled-wasm-ready-shape
-       (let [selrect (:selrect attrs)
-             buffer  (new Float32Array 4)]
-         (write-selrect buffer selrect)
-         (ShapeWithBuffer. buffer (dissoc attrs :selrect)))
-       (map->Shape attrs))
-
-     :clj (map->Shape attrs)))
-
-;; --- SHAPE SERIALIZATION
-
-(t/add-handlers!
- {:id "shape"
-  :class Shape
-  :wfn #(into {} %)
-  :rfn create-shape})
-
-#?(:cljs
-   (t/add-handlers!
-    {:id "shape"
-     :class ShapeWithBuffer
-     :wfn #(into {} %)
-     :rfn create-shape}))
-
-#?(:clj
-   (fres/add-handlers!
-    {:name "penpot/shape"
-     :class Shape
-     :wfn fres/write-map-like
-     :rfn (comp create-shape fres/read-map-like)}))

common/src/app/common/types/shape/layout.cljc

@@ -86,7 +86,8 @@
    :layout-item-absolute
    :layout-item-z-index])
 
-(sm/register! ::layout-attrs
+(sm/register!
+ ^{::sm/type ::layout-attrs}
  [:map {:title "LayoutAttrs"}
   [:layout {:optional true} [::sm/one-of layout-types]]
   [:layout-flex-dir {:optional true} [::sm/one-of flex-direction-types]]
@@ -129,7 +130,8 @@
 (def grid-cell-justify-self-types
   #{:auto :start :center :end :stretch})
 
-(sm/register! ::grid-cell
+(sm/register!
+ ^{::sm/type ::grid-cell}
  [:map {:title "GridCell"}
   [:id ::sm/uuid]
   [:area-name {:optional true} :string]
@@ -143,7 +145,8 @@
   [:shapes
    [:vector {:gen/max 1} ::sm/uuid]]])
 
-(sm/register! ::grid-track
+(sm/register!
+ ^{::sm/type ::grid-track}
  [:map {:title "GridTrack"}
   [:type [::sm/one-of grid-track-types]]
   [:value {:optional true} [:maybe ::sm/safe-number]]])
@@ -165,7 +168,8 @@
 (def item-align-self-types
   #{:start :end :center :stretch})
 
-(sm/register! ::layout-child-attrs
+(sm/register!
+ ^{::sm/type ::layout-child-attrs}
  [:map {:title "LayoutChildAttrs"}
   [:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
   [:layout-item-margin {:optional true}
@@ -191,8 +195,7 @@
 (def valid-layouts
   #{:flex :grid})
 
-(sm/register! ::layout
+(sm/register! ::layout [::sm/one-of valid-layouts])
-  [::sm/one-of valid-layouts])
 
 (defn flex-layout?
   ([objects id]

common/src/app/common/types/shape/text.cljc

@@ -16,7 +16,8 @@
 
 (def node-types #{"root" "paragraph-set" "paragraph"})
 
-(sm/register! ::content
+(sm/register!
+ ^{::sm/type ::content}
  [:map
   [:type [:= "root"]]
   [:key {:optional true} :string]
@@ -64,7 +65,8 @@
 
 
 
-(sm/register! ::position-data
+(sm/register!
+ ^{::sm/type ::position-data}
  [:vector {:min 1 :gen/max 2}
   [:map
    [:x ::sm/safe-number]

common/src/app/common/types/team.cljc

@@ -4,7 +4,9 @@
 ;;
 ;; Copyright (c) KALEIDOS INC
 
-(ns app.common.types.team)
+(ns app.common.types.team
+  (:require
+   [app.common.schema :as sm]))
 
 (def valid-roles
   #{:owner :admin :editor :viewer})
@@ -15,3 +17,4 @@
    :admin  {:can-edit true :is-admin true :is-owner false}
    :owner  {:can-edit true :is-admin true :is-owner true}})
 
+(sm/register! ::role [::sm/one-of valid-roles])

common/src/app/common/types/token.cljc

@@ -64,7 +64,8 @@
   (string? n))
 
 ;; TODO Move this to tokens-lib
-(sm/register! ::token
+(sm/register!
+ ^{::sm/type ::token}
  [:map {:title "Token"}
   [:name token-name-ref]
   [:type [::sm/one-of token-types]]
@@ -72,14 +73,16 @@
   [:description {:optional true} [:maybe :string]]
   [:modified-at {:optional true} ::sm/inst]])
 
-(sm/register! ::color
+(sm/register!
+ ^{::sm/type ::color}
  [:map
   [:fill {:optional true} token-name-ref]
   [:stroke-color {:optional true} token-name-ref]])
 
 (def color-keys (schema-keys ::color))
 
-(sm/register! ::border-radius
+(sm/register!
+ ^{::sm/type ::border-radius}
  [:map
   [:rx {:optional true} token-name-ref]
   [:ry {:optional true} token-name-ref]
@@ -90,13 +93,15 @@
 
 (def border-radius-keys (schema-keys ::border-radius))
 
-(sm/register! ::stroke-width
+(sm/register!
+ ^{::sm/type ::stroke-width}
  [:map
   [:stroke-width {:optional true} token-name-ref]])
 
 (def stroke-width-keys (schema-keys ::stroke-width))
 
-(sm/register! ::sizing
+(sm/register!
+ ^{::sm/type ::sizing}
  [:map
   [:width {:optional true} token-name-ref]
   [:height {:optional true} token-name-ref]
@@ -107,13 +112,15 @@
 
 (def sizing-keys (schema-keys ::sizing))
 
-(sm/register! ::opacity
+(sm/register!
+ ^{::sm/type ::opacity}
  [:map
   [:opacity {:optional true} token-name-ref]])
 
 (def opacity-keys (schema-keys ::opacity))
 
-(sm/register! ::spacing
+(sm/register!
+ ^{::sm/type ::spacing}
  [:map
   [:row-gap {:optional true} token-name-ref]
   [:column-gap {:optional true} token-name-ref]
@@ -126,27 +133,33 @@
 
 (def spacing-keys (schema-keys ::spacing))
 
-(sm/register! ::dimensions
+(sm/register!
-  (merge-schemas ::sizing
+ ^{::sm/type ::dimensions}
+ [:merge
+  ::sizing
   ::spacing
   ::stroke-width
-    ::border-radius))
+  ::border-radius])
 
 (def dimensions-keys (schema-keys ::dimensions))
 
-(sm/register! ::rotation
+(sm/register!
+ ^{::sm/type ::rotation}
  [:map
   [:rotation {:optional true} token-name-ref]])
 
 (def rotation-keys (schema-keys ::rotation))
 
-(sm/register! ::tokens
+(sm/register!
+ ^{::sm/type ::tokens}
  [:map {:title "Applied Tokens"}])
 
-(sm/register! ::applied-tokens
+(sm/register!
-  (merge-schemas ::tokens
+ ^{::sm/type ::applied-tokens}
+ [:merge
+  ::tokens
   ::border-radius
   ::sizing
   ::spacing
   ::rotation
-    ::dimensions))
+  ::dimensions])