From 88fb5e7ab5185b18950b11c9100c5b05fa002527 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Tue, 29 Oct 2024 09:08:25 +0100 Subject: [PATCH] :recycle: Update integrant to latest version This upgrade also includes complete elimination of use spec from the backend codebase, completing the long running migration to fully use malli for validation and decoding. --- .circleci/config.yml | 2 +- .cljfmt.edn | 1 - backend/dev/user.clj | 1 - backend/scripts/repl | 1 - backend/scripts/start-dev | 2 +- backend/src/app/auth/ldap.clj | 75 +- backend/src/app/auth/oidc.clj | 102 +- backend/src/app/config.clj | 18 +- backend/src/app/db.clj | 100 +- backend/src/app/email.clj | 237 ++-- backend/src/app/http.clj | 75 +- backend/src/app/http/assets.clj | 11 +- backend/src/app/http/awsns.clj | 11 +- backend/src/app/http/client.clj | 16 +- backend/src/app/http/debug.clj | 7 +- backend/src/app/http/session.clj | 58 +- backend/src/app/http/websocket.clj | 17 +- backend/src/app/loggers/audit.clj | 62 +- .../src/app/loggers/audit/archive_task.clj | 13 +- backend/src/app/loggers/audit/gc_task.clj | 6 +- backend/src/app/loggers/database.clj | 8 +- backend/src/app/loggers/mattermost.clj | 9 +- backend/src/app/loggers/webhooks.clj | 19 +- backend/src/app/main.clj | 36 +- backend/src/app/media.clj | 17 +- backend/src/app/metrics.clj | 96 +- backend/src/app/migrations.clj | 7 +- backend/src/app/msgbus.clj | 143 ++- backend/src/app/redis.clj | 444 ++++--- backend/src/app/rpc.clj | 47 +- backend/src/app/rpc/climit.clj | 275 +++-- backend/src/app/rpc/doc.clj | 7 +- backend/src/app/rpc/permissions.clj | 35 +- backend/src/app/rpc/rlimit.clj | 111 +- backend/src/app/setup.clj | 17 +- backend/src/app/srepl.clj | 18 +- backend/src/app/storage.clj | 65 +- backend/src/app/storage/fs.clj | 37 +- backend/src/app/storage/gc_deleted.clj | 16 +- backend/src/app/storage/gc_touched.clj | 6 +- backend/src/app/storage/impl.clj | 5 - backend/src/app/storage/s3.clj | 88 +- backend/src/app/storage/tmp.clj | 13 +- backend/src/app/tasks/delete_object.clj | 6 +- backend/src/app/tasks/file_gc.clj | 7 +- backend/src/app/tasks/file_gc_scheduler.clj | 12 +- backend/src/app/tasks/file_xlog_gc.clj | 6 +- backend/src/app/tasks/objects_gc.clj | 17 +- backend/src/app/tasks/offload_file_data.clj | 7 +- backend/src/app/tasks/tasks_gc.clj | 12 +- backend/src/app/tasks/telemetry.clj | 10 +- backend/src/app/util/cache.clj | 7 + backend/src/app/util/overrides.clj | 24 +- backend/src/app/util/time.clj | 52 +- backend/src/app/worker.clj | 45 +- backend/src/app/worker/cron.clj | 37 +- backend/src/app/worker/dispatcher.clj | 36 +- backend/src/app/worker/executor.clj | 26 +- backend/src/app/worker/runner.clj | 55 +- backend/test/backend_tests/helpers.clj | 8 +- backend/test/backend_tests/storage_test.clj | 19 +- common/deps.edn | 2 +- common/src/app/common/features.cljc | 13 +- .../src/app/common/files/changes_builder.cljc | 17 +- common/src/app/common/geom/point.cljc | 4 +- common/src/app/common/logging.cljc | 27 +- common/src/app/common/schema.cljc | 1097 +++++++++-------- common/src/app/common/types/container.cljc | 23 +- common/src/app/common/types/shape/blur.cljc | 13 +- common/src/app/common/types/shape/layout.cljc | 133 +- common/src/app/common/types/shape/text.cljc | 128 +- common/src/app/common/types/token.cljc | 133 +- common/src/app/common/types/token_theme.cljc | 30 +- exporter/scripts/wait-and-start.sh | 2 - frontend/src/app/main/data/comments.cljs | 6 +- frontend/src/app/main/data/users.cljs | 8 +- frontend/src/app/main/data/viewer.cljs | 4 +- .../src/app/main/data/workspace/media.cljs | 4 +- frontend/src/app/worker.cljs | 2 +- 79 files changed, 2249 insertions(+), 2117 deletions(-) diff --git a/.circleci/config.yml b/.circleci/config.yml index 6b54b1893..74d1cbf30 100644 --- a/.circleci/config.yml +++ b/.circleci/config.yml @@ -161,7 +161,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" diff --git a/.cljfmt.edn b/.cljfmt.edn index 02c567b2e..38cfeb89b 100644 --- a/.cljfmt.edn +++ b/.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]]} } diff --git a/backend/dev/user.clj b/backend/dev/user.clj index 5f742ff15..a790c1018 100644 --- a/backend/dev/user.clj +++ b/backend/dev/user.clj @@ -137,7 +137,6 @@ ;; :v6 v6 ;; }]))) - (defn calculate-frames [{:keys [data]}] (->> (vals (:pages-index data)) diff --git a/backend/scripts/repl b/backend/scripts/repl index eec5ba5aa..4aa78f025 100755 --- a/backend/scripts/repl +++ b/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 \ diff --git a/backend/scripts/start-dev b/backend/scripts/start-dev index 65ccbc9c1..4e4c8497f 100755 --- a/backend/scripts/start-dev +++ b/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 \ diff --git a/backend/src/app/auth/ldap.clj b/backend/src/app/auth/ldap.clj index c430a794d..63b7c9367 100644 --- a/backend/src/app/auth/ldap.clj +++ b/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) -(s/def ::email ::us/email) -(s/def ::backend ::us/not-empty-string) +(def ^:private schema:info-data + [:map + [:fullname ::sm/text] + [:email ::sm/email] + [:backend ::sm/text]]) -(s/def ::info-data - (s/keys :req-un [::fullname ::email ::backend])) +(def ^:private valid-info-data? + (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) - (let [explain (s/explain-str ::info-data user)] - (l/warn ::l/raw (str "invalid response from ldap, looks like ldap is not configured correctly\n" explain)) + (when-not (valid-info-data? user) + (let [explain (explain-info-data user)] + (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) -(s/def ::host ::us/string) -(s/def ::port ::us/integer) -(s/def ::ssl ::us/boolean) -(s/def ::tls ::us/boolean) -(s/def ::query ::us/string) -(s/def ::base-dn ::us/string) -(s/def ::bind-dn ::us/string) -(s/def ::bind-password ::us/string) -(s/def ::attrs-email ::us/string) -(s/def ::attrs-fullname ::us/string) -(s/def ::attrs-username ::us/string) +(def ^:private schema:params + [:map + [:host {:optional true} :string] + [:port {:optional true} ::sm/int] + [:bind-dn {:optional true} :string] + [:bind-passwor {:optional true} :string] + [:query {:optional true} :string] + [:base-dn {:optional true} :string] + [:attrs-email {:optional true} :string] + [:attrs-username {:optional true} :string] + [:attrs-fullname {:optional true} :string] + [:ssl {:optional true} ::sm/boolean] + [:tls {:optional true} ::sm/boolean]]) -(s/def ::provider-params - (s/keys :opt-un [::host ::port - ::ssl ::tls - ::enabled? - ::bind-dn - ::bind-password - ::query - ::attrs-email - ::attrs-username - ::attrs-fullname])) +(def ^:private check-params + (sm/check-fn schema:params :hint "Invalid LDAP provider parameters")) -(s/def ::provider - (s/nilable ::provider-params)) - -(defmethod ig/pre-init-spec ::provider - [_] - (s/spec ::provider)) +(defmethod ig/assert-key ::provider + [_ params] + (when (:enabled params) + (some->> params check-params))) (defmethod ig/init-key ::provider [_ cfg] - (when (:enabled? cfg) + (when (:enabled cfg) (try-connectivity cfg))) + +(sm/register! ::provider schema:params) diff --git a/backend/src/app/auth/oidc.clj b/backend/src/app/auth/oidc.clj index 735beb4af..42de8ddb8 100644 --- a/backend/src/app/auth/oidc.clj +++ b/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 [_] - (s/keys :req [::http/client])) +(defmethod ig/assert-key ::providers/generic + [_ 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 [_] - (s/keys :req [::http/client])) +(defmethod ig/assert-key ::providers/github + [_ 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) -(s/def ::email ::us/not-empty-string) -(s/def ::fullname ::us/not-empty-string) -(s/def ::props (s/map-of ::us/keyword any?)) -(s/def ::info - (s/keys :req-un [::backend - ::email - ::fullname - ::props])) +(def ^:private schema:info + [:map + [:backend ::sm/text] + [:email ::sm/email] + [:fullname ::sm/text] + [:props [:map-of :keyword :any]]]) + +(def ^:private valid-info? + (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) -(s/def ::client-secret ::us/string) -(s/def ::base-uri ::us/string) -(s/def ::token-uri ::us/string) -(s/def ::auth-uri ::us/string) -(s/def ::user-uri ::us/string) -(s/def ::scopes ::us/set-of-strings) -(s/def ::roles ::us/set-of-strings) -(s/def ::roles-attr ::us/string) -(s/def ::email-attr ::us/string) -(s/def ::name-attr ::us/string) +(def ^:private schema:provider + [:map {:title "provider"} + [:client-id ::sm/text] + [:client-secret ::sm/text] + [:base-uri {:optional true} ::sm/text] + [:token-uri {:optional true} ::sm/text] + [:auth-uri {:optional true} ::sm/text] + [:user-uri {:optional true} ::sm/text] + [:scopes {:optional true} + [::sm/set ::sm/text]] + [: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 - (s/keys :req-un [::client-id - ::client-secret] - :opt-un [::base-uri - ::token-uri - ::auth-uri - ::user-uri - ::scopes - ::roles - ::roles-attr - ::email-attr - ::name-attr])) +(def ^:private schema:routes-params + [:map + ::session/manager + ::http/client + ::setup/props + ::db/pool + [::providers [:map-of :keyword [:maybe schema:provider]]]]) -(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])) +(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" diff --git a/backend/src/app/config.clj b/backend/src/app/config.clj index d7eab48f0..54f568b18 100644 --- a/backend/src/app/config.clj +++ b/backend/src/app/config.clj @@ -26,11 +26,11 @@ [_ data] (d/without-nils data)) -(defmethod ig/prep-key :default - [_ data] - (if (map? data) - (d/without-nils data) - data)) +(defmethod ig/expand-key :default + [k v] + {k (if (map? v) + (d/without-nils v) + 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] @@ -190,7 +190,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 +218,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 diff --git a/backend/src/app/db.clj b/backend/src/app/db.clj index 2df9a53b1..d02a8ee4e 100644 --- a/backend/src/app/db.clj +++ b/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) -(s/def ::max-size ::us/integer) -(s/def ::min-size ::us/integer) -(s/def ::name keyword?) -(s/def ::password ::us/string) -(s/def ::uri ::us/not-empty-string) -(s/def ::username ::us/string) -(s/def ::validation-timeout ::us/integer) -(s/def ::read-only? ::us/boolean) - -(s/def ::pool-options - (s/keys :opt [::uri - ::name - ::min-size - ::max-size - ::connection-timeout - ::validation-timeout - ::username - ::password - ::mtx/metrics - ::read-only?])) +(def ^:private schema:pool-options + [:map {:title "pool-options"} + [::connect-timeout {:optional true} ::sm/int] + [::max-size {:optional true} ::sm/int] + [::min-size {:optional true} ::sm/int] + [::name {:optional true} :keyword] + [::uri {:optional true} ::sm/uri] + [::password {:optional true} :string] + [::username {:optional true} :string] + [::validation-timeout {:optional true} ::sm/int] + [::read-only {:optional true} ::sm/boolean]]) (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 - [_ cfg] - (merge defaults (d/without-nils cfg))) - -;; Don't validate here, just validate that a map is received. -(defmethod ig/pre-init-spec ::pool [_] ::pool-options) +(defmethod ig/assert-key ::pool + [_ options] + (assert (sm/check schema:pool-options options))) (defmethod ig/init-key ::pool - [_ {:keys [::uri ::read-only?] :as cfg}] - (when uri - (l/info :hint "initialize connection pool" - :name (d/name (::name cfg)) - :uri uri - :read-only read-only? - :with-credentials (and (contains? cfg ::username) - (contains? cfg ::password)) - :min-size (::min-size cfg) - :max-size (::max-size cfg)) - (create-pool 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 (str uri) + :read-only read-only + :credentials (and (contains? cfg ::username) + (contains? cfg ::password)) + :min-size (::min-size cfg) + :max-size (::max-size 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 - (->> (::mtx/registry metrics) + (when-let [instance (::mtx/metrics cfg)] + (->> (mtx/get-registry instance) (PrometheusMetricsTrackerFactory.) (.setMetricsTrackerFactory config))) @@ -150,10 +140,22 @@ [conn] (instance? Connection conn)) -(s/def ::conn some?) -(s/def ::nilable-pool (s/nilable ::pool)) -(s/def ::pool pool?) -(s/def ::connectable some?) +(defn connectable? + [o] + (or (connection? o) + (pool? o))) + +(sm/register! + {:type ::conn + :pred connection?}) + +(sm/register! + {:type ::connectable + :pred connectable?}) + +(sm/register! + {:type ::pool + :pred pool?}) (defn closed? [pool] diff --git a/backend/src/app/email.clj b/backend/src/app/email.clj index eee5ec42a..a8ee40c4d 100644 --- a/backend/src/app/email.clj +++ b/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,50 +217,47 @@ [{:type "text/html" :content html}]))})) -(s/def ::priority #{:high :low}) -(s/def ::to (s/or :single ::us/email - :multi (s/coll-of ::us/email))) -(s/def ::from ::us/email) -(s/def ::reply-to ::us/email) -(s/def ::lang string?) -(s/def ::extra-data ::us/string) +(def ^:private schema:context + [:map + [:to [:or ::sm/email [::sm/vec ::sm/email]]] + [:reply-to {:optional true} ::sm/email] + [:from {:optional true} ::sm/email] + [:lang {:optional true} ::sm/text] + [:priority {:optional true} [:enum :high :low]] + [:extra-data {:optional true} ::sm/text]]) -(s/def ::context - (s/keys :req-un [::to] - :opt-un [::reply-to ::from ::lang ::priority ::extra-data])) +(def ^:private valid-context? + (sm/validator schema:context)) (defn template-factory - ([id] (template-factory id {})) - ([id extra-context] - (s/assert keyword? id) - (fn [context] - (us/verify ::context context) - (when-let [spec (s/get-spec id)] - (s/assert spec context)) + [& {:keys [id schema]}] + (assert (keyword? id) "id should be provided and it should be a keyword") + (let [check-fn (if schema + (sm/check-fn schema) + (constantly nil))] + (fn [context] + (assert (valid-context? context) "expected a valid context") + (check-fn context) - (let [context (merge (if (fn? extra-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})) - (cond-> (assoc email :id (name id)) - (:extra-data context) - (assoc :extra-data (:extra-data context)) + (let [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." + :template-id id)) - (:from context) - (assoc :from (:from context)) + (cond-> (assoc email :id (name id)) + (:extra-data context) + (assoc :extra-data (:extra-data context)) - (:reply-to context) - (assoc :reply-to (:reply-to context)) + (:from context) + (assoc :from (:from context)) - (:to context) - (assoc :to (:to context))))))) + (:reply-to context) + (assoc :reply-to (:reply-to context)) + (: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 [_] - (s/keys :req [::sendmail ::mtx/metrics])) +(defmethod ig/assert-key ::handler + [_ 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) -(s/def ::content ::us/string) - -(s/def ::feedback - (s/keys :req-un [::subject ::content])) +(def ^:private schema:feedback + [:map + [:subject ::sm/text] + [:content ::sm/text]]) (def feedback "A profile feedback email." - (template-factory ::feedback)) + (template-factory + :id ::feedback + :schema schema:feedback)) -(s/def ::name ::us/string) -(s/def ::register - (s/keys :req-un [::name])) +(def ^:private schema:register + [:map [:name ::sm/text]]) (def register "A new profile registration welcome email." - (template-factory ::register)) + (template-factory + :id ::register + :schema schema:register)) -(s/def ::token ::us/string) -(s/def ::password-recovery - (s/keys :req-un [::name ::token])) +(def ^:private schema:password-recovery + [:map + [: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) -(s/def ::change-email - (s/keys :req-un [::name ::pending-email ::token])) +(def ^:private schema:change-email + [:map + [: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) -(s/def ::email.invite-to-team/team ::us/string) -(s/def ::email.invite-to-team/token ::us/string) - -(s/def ::invite-to-team - (s/keys :req-un [::email.invite-to-team/invited-by - ::email.invite-to-team/token - ::email.invite-to-team/team])) +(def ^:private schema:invite-to-team + [:map + [:invited-by ::sm/text] + [:team ::sm/text] + [:token ::sm/text]]) (def invite-to-team "Teams member invitation email." - (template-factory ::invite-to-team)) + (template-factory + :id ::invite-to-team + :schema schema:invite-to-team)) - -(s/def ::email.join-team/invited-by ::us/string) -(s/def ::email.join-team/team ::us/string) -(s/def ::email.join-team/team-id ::us/uuid) - -(s/def ::join-team - (s/keys :req-un [::email.join-team/invited-by - ::email.join-team/team-id - ::email.join-team/team])) +(def ^:private schema:join-team + [:map + [:invited-by ::sm/text] + [:team ::sm/text] + [:team-id ::sm/uuid]]) (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) -(s/def ::email.request-team-access/requested-by-email ::us/string) -(s/def ::email.request-team-access/team-name ::us/string) -(s/def ::email.request-team-access/team-id ::us/uuid) -(s/def ::email.request-team-access/file-name ::us/string) -(s/def ::email.request-team-access/file-id ::us/uuid) -(s/def ::email.request-team-access/page-id ::us/uuid) - -(s/def ::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 ^:private schema:request-file-access + [:map + [:requested-by ::sm/text] + [:requested-by-email ::sm/text] + [:team-name ::sm/text] + [:team-id ::sm/uuid] + [:file-name ::sm/text] + [:file-id ::sm/uuid] + [:page-id ::sm/uuid]]) (def request-file-access "File access request email." - (template-factory ::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])) + (template-factory + :id ::request-file-access + :schema schema:request-file-access)) (def request-file-access-yourpenpot "File access on Your Penpot request email." - (template-factory ::request-file-access-yourpenpot)) - -(s/def ::request-file-access-yourpenpot-view - (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])) + (template-factory + :id ::request-file-access-yourpenpot + :schema schema:request-file-access)) (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 - (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])) +(def ^:private schema:request-team-access + [:map + [:requested-by ::sm/text] + [:requested-by-email ::sm/text] + [: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 diff --git a/backend/src/app/http.clj b/backend/src/app/http.clj index 45972db2e..4d85cdaee 100644 --- a/backend/src/app/http.clj +++ b/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?) -(s/def ::router some?) -(s/def ::port integer?) -(s/def ::host string?) -(s/def ::name string?) +(def default-params + {::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 -(s/def ::max-body-size integer?) -(s/def ::max-multipart-body-size integer?) -(s/def ::io-threads integer?) +(defmethod ig/expand-key ::server + [k v] + {k (merge default-params (d/without-nils v))}) -(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 - (d/without-nils cfg))) +(def ^:private schema:server-params + [:map + [::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/pre-init-spec ::server [_] - (s/keys :req [::port ::host] - :opt [::max-body-size - ::max-multipart-body-size - ::router - ::handler - ::io-threads])) +(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 [_] - (s/keys :req [::session/manager - ::ws/routes - ::rpc/routes - ::rpc.doc/routes - ::oidc/routes - ::setup/props - ::assets/routes - ::debug/routes - ::db/pool - ::mtx/routes - ::awsns/routes])) +(def ^:private schema:routes + [:vector :any]) + +(def ^:private schema:router-params + [:map + [::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 + ::db/pool]) + +(defmethod ig/assert-key ::router + [_ params] + (assert (sm/check schema:router-params params))) (defmethod ig/init-key ::router [_ cfg] diff --git a/backend/src/app/http/assets.clj b/backend/src/app/http/assets.clj index 45c4ab315..5e7da3e00 100644 --- a/backend/src/app/http/assets.clj +++ b/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) -(s/def ::routes vector?) - -(defmethod ig/pre-init-spec ::routes [_] - (s/keys :req [::sto/storage ::path])) +(defmethod ig/assert-key ::routes + [_ params] + (assert (sto/valid-storage? (::sto/storage params)) "expected valid storage instance") + (assert (string? (::path params)))) (defmethod ig/init-key ::routes [_ cfg] diff --git a/backend/src/app/http/awsns.clj b/backend/src/app/http/awsns.clj index 117d702bc..1a937e444 100644 --- a/backend/src/app/http/awsns.clj +++ b/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 [_] - (s/keys :req [::http/client - ::setup/props - ::db/pool])) +(defmethod ig/assert-key ::routes + [_ params] + (assert (http/client? (::http/client params)) "expect a valid http client") + (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] diff --git a/backend/src/app/http/client.clj b/backend/src/app/http/client.clj index 4494a1bb0..456d66ae1 100644 --- a/backend/src/app/http/client.clj +++ b/backend/src/app/http/client.clj @@ -7,20 +7,20 @@ (ns app.http.client "Http client abstraction layer." (:require - [app.common.spec :as us] - [clojure.spec.alpha :as s] + [app.common.schema :as sm] [integrant.core :as ig] [java-http-clj.core :as http] [promesa.core :as p]) (:import java.net.http.HttpClient)) -(s/def ::client #(instance? HttpClient %)) -(s/def ::client-holder - (s/keys :req [::client])) +(defn client? + [o] + (instance? HttpClient o)) -(defmethod ig/pre-init-spec ::client [_] - (s/keys :req [])) +(sm/register! + {: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 diff --git a/backend/src/app/http/debug.clj b/backend/src/app/http/debug.clj index fa9120f21..279e36f0e 100644 --- a/backend/src/app/http/debug.clj +++ b/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 [_] - (s/keys :req [::db/pool ::session/manager])) +(defmethod ig/assert-key ::routes + [_ 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}] diff --git a/backend/src/app/http/session.clj b/backend/src/app/http/session.clj index 3c379bb1c..11530f351 100644 --- a/backend/src/app/http/session.clj +++ b/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 - (s/keys :req-un [::user-agent - ::profile-id - ::created-at])) +(def ^:private schema:params + [:map {:title "session-params"} + [:user-agent ::sm/text] + [: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) - (us/assert! ::session-params params) + (assert (string? key) "expected key to be a string") + (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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::manager + [_ 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) - (us/assert! ::us/uuid profile-id) + (assert (manager? manager) "expected valid session manager") + (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 [_] - (s/keys :req [::db/pool] - :opt [::tasks/max-age])) +(defmethod ig/assert-key ::tasks/gc + [_ params] + (assert (db/pool? (::db/pool params)) "expected valid database pool") + (assert (dt/duration? (::tasks/max-age params)))) -(defmethod ig/prep-key ::tasks/gc - [_ cfg] +(defmethod ig/expand-key ::tasks/gc + [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 diff --git a/backend/src/app/http/websocket.clj b/backend/src/app/http/websocket.clj index 31cac2a56..bcedf31ce 100644 --- a/backend/src/app/http/websocket.clj +++ b/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 - ::mtx/metrics - ::db/pool - ::session/manager])) -(s/def ::routes vector?) +(def ^:private schema:routes-params + [:map + ::mbus/msgbus + ::mtx/metrics + ::db/pool + ::session/manager]) + +(defmethod ig/assert-key ::routes + [_ params] + (assert (sm/valid? schema:routes-params params))) (defmethod ig/init-key ::routes [_ cfg] diff --git a/backend/src/app/loggers/audit.clj b/backend/src/app/loggers/audit.clj index 6b1e7ea28..88e506f22 100644 --- a/backend/src/app/loggers/audit.clj +++ b/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] - [integrant.core :as ig])) + [cuerdas.core :as str])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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) -(s/def ::name ::us/string) -(s/def ::type ::us/string) -(s/def ::props (s/map-of ::us/keyword any?)) -(s/def ::ip-addr ::us/string) +(def ^:private schema:event + [:map {:title "event"} + [::type ::sm/text] + [::name ::sm/text] + [::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) -(s/def ::webhooks/batch-timeout ::dt/duration) -(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)) +(def ^:private check-event + (sm/check-fn schema:event)) (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)] - (us/verify! ::event event) + (let [event (-> (d/without-nils event) + (check-event))] (db/run! cfg (fn [cfg] (let [tnow (dt/now) params (-> (event->params event) diff --git a/backend/src/app/loggers/audit/archive_task.clj b/backend/src/app/loggers/audit/archive_task.clj index 046fb8068..fd745f8d6 100644 --- a/backend/src/app/loggers/audit/archive_task.clj +++ b/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 [_] - (s/keys :req [::db/pool ::setup/props ::http/client])) +(def ^:private schema:handler-params + [: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] diff --git a/backend/src/app/loggers/audit/gc_task.clj b/backend/src/app/loggers/audit/gc_task.clj index 7f94217a4..185daad3c 100644 --- a/backend/src/app/loggers/audit/gc_task.clj +++ b/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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::handler + [_ params] + (assert (db/pool? (::db/pool params)) "valid database pool expected")) (defmethod ig/init-key ::handler [_ cfg] diff --git a/backend/src/app/loggers/database.clj b/backend/src/app/loggers/database.clj index bf9e9e3f9..476180be0 100644 --- a/backend/src/app/loggers/database.clj +++ b/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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::reporter + [_ params] + (assert (db/pool? (::db/pool params)) "expect valid database pool")) (defmethod ig/init-key ::reporter [_ cfg] diff --git a/backend/src/app/loggers/mattermost.clj b/backend/src/app/loggers/mattermost.clj index 32fff185b..530eb4a0a 100644 --- a/backend/src/app/loggers/mattermost.clj +++ b/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 [_] - (s/keys :req [::http/client])) +(defmethod ig/assert-key ::reporter + [_ params] + (assert (http/client? (::http/client params)) "expect valid http client")) (defmethod ig/init-key ::reporter [_ cfg] diff --git a/backend/src/app/loggers/webhooks.clj b/backend/src/app/loggers/webhooks.clj index 4bcd2b009..9d2892dd7 100644 --- a/backend/src/app/loggers/webhooks.clj +++ b/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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::process-event-handler + [_ 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 [_] - (s/keys :req [::http/client ::db/pool])) +(defmethod ig/assert-key ::run-webhook-handler + [_ 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 - [_ cfg] - (merge {::max-errors 3} (d/without-nils cfg))) +(defmethod ig/expand-key ::run-webhook-handler + [k v] + {k (merge {::max-errors 3} (d/without-nils v))}) (defmethod ig/init-key ::run-webhook-handler [_ {:keys [::db/pool ::max-errors] :as cfg}] diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj index 071890663..1ad2fcc4c 100644 --- a/backend/src/app/main.clj +++ b/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 - {::mtx/metrics (ig/ref ::mtx/metrics) - ::wrk/executor (ig/ref ::wrk/executor)} + ::rpc/climit + {::mtx/metrics (ig/ref ::mtx/metrics) + ::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) - ::mtx/metrics (ig/ref ::mtx/metrics)} + {::email/sendmail (ig/ref ::email/sendmail)} :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*] - (println "==== ERROR ====")) - (.printStackTrace cause) - (when-let [cause' (ex-cause cause)] - (binding [*out* *err*] - (println "==== CAUSE ====")) - (.printStackTrace cause')) + (ex/print-throwable cause) (px/sleep 500) (System/exit -1)))) diff --git a/backend/src/app/media.clj b/backend/src/app/media.clj index 56fd53bfc..bd1c1e1b8 100644 --- a/backend/src/app/media.clj +++ b/backend/src/app/media.clj @@ -46,14 +46,15 @@ (s/keys :req-un [::path] :opt-un [::mtype])) -(sm/register! ::upload - [:map {:title "Upload"} - [:filename :string] - [:size ::sm/int] - [:path ::fs/path] - [:mtype {:optional true} :string] - [:headers {:optional true} - [:map-of :string :string]]]) +(sm/register! + ^{::sm/type ::upload} + [:map {:title "Upload"} + [:filename :string] + [:size ::sm/int] + [:path ::fs/path] + [:mtype {:optional true} :string] + [:headers {:optional true} + [:map-of :string :string]]]) (defn validate-media-type! ([upload] (validate-media-type! upload cm/valid-image-types)) diff --git a/backend/src/app/metrics.clj b/backend/src/app/metrics.clj index 3848c0773..1c7456b7a 100644 --- a/backend/src/app/metrics.clj +++ b/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?) -(s/def ::mdef/help string?) -(s/def ::mdef/labels (s/every string? :kind vector?)) -(s/def ::mdef/type #{:gauge :counter :summary :histogram}) +(sm/register! + {:type ::collector + :pred #(instance? SimpleCollector %) + :type-properties + {:title "collector" + :description "An instance of SimpleCollector"}}) -(s/def ::mdef/instance - #(instance? SimpleCollector %)) +(sm/register! + {:type ::registry + :pred #(instance? CollectorRegistry %) + :type-properties + {:title "Metrics Registry" + :description "Instance of CollectorRegistry"}}) -(s/def ::mdef/definition - (s/keys :req [::mdef/name - ::mdef/help - ::mdef/type] - :opt [::mdef/labels - ::mdef/instance])) +(def ^:private schema:definitions + [:map-of :keyword + [:map {:title "definition"} + [::mdef/name :string] + [::mdef/help :string] + [::mdef/type [:enum :gauge :counter :summary :histogram]] + [::mdef/labels {:optional true} [::sm/vec :string]] + [::mdef/instance {:optional true} ::collector]]]) -(s/def ::definitions - (s/map-of keyword? ::mdef/definition)) +(defn metrics? + [o] + (satisfies? IMetrics o)) -(s/def ::registry - #(instance? CollectorRegistry %)) +(sm/register! + {:type ::metrics + :pred metrics?}) -(s/def ::handler fn?) -(s/def ::metrics - (s/keys :req [::registry - ::handler - ::definitions])) +(def ^:private valid-definitions? + (sm/validator schema:definitions)) -(s/def ::default ::definitions) - -(defmethod ig/pre-init-spec ::metrics [_] - (s/keys :req-un [::default])) +(defmethod ig/assert-key ::metrics + [_ {:keys [default]}] + (assert (valid-definitions? default) "expected valid definitions")) (defmethod ig/init-key ::metrics [_ cfg] @@ -81,12 +91,14 @@ {} (:default cfg))] - (us/verify! ::definitions definitions) - - {::handler (partial handler registry) - ::definitions definitions - ::registry registry})) - + (reify + IMetrics + (get-handler [_] + (partial handler 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)})) - - -(s/def ::routes vector?) -(defmethod ig/pre-init-spec ::routes [_] - (s/keys :req [::metrics])) +(defmethod ig/assert-key ::routes + [_ {:keys [::metrics]}] + (assert (metrics? metrics) "expected a valid instance for metrics")) (defmethod ig/init-key ::routes [_ {:keys [::metrics]}] - (let [registry (::registry metrics)] - ["/metrics" {:handler (partial handler registry) - :allowed-methods #{:get}}])) + ["/metrics" {:handler (get-handler metrics) + :allowed-methods #{:get}}]) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation @@ -126,8 +135,9 @@ (defmulti create-collector ::mdef/type) (defn run! - [{:keys [::definitions]} & {:keys [id] :as params}] - (when-let [mobj (get definitions id)] + [instance & {:keys [id] :as params}] + (assert (metrics? instance) "expected valid metrics instance") + (when-let [mobj (get-collector instance id)] (run-collector! mobj params) true)) diff --git a/backend/src/app/migrations.clj b/backend/src/app/migrations.clj index 5c89f83e2..566095a19 100644 --- a/backend/src/app/migrations.clj +++ b/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 @@ -435,9 +434,9 @@ (mg/setup! conn) (mg/migrate! conn {:name name :steps migrations}))) -(defmethod ig/pre-init-spec ::migrations - [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::migrations + [_ {:keys [::db/pool]}] + (assert (db/pool? pool) "expected valid pool")) (defmethod ig/init-key ::migrations [module {:keys [::db/pool]}] diff --git a/backend/src/app/msgbus.clj b/backend/src/app/msgbus.clj index 4852734c0..11de69541 100644 --- a/backend/src/app/msgbus.clj +++ b/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-sub!) -(declare ^:private redis-unsub!) -(declare ^:private start-io-loop!) +(declare ^:private redis-pub) +(declare ^:private redis-sub) +(declare ^:private redis-unsub) +(declare ^:private start-io-loop) (declare ^:private subscribe-to-topics) (declare ^:private unsubscribe-channels) -(s/def ::cmd-ch sp/chan?) -(s/def ::rcv-ch sp/chan?) -(s/def ::pub-ch sp/chan?) -(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])) +(defn msgbus? + [o] + (satisfies? IMsgBus o)) -(defmethod ig/pre-init-spec ::msgbus [_] - (s/keys :req [::rds/redis ::wrk/executor])) +(sm/register! + {:type ::msgbus + :pred msgbus?}) -(defmethod ig/prep-key ::msgbus - [_ cfg] - (-> cfg - (assoc ::buffer-size 128) - (assoc ::timeout (dt/duration {:seconds 30})))) +(defmethod ig/expand-key ::msgbus + [k v] + {k (-> (d/without-nils v) + (assoc ::buffer-size 128) + (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 ::wrk/executor executor))] + (assoc ::state state)) - (set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/sync? true)) - (set-error-mode! state :continue) + io-thr (start-io-loop cfg)] - (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] - (px/interrupt! (::io-thr msgbus)) - (sp/close! (::cmd-ch msgbus)) - (sp/close! (::rcv-ch msgbus)) - (sp/close! (::pub-ch msgbus)) - (d/close! (::pconn msgbus)) - (d/close! (::sconn msgbus))) + [_ instance] + (d/close! instance)) (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)) - (send-via executor state subscribe-to-topics cfg topics chan) + (-sub instance topics chan) nil)) (defn pub! - [{::keys [pub-ch]} & {:keys [topic] :as params}] - (let [params (update params :message assoc :topic topic)] - (sp/put! pub-ch params))) + [instance & {:keys [topic message]}] + (assert (satisfies? IMsgBus instance) "expected valid msgbus instance") + (-pub instance topic message)) (defn purge! - [{:keys [::state ::wrk/executor] :as msgbus} chans] - (l/debug :hint "purge" :chans (count chans)) - (send-via executor state unsubscribe-channels msgbus chans) + [instance chans] + (assert (satisfies? IMsgBus instance) "expected valid msgbus instance") + (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 diff --git a/backend/src/app/redis.clj b/backend/src/app/redis.clj index 58023fe00..cabefd73c 100644 --- a/backend/src/app/redis.clj +++ b/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 shutdown-resources) -(declare connect*) +(declare ^:private initialize-resources) +(declare ^:private shutdown-resources) +(declare ^:private impl-eval) -(s/def ::timer - #(instance? Timer %)) +(defprotocol IRedis + (-connect [_ options]) + (-get-or-connect [_ key options])) -(s/def ::default-connection - #(or (instance? StatefulRedisConnection %) - (and (instance? IDeref %) - (instance? StatefulRedisConnection (deref %))))) +(defprotocol IConnection + (publish [_ topic message]) + (rpush [_ key payload]) + (blpop [_ timeout keys]) + (eval [_ script])) -(s/def ::pubsub-connection - #(or (instance? StatefulRedisPubSubConnection %) - (and (instance? IDeref %) - (instance? StatefulRedisPubSubConnection (deref %))))) - -(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)) +(defprotocol IPubSubConnection + (add-listener [_ listener]) + (subscribe [_ topics]) + (unsubscribe [_ topics])) (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 - [{:keys [::wrk/executor] :as cfg}] - (letfn [(on-remove [key val cause] - (l/trace :hint "evict connection (cache)" :key key :reason cause) - (some-> val d/close!))] - (cache/create :executor executor - :on-remove on-remove - :keepalive "5m"))) +(sm/register! + {:type ::connection + :pred #(satisfies? IConnection %) + :type-properties + {:title "connection" + :description "redis connection instance"}}) + +(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}] - (l/info :hint "initialize redis resources" - :uri uri - :io-threads io-threads - :worker-threads worker-threads - :connect? connect?) + [{:keys [::uri ::io-threads ::worker-threads ::wrk/executor ::mtx/metrics] :as params}] + + (l/inf :hint "initialize redis resources" + :uri (str uri) + :io-threads io-threads + :worker-threads worker-threads) (let [timer (HashedWheelTimer.) resources (.. (DefaultClientResources/builder) @@ -158,147 +155,134 @@ (timer ^Timer timer) (build)) - redis-uri (RedisURI/create ^String uri) - cfg (-> cfg - (assoc ::resources resources) - (assoc ::timer timer) - (assoc ::redis-uri redis-uri))] + redis-uri (RedisURI/create ^String (str 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 - [{:keys [::resources ::cache ::timer]}] - (cache/invalidate! cache) + on-remove (fn [key val cause] + (l/trace :hint "evict connection (cache)" :key key :reason cause) + (some-> val d/close!)) - (when resources - (.shutdown ^ClientResources resources)) - - (when timer - (.stop ^Timer timer))) - -(defn connect* - [{:keys [::resources ::redis-uri] :as state} - {:keys [timeout codec type] - :or {codec default-codec type :default}}] - - (us/assert! ::resources resources) - (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) + cache (cache/create :executor executor + :on-remove on-remove + :keepalive "5m")] (reify - IDeref - (deref [_] conn) - - AutoCloseable + java.lang.AutoCloseable (close [_] - (ex/ignoring (.close ^StatefulConnection conn)) - (ex/ignoring (.shutdown ^RedisClient client)) - (l/trc :hint "disconnect" :hid (hash client)))))) + (ex/ignoring (cache/invalidate! cache)) + (ex/ignoring (.shutdown ^ClientResources resources)) + (ex/ignoring (.stop ^Timer timer))) + + IRedis + (-get-or-connect [this key options] + (let [create (fn [_] (-connect this options))] + (cache/get cache key create))) + + (-connect [_ options] + (let [timeout (or (:timeout options) (::timeout params)) + codec (get options :codec default-codec) + type (get options :type :default) + client (RedisClient/create ^ClientResources resources + ^RedisURI redis-uri)] + + (l/trc :hint "connect" :hid (hash client)) + (if (= type :pubsub) + (let [conn (.connectPubSub ^RedisClient client + ^RedisCodec codec)] + (.setTimeout ^StatefulConnection conn + ^Duration timeout) + (reify + IPubSubConnection + (add-listener [_ listener] + (assert (instance? RedisPubSubListener listener) "expected listener instance") + (.addListener ^StatefulRedisPubSubConnection conn + ^RedisPubSubListener listener)) + + (subscribe [_ topics] + (try + (let [topics (into-array String (map str topics)) + cmd (.sync ^StatefulRedisPubSubConnection conn)] + (.subscribe ^RedisPubSubCommands cmd topics)) + (catch RedisCommandInterruptedException cause + (throw (InterruptedException. (ex-message cause)))))) + + (unsubscribe [_ topics] + (try + (let [topics (into-array String (map str topics)) + cmd (.sync ^StatefulRedisPubSubConnection conn)] + (.unsubscribe ^RedisPubSubCommands cmd topics)) + (catch RedisCommandInterruptedException cause + (throw (InterruptedException. (ex-message cause)))))) + + + AutoCloseable + (close [_] (shutdown client conn)))) + + (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 conn) + data (if (vector? payload) payload [payload]) + vals (make-array (. Class (forName "[B")) (count data))] + + (loop [i 0 xs (seq data)] + (when xs + (aset ^"[[B" vals i ^bytes (first xs)) + (recur (inc i) (next xs)))) + + (.rpush ^RedisCommands cmd + ^String key + ^"[[B" vals)) + + (catch RedisCommandInterruptedException cause + (throw (InterruptedException. (ex-message cause)))))) + + (blpop [_ timeout keys] + (try + (let [keys (into-array Object (map str keys)) + cmd (.sync ^StatefulRedisConnection conn) + timeout (/ (double (inst-ms timeout)) 1000.0)] + (when-let [res (.blpop ^RedisCommands cmd + ^double timeout + ^"[Ljava.lang.String;" keys)] + (MapEntry/create + (.getKey ^KeyValue res) + (.getValue ^KeyValue res)))) + (catch RedisCommandInterruptedException cause + (throw (InterruptedException. (ex-message cause)))))) + + (eval [_ script] + (assert (valid-script? script) "expected valid script") + (impl-eval conn metrics script)) + + AutoCloseable + (close [_] (shutdown client conn)))))))))) (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)))))) + [instance & {:as opts}] + (assert (satisfies? IRedis instance) "expected valid redis instance") + (-connect instance opts)) (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)] - (.subscribe ^RedisPubSubCommands cmd topics)) - (catch RedisCommandInterruptedException cause - (throw (InterruptedException. (ex-message cause)))))) - -(defn unsubscribe! - "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)] - (.unsubscribe ^RedisPubSubCommands cmd topics)) - (catch RedisCommandInterruptedException cause - (throw (InterruptedException. (ex-message cause)))))) - -(defn rpush! - [{:keys [::connection]} key payload] - (us/assert! ::default-connection connection) - (us/assert! (or (and (vector? payload) - (every? bytes? payload)) - (bytes? payload))) - (try - (let [cmd (.sync ^StatefulRedisConnection @connection) - data (if (vector? payload) payload [payload]) - vals (make-array (. Class (forName "[B")) (count data))] - - (loop [i 0 xs (seq data)] - (when xs - (aset ^"[[B" vals i ^bytes (first xs)) - (recur (inc i) (next xs)))) - - (.rpush ^RedisCommands cmd - ^String key - ^"[[B" vals)) - - (catch RedisCommandInterruptedException cause - (throw (InterruptedException. (ex-message cause)))))) - -(defn blpop! - [{:keys [::connection]} timeout & keys] - (us/assert! ::default-connection connection) - (try - (let [keys (into-array Object (map str keys)) - cmd (.sync ^StatefulRedisConnection @connection) - timeout (/ (double (inst-ms timeout)) 1000.0)] - (when-let [res (.blpop ^RedisCommands cmd - ^double timeout - ^"[Ljava.lang.String;" keys)] - (MapEntry/create - (.getKey ^KeyValue res) - (.getValue ^KeyValue res)))) - (catch RedisCommandInterruptedException cause - (throw (InterruptedException. (ex-message cause)))))) - -(defn open? - [{:keys [::connection]}] - (us/assert! ::pubsub-connection connection) - (.isOpen ^StatefulConnection @connection)) + [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?) -(s/def ::rscript/path ::us/not-empty-string) -(s/def ::rscript/keys (s/every any? :kind vector?)) -(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) +(defn- impl-eval + [^StatefulRedisConnection connection metrics 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)] diff --git a/backend/src/app/rpc.clj b/backend/src/app/rpc.clj index d0c3bbcff..bd902b154 100644 --- a/backend/src/app/rpc.clj +++ b/backend/src/app/rpc.clj @@ -257,33 +257,42 @@ (map (partial process-method cfg)) (into {})))) -(defmethod ig/pre-init-spec ::methods [_] - (s/keys :req [::session/manager - ::http.client/client - ::db/pool - ::mbus/msgbus - ::ldap/provider - ::sto/storage - ::mtx/metrics - ::setup/props] - :opt [::climit - ::rlimit])) +(def ^:private schema:methods-params + [:map {:title "methods-params"} + ::session/manager + ::http.client/client + ::db/pool + ::mbus/msgbus + ::ldap/provider + ::sto/storage + ::mtx/metrics + [::climit [:maybe ::climit]] + [::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 - (s/map-of keyword? (s/tuple map? fn?))) +(def ^:private schema:methods + [:map-of :keyword [:tuple :map ::sm/fn]]) -(s/def ::routes vector?) +(sm/register! ::methods schema:methods) -(defmethod ig/pre-init-spec ::routes [_] - (s/keys :req [::methods - ::db/pool - ::setup/props - ::session/manager])) +(def ^:private valid-methods? + (sm/validator schema:methods)) + +(defmethod ig/assert-key ::routes + [_ 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}] diff --git a/backend/src/app/rpc/climit.clj b/backend/src/app/rpc/climit.clj index 3ca348e0b..bb3db5ba5 100644 --- a/backend/src/app/rpc/climit.clj +++ b/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.config :as cf] + [app.common.schema :as sm] [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]] - (l/trc :hint "created" :id (id->str id skey)) + [config id] + (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! - [action req-id stats limit-id limit-label params elapsed] +(defn- prepare-params-for-debug + [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]) - (set/rename-keys {::rpc/profile-id :profile-id}) - (update-vals str))))) + :params @limit-params))) (def ^:private idseq (AtomicLong. 0)) -(defn- invoke - [limiter metrics limit-id limit-key limit-label handler params] - (let [tpoint (dt/tpoint) - mlabels (into-array String [(id->str limit-id)]) - limit-id (id->str limit-id limit-key) - stats (pbh/get-stats limiter) - req-id (.incrementAndGet ^AtomicLong idseq)] +(defn- impl-invoke + [metrics cache config handler] + (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) + limiter (cache/get cache limit-id (partial create-limiter config)) + tpoint (dt/tpoint) + req-id (.incrementAndGet ^AtomicLong idseq)] (try - (measure! metrics mlabels stats nil) - (log! "enqueued" req-id stats limit-id limit-label params nil) + (let [stats (pbh/get-stats limiter)] + (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) - (log! "acquired" req-id stats limit-id limit-label params elapsed) - - (handler params)))) + (measure metrics mlabels stats elapsed) + (log "acquired" req-id stats limit-id limit-label limit-params elapsed) + (handler)))) (catch ExceptionInfo cause (let [{:keys [type code]} (ex-data cause)] (if (= :bulkhead-error type) - (let [elapsed (tpoint)] - (log! "rejected" req-id stats limit-id limit-label params elapsed) + (let [elapsed (tpoint) + 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) - (log! "finished" req-id stats limit-id limit-label params elapsed)))))) + (measure metrics mlabels stats nil) + (log "finished" req-id stats limit-id limit-label limit-params elapsed)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; MIDDLEWARE @@ -204,71 +232,70 @@ (throw (IllegalArgumentException. "unable to normalize limit"))))) (defn wrap - [{:keys [::rpc/climit ::mtx/metrics]} handler mdata] - (let [cache (::cache climit) - config (::config climit) - label (::sv/name mdata)] + [cfg handler {label ::sv/name :as mdata}] + (if-let [climit (::rpc/climit cfg)] + (reduce (fn [handler [limit-id key-fn]] + (if-let [config (get-config climit limit-id)] + (let [key-fn (or key-fn noop-fn)] + (l/trc :hint "instrumenting method" + :method label + :limit (id->str limit-id) + :timeout (:timeout config) + :permits (:permits config) + :queue (:queue config) + :keyed (not= key-fn nil)) - (if climit - (reduce (fn [handler [limit-id key-fn]] - (if-let [config (get config limit-id)] - (let [key-fn (or key-fn noop-fn)] - (l/trc :hint "instrumenting method" - :method label - :limit (id->str limit-id) - :timeout (:timeout config) - :permits (:permits config) - :queue (:queue config) - :keyed (not= key-fn noop-fn)) + (if (and (= key-fn ::rpc/profile-id) + (false? (::rpc/auth mdata true))) - (if (and (= key-fn ::rpc/profile-id) - (false? (::rpc/auth mdata true))) + ;; We don't enforce by-profile limit on methods that does + ;; not require authentication + handler - ;; We don't enforce by-profile limit on methods that does - ;; not require authentication - handler + (fn [cfg params] + (let [config (-> config + (assoc ::key (key-fn params)) + (assoc ::label label) + ;; NOTE: only used for debugging output + (assoc ::params params))] + (invoke climit config (partial handler cfg params)))))) - (fn [cfg params] - (let [limit-key (key-fn params) - cache-key [limit-id limit-key] - limiter (cache/get cache cache-key (partial create-limiter config)) - handler (partial handler cfg)] - (invoke limiter metrics limit-id limit-key label handler params))))) + (do + (l/wrn :hint "no config found for specified queue" :id (id->str limit-id)) + handler))) + handler + (concat global-limits (get-limits mdata))) - (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] - (let [config (get climit ::config) - cache (get climit ::cache)] - (reduce (fn [handler [limit-id limit-key :as ckey]] - (if-let [config (get config limit-id)] + [{:keys [::label ::rpc/climit] :as cfg} f] + (reduce (fn [handler [limit-id limit-key]] + (if-let [config (get-config climit limit-id)] + (let [config (-> config + (assoc ::key limit-key) + (assoc ::label label))] (fn [cfg params] - (let [limiter (cache/get cache ckey (partial create-limiter config)) - handler (partial handler cfg)] - (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)))) + (let [config (assoc config ::params params)] + (invoke climit config (partial handler cfg params))))) + (do + (l/wrn :hint "config not found" :label label :id limit-id) + f))) + f + (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] - (let [f (if (some? executor) - (fn [cfg params] (px/await! (px/submit! executor (fn [] (f cfg params))))) - f) - f (build-exec-chain cfg f)] + [{: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)] + (build-exec-chain cfg f)) + f)] (f cfg params))) diff --git a/backend/src/app/rpc/doc.clj b/backend/src/app/rpc/doc.clj index a4021102f..217e86332 100644 --- a/backend/src/app/rpc/doc.clj +++ b/backend/src/app/rpc/doc.clj @@ -202,10 +202,9 @@ ;; MODULE INIT ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(s/def ::routes vector?) - -(defmethod ig/pre-init-spec ::routes [_] - (s/keys :req-un [::rpc/methods])) +(defmethod ig/assert-key ::routes + [_ params] + (assert (sm/valid? ::rpc/methods (::rpc/methods params)) "expected valid methods")) (defmethod ig/init-key ::routes [_ {:keys [methods] :as cfg}] diff --git a/backend/src/app/rpc/permissions.clj b/backend/src/app/rpc/permissions.clj index 0704d70ed..e1411a981 100644 --- a/backend/src/app/rpc/permissions.clj +++ b/backend/src/app/rpc/permissions.clj @@ -8,25 +8,24 @@ "A permission checking helper factories." (:require [app.common.exceptions :as ex] - [app.common.schema :as sm] - [app.common.spec :as us] - [clojure.spec.alpha :as s])) + [app.common.schema :as sm])) -(sm/register! ::permissions - [:map {:title "Permissions"} - [:type {:gen/elements [:membership :share-link]} :keyword] - [:is-owner ::sm/boolean] - [:is-admin ::sm/boolean] - [:can-edit ::sm/boolean] - [:can-read ::sm/boolean] - [:is-logged ::sm/boolean]]) +(sm/register! + ^{::sm/type ::permissions} + [:map {:title "Permissions"} + [:type {:gen/elements [:membership :share-link]} :keyword] + [:is-owner ::sm/boolean] + [:is-admin ::sm/boolean] + [:can-edit ::sm/boolean] + [:can-read ::sm/boolean] + [:is-logged ::sm/boolean]]) - -(s/def ::role #{:admin :owner :editor :viewer}) +(def valid-roles + #{: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"))) diff --git a/backend/src/app/rpc/rlimit.clj b/backend/src/app/rpc/rlimit.clj index 4e0924490..67b8b2ef8 100644 --- a/backend/src/app/rpc/rlimit.clj +++ b/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) - (us/assert! ::rds/redis redis) + (assert (rds/redis? redis) "expected a valid redis instance") + (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})) -(s/def ::capacity ::us/integer) -(s/def ::rate ::us/integer) -(s/def ::interval ::dt/duration) -(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) +(def ^:private schema:config + [:map-of + [:or :keyword [:set :keyword]] + [:vector schema:limit-tuple]]) -(s/def ::limit-tuple - (s/tuple ::us/keyword ::strategy string?)) +(def ^:private check-config + (sm/check-fn schema:config)) -(s/def ::limits - (s/map-of keyword? (s/every ::limit :kind vector?))) +(def ^:private check-refresh + (sm/check-fn ::dt/duration)) -(s/def ::limit - (s/and - (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?))) +(def ^:private check-limits + (sm/check-fn schema:limits)) (defn read-config [path] @@ -336,13 +350,9 @@ {} config)))] - (when-let [config (some->> path slurp edn/read-string)] - (us/verify! ::config config) - (let [refresh (->> config meta :refresh dt/duration) - limits (->> config compile-pass-1 compile-pass-2)] - - (us/verify! ::limits limits) - (us/verify! ::refresh refresh) + (when-let [config (some->> path slurp edn/read-string check-config)] + (let [refresh (->> config meta :refresh dt/duration check-refresh) + limits (->> config compile-pass-1 compile-pass-2 check-limits)] {::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 [_] - (s/keys :req [::wrk/executor])) +(defmethod ig/assert-key :app.rpc/rlimit + [_ {:keys [::wrk/executor]}] + (assert (sm/valid? ::wrk/executor executor) "expect valid executor")) (defmethod ig/init-key ::rpc/rlimit [_ {:keys [::wrk/executor] :as cfg}] diff --git a/backend/src/app/setup.clj b/backend/src/app/setup.clj index 68df58330..8e2733c6d 100644 --- a/backend/src/app/setup.clj +++ b/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) -(s/def ::props (s/map-of ::us/keyword some?)) - -(defmethod ig/pre-init-spec ::props [_] - (s/keys :req [::db/pool] - :opt [::key])) +(defmethod ig/assert-key ::props + [_ params] + (assert (db/pool? (::db/pool params)) "expected valid database pool") + (assert (string? (::key params)) "expected valid key string")) (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) diff --git a/backend/src/app/srepl.clj b/backend/src/app/srepl.clj index 1a87bcf7d..fb53ca1e2 100644 --- a/backend/src/app/srepl.clj +++ b/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) -(s/def ::host ::us/not-empty-string) +(defmethod ig/assert-key ::server + [_ params] + (assert (int? (::port params)) "expected valid port") + (assert (string? (::host params)) "expected valid host")) -(defmethod ig/pre-init-spec ::server - [_] - (s/keys :req [::host ::port])) - -(defmethod ig/prep-key ::server - [[type _] cfg] - (assoc cfg ::flag (keyword (str (name type) "-server")))) +(defmethod ig/expand-key ::server + [[type :as k] v] + {k (assoc v ::flag (keyword (str (name type) "-server")))}) (defmethod ig/init-key ::server [[type _] {:keys [::flag ::port ::host] :as cfg}] diff --git a/backend/src/app/storage.clj b/backend/src/app/storage.clj index 47cf8ca2d..fd573079f 100644 --- a/backend/src/app/storage.clj +++ b/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}) -(s/def ::s3 ::ss3/backend) -(s/def ::fs ::sfs/backend) -(s/def ::type #{:fs :s3}) +(def ^:private schema:backends + [:map-of :keyword + [:maybe + [:or ::ss3/backend ::sfs/backend]]]) -(s/def ::backends - (s/map-of ::us/keyword - (s/nilable - (s/or :s3 ::ss3/backend - :fs ::sfs/backend)))) +(def ^:private valid-backends? + (sm/validator schema:backends)) -(defmethod ig/pre-init-spec ::storage [_] - (s/keys :req [::db/pool ::backends])) +(def ^:private schema:storage + [: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 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -200,15 +201,16 @@ (dm/export impl/object?) (defn get-object - [{:keys [::db/connectable] :as storage} id] - (us/assert! ::storage storage) + [{:keys [::db/connectable] :as storage} id] + (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) - (us/assert! ::impl/content content) + (assert (valid-storage? storage)) + (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 diff --git a/backend/src/app/storage/fs.clj b/backend/src/app/storage/fs.clj index a6d8a9ea5..f3b12b50a 100644 --- a/backend/src/app/storage/fs.clj +++ b/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/pre-init-spec ::backend [_] - (s/keys :opt [::directory])) +(defmethod ig/assert-key ::backend + [_ params] + ;; FIXME: path (?) + (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?) -(s/def ::backend - (s/keys :req [::directory - ::uri] - :opt [::sto/type - ::sto/id])) +(def ^:private schema:backend + [:map {:title "fs-backend"} + [::directory :string] + [::uri ::sm/uri] + [::sto/type [:= :fs]]]) + +(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)) diff --git a/backend/src/app/storage/gc_deleted.clj b/backend/src/app/storage/gc_deleted.clj index 7f903b000..369ddc11b 100644 --- a/backend/src/app/storage/gc_deleted.clj +++ b/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 [_] - (s/keys :req [::sto/storage ::db/pool])) - -(defmethod ig/prep-key ::handler - [_ cfg] - (assoc cfg ::min-age (dt/duration {:hours 2}))) +(defmethod ig/expand-key ::handler + [k v] + {k (assoc v ::min-age (dt/duration {:hours 2}))}) (defmethod ig/init-key ::handler [_ {:keys [::min-age] :as cfg}] diff --git a/backend/src/app/storage/gc_touched.clj b/backend/src/app/storage/gc_touched.clj index 03fe0f426..45d459429 100644 --- a/backend/src/app/storage/gc_touched.clj +++ b/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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::handler + [_ params] + (assert (db/pool? (::db/pool params)) "expect valid storage")) (defmethod ig/init-key ::handler [_ cfg] diff --git a/backend/src/app/storage/impl.clj b/backend/src/app/storage/impl.clj index 6de48b682..1ad389583 100644 --- a/backend/src/app/storage/impl.clj +++ b/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?) - - diff --git a/backend/src/app/storage/s3.clj b/backend/src/app/storage/s3.clj index 2adde671f..36fccd120 100644 --- a/backend/src/app/storage/s3.clj +++ b/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) -(s/def ::bucket ::us/string) -(s/def ::prefix ::us/string) -(s/def ::endpoint ::us/string) -(s/def ::io-threads ::us/integer) +(def ^:private schema:config + [:map {:title "s3-backend-config"} + ::wrk/executor + [::region {:optional true} :keyword] + [::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 [_] - (s/keys :opt [::region ::bucket ::prefix ::endpoint ::io-threads ::wrk/executor])) +(defmethod ig/expand-key ::backend + [k v] + {k (merge {::region :eu-central-1} (d/without-nils v))}) -(defmethod ig/prep-key ::backend - [_ {:keys [::prefix ::region] :as cfg}] - (cond-> (d/without-nils cfg) - (some? prefix) (assoc ::prefix prefix) - (nil? region) (assoc ::region :eu-central-1))) +(defmethod ig/assert-key ::backend + [_ params] + (assert (sm/check schema:config params))) (defmethod ig/init-key ::backend - [_ cfg] - ;; Return a valid backend data structure only if all optional - ;; parameters are provided. - (when (and (contains? cfg ::region) - (string? (::bucket cfg))) - (let [client (build-s3-client cfg) - presigner (build-s3-presigner cfg)] - (assoc cfg + [_ params] + (when (and (contains? params ::region) + (contains? params ::bucket)) + (let [client (build-s3-client params) + presigner (build-s3-presigner params)] + (assoc params ::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 %)) -(s/def ::presigner #(instance? S3Presigner %)) -(s/def ::backend - (s/keys :req [::region - ::bucket - ::client - ::presigner] - :opt [::prefix - ::sto/id])) +(def ^:private schema:backend + [:map {:title "s3-backend"} + ;; [::region :keyword] + ;; [::bucket ::sm/text] + [::client [:fn #(instance? S3AsyncClient %)]] + [::presigner [:fn #(instance? S3Presigner %)]] + [::prefix {:optional true} ::sm/text] + #_[::sto/type [:= :s3]]]) + +(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))) diff --git a/backend/src/app/storage/tmp.clj b/backend/src/app/storage/tmp.clj index 376c6ae8b..2d03a030e 100644 --- a/backend/src/app/storage/tmp.clj +++ b/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 [_] - (s/keys :req [::wrk/executor])) +(defmethod ig/assert-key ::cleaner + [_ {:keys [::wrk/executor]}] + (assert (sm/valid? ::wrk/executor executor))) -(defmethod ig/prep-key ::cleaner - [_ cfg] - (assoc cfg ::min-age (dt/duration "60m"))) +(defmethod ig/expand-key ::cleaner + [k v] + {k (assoc v ::min-age (dt/duration "60m"))}) (defmethod ig/init-key ::cleaner [_ cfg] diff --git a/backend/src/app/tasks/delete_object.clj b/backend/src/app/tasks/delete_object.clj index 9c48d2309..b9939c8be 100644 --- a/backend/src/app/tasks/delete_object.clj +++ b/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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::handler + [_ params] + (assert (db/pool? (::db/pool params)) "expected a valid database pool")) (defmethod ig/init-key ::handler [_ cfg] diff --git a/backend/src/app/tasks/file_gc.clj b/backend/src/app/tasks/file_gc.clj index 279ab63dc..7e3c3ee27 100644 --- a/backend/src/app/tasks/file_gc.clj +++ b/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 [_] - (s/keys :req [::db/pool ::sto/storage])) +(defmethod ig/assert-key ::handler + [_ 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] diff --git a/backend/src/app/tasks/file_gc_scheduler.clj b/backend/src/app/tasks/file_gc_scheduler.clj index a133b6c41..dfa08ebcf 100644 --- a/backend/src/app/tasks/file_gc_scheduler.clj +++ b/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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::handler + [_ params] + (assert (db/pool? (::db/pool params)) "expected a valid database pool")) -(defmethod ig/prep-key ::handler - [_ cfg] - (assoc cfg ::min-age (cf/get-deletion-delay))) +(defmethod ig/expand-key ::handler + [k v] + {k (assoc v ::min-age (cf/get-deletion-delay))}) (defmethod ig/init-key ::handler [_ cfg] diff --git a/backend/src/app/tasks/file_xlog_gc.clj b/backend/src/app/tasks/file_xlog_gc.clj index f430e107d..f0654916c 100644 --- a/backend/src/app/tasks/file_xlog_gc.clj +++ b/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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::handler + [_ params] + (assert (db/pool? (::db/pool params)) "expected a valid database pool")) (defmethod ig/init-key ::handler [_ cfg] diff --git a/backend/src/app/tasks/objects_gc.clj b/backend/src/app/tasks/objects_gc.clj index 76fead713..e08bdce44 100644 --- a/backend/src/app/tasks/objects_gc.clj +++ b/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 [_] - (s/keys :req [::db/pool ::sto/storage])) +(defmethod ig/assert-key ::handler + [_ 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 - [_ cfg] - (assoc cfg - ::min-age (cf/get-deletion-delay) - ::chunk-size 50)) +(defmethod ig/expand-key ::handler + [k v] + {k (assoc v + ::min-age (cf/get-deletion-delay) + ::chunk-size 50)}) (defmethod ig/init-key ::handler [_ cfg] diff --git a/backend/src/app/tasks/offload_file_data.clj b/backend/src/app/tasks/offload_file_data.clj index cfe50970f..c6ea5b0f8 100644 --- a/backend/src/app/tasks/offload_file_data.clj +++ b/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 [_] - (s/keys :req [::db/pool ::sto/storage])) +(defmethod ig/assert-key ::handler + [_ 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] diff --git a/backend/src/app/tasks/tasks_gc.clj b/backend/src/app/tasks/tasks_gc.clj index 0e93ea0d0..839257e65 100644 --- a/backend/src/app/tasks/tasks_gc.clj +++ b/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 [_] - (s/keys :req [::db/pool])) +(defmethod ig/assert-key ::handler + [_ params] + (assert (db/pool? (::db/pool params)) "expected a valid database pool")) -(defmethod ig/prep-key ::handler - [_ cfg] - (assoc cfg ::min-age (cf/get-deletion-delay))) +(defmethod ig/expand-key ::handler + [k v] + {k (assoc v ::min-age (cf/get-deletion-delay))}) (defmethod ig/init-key ::handler [_ {:keys [::db/pool ::min-age] :as cfg}] diff --git a/backend/src/app/tasks/telemetry.clj b/backend/src/app/tasks/telemetry.clj index 204d6be0c..dd0d42c4c 100644 --- a/backend/src/app/tasks/telemetry.clj +++ b/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 [_] - (s/keys :req [::http/client - ::db/pool - ::setup/props])) +(defmethod ig/assert-key ::handler + [_ params] + (assert (http/client? (::http/client params)) "expected a valid http client") + (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}] diff --git a/backend/src/app/util/cache.clj b/backend/src/app/util/cache.clj index 65861e179..4cba3ae82 100644 --- a/backend/src/app/util/cache.clj +++ b/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"}}) diff --git a/backend/src/app/util/overrides.clj b/backend/src/app/util/overrides.clj index 71b2c0c23..a7a72ab28 100644 --- a/backend/src/app/util/overrides.clj +++ b/backend/src/app/util/overrides.clj @@ -25,15 +25,15 @@ clojure.lang.IPersistentMap clojure.lang.IDeref) -(sm/register! ::fs/path - {:type ::fs/path - :pred fs/path? - :type-properties - {:title "path" - :description "filesystem path" - :error/message "expected a valid fs path instance" - :error/code "errors.invalid-path" - :gen/gen (sg/generator :string) - :decode/string fs/path - ::oapi/type "string" - ::oapi/format "unix-path"}}) +(sm/register! + {:type ::fs/path + :pred fs/path? + :type-properties + {:title "path" + :description "filesystem path" + :error/message "expected a valid fs path instance" + :error/code "errors.invalid-path" + :gen/gen (sg/generator :string) + :decode/string fs/path + ::oapi/type "string" + ::oapi/format "unix-path"}}) diff --git a/backend/src/app/util/time.clj b/backend/src/app/util/time.clj index c451ef742..d2ffc4ef8 100644 --- a/backend/src/app/util/time.clj +++ b/backend/src/app/util/time.clj @@ -370,30 +370,30 @@ (let [p1 (System/nanoTime)] #(duration {:nanos (- (System/nanoTime) p1)}))) -(sm/register! ::instant - {:type ::instant - :pred instant? - :type-properties - {:error/message "should be an instant" - :title "instant" - :decode/string instant - :encode/string format-instant - :decode/json instant - :encode/json format-instant - :gen/gen (tgen/fmap (fn [i] (in-past i)) tgen/pos-int) - ::oapi/type "string" - ::oapi/format "iso"}}) +(sm/register! + {:type ::instant + :pred instant? + :type-properties + {:error/message "should be an instant" + :title "instant" + :decode/string instant + :encode/string format-instant + :decode/json instant + :encode/json format-instant + :gen/gen (tgen/fmap (fn [i] (in-past i)) tgen/pos-int) + ::oapi/type "string" + ::oapi/format "iso"}}) -(sm/register! ::duration - {:type :durations - :pred duration? - :type-properties - {:error/message "should be a duration" - :gen/gen (tgen/fmap duration tgen/pos-int) - :title "duration" - :decode/string duration - :encode/string format-duration - :decode/json duration - :encode/json format-duration - ::oapi/type "string" - ::oapi/format "duration"}}) +(sm/register! + {:type ::duration + :pred duration? + :type-properties + {:error/message "should be a duration" + :gen/gen (tgen/fmap duration tgen/pos-int) + :title "duration" + :decode/string duration + :encode/string format-duration + :decode/json duration + :encode/json format-duration + ::oapi/type "string" + ::oapi/format "duration"}}) diff --git a/backend/src/app/worker.clj b/backend/src/app/worker.clj index 06b5c6a48..a7eaf836f 100644 --- a/backend/src/app/worker.clj +++ b/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?)) -(s/def ::tasks (s/map-of keyword? fn?)) +(def ^:private schema:tasks + [:map-of :keyword ::sm/fn]) -(defmethod ig/pre-init-spec ::registry [_] - (s/keys :req [::mtx/metrics ::tasks])) +(def ^:private valid-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 [tname (name k)] - (l/trc :hint "register task" :name tname) - (assoc registry tname (wrap-with-metrics f metrics tname)))) - {} - tasks)) + (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)] + (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}))) diff --git a/backend/src/app/worker/cron.clj b/backend/src/app/worker/cron.clj index cb5a69d88..1bca3798b 100644 --- a/backend/src/app/worker/cron.clj +++ b/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?)) -(s/def ::id keyword?) -(s/def ::cron dt/cron?) -(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/assert-key ::wrk/cron + [_ params] + (assert (sm/check schema:params params))) (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 diff --git a/backend/src/app/worker/dispatcher.clj b/backend/src/app/worker/dispatcher.clj index 9b901747f..e6ab12818 100644 --- a/backend/src/app/worker/dispatcher.clj +++ b/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 [_] - (s/keys :req [::mtx/metrics ::db/pool ::rds/redis])) +(def ^:private schema:dispatcher + [: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 - ::wait-duration (dt/duration "5s")} - (d/without-nils cfg))) + (assert (sm/check schema:dispatcher 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") diff --git a/backend/src/app/worker/executor.clj b/backend/src/app/worker/executor.clj index b712c6769..1419f2c29 100644 --- a/backend/src/app/worker/executor.clj +++ b/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/pre-init-spec ::wrk/monitor [_] - (s/keys :req [::wrk/name ::wrk/executor ::mtx/metrics])) - -(defmethod ig/prep-key ::wrk/monitor - [_ cfg] - (merge {::interval (dt/duration "2s")} - (d/without-nils cfg))) +(defmethod ig/expand-key ::wrk/monitor + [k v] + {k (-> (d/without-nils v) + (assoc ::interval (dt/duration "2s")))}) (defmethod ig/init-key ::wrk/monitor [_ {:keys [::wrk/executor ::mtx/metrics ::interval ::wrk/name]}] diff --git a/backend/src/app/worker/runner.clj b/backend/src/app/worker/runner.clj index 4082c4a3a..eccd58407 100644 --- a/backend/src/app/worker/runner.clj +++ b/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] - [clojure.spec.alpha :as s] + [app.worker :as wrk] [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) - [_ payload] (rds/blpop! rconn timeout queue)] + (let [key (str/ffmt "taskq:%" 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") - cfg (-> cfg - (assoc ::queue (str/ffmt "%:%" tenant queue)) + (let [cfg (-> cfg (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 + [::wrk/parallelism {:optional true} ::sm/int] + [::wrk/queue :keyword] + [::wrk/tenant ::sm/text] + ::wrk/registry + ::mtx/metrics + ::db/pool + ::rds/redis]) -(defmethod ig/pre-init-spec ::runner [_] - (s/keys :req [::wrk/parallelism - ::mtx/metrics - ::db/pool - ::rds/redis - ::wrk/queue - ::wrk/registry])) +(defmethod ig/assert-key ::wrk/runner + [_ params] + (assert (sm/check schema:params params))) -(defmethod ig/prep-key ::wrk/runner - [_ cfg] - (merge {::wrk/parallelism 1} - (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}] diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj index 0095e2363..3aa7d1589 100644 --- a/backend/test/backend_tests/helpers.clj +++ b/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 diff --git a/backend/test/backend_tests/storage_test.clj b/backend/test/backend_tests/storage_test.clj index e40f61333..64498f71a 100644 --- a/backend/test/backend_tests/storage_test.clj +++ b/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] - (assoc storage ::sto/backend :assets-fs)) - ([storage conn] - (-> storage - (assoc ::db/pool-or-conn conn) - (assoc ::sto/backend :assets-fs)))) + [storage] + (assoc storage ::sto/backend :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) diff --git a/common/deps.edn b/common/deps.edn index e45321d47..23065d798 100644 --- a/common/deps.edn +++ b/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"} diff --git a/common/src/app/common/features.cljc b/common/src/app/common/features.cljc index bd6cb6b7b..fc00f46cf 100644 --- a/common/src/app/common/features.cljc +++ b/common/src/app/common/features.cljc @@ -89,12 +89,13 @@ "text-editor/v2"} (into frontend-only-features))) -(sm/register! ::features - [:schema - {:title "FileFeatures" - ::smdj/inline true - :gen/gen (smg/subseq supported-features)} - [::sm/set :string]]) +(sm/register! + ^{::sm/type ::features} + [:schema + {:title "FileFeatures" + ::smdj/inline true + :gen/gen (smg/subseq supported-features)} + [::sm/set :string]]) (defn- flag->feature "Translate a flag to a feature name" diff --git a/common/src/app/common/files/changes_builder.cljc b/common/src/app/common/files/changes_builder.cljc index 9da21cfda..3258ce734 100644 --- a/common/src/app/common/files/changes_builder.cljc +++ b/common/src/app/common/files/changes_builder.cljc @@ -25,14 +25,15 @@ ;; Auxiliary functions to help create a set of changes (undo + redo) -(sm/register! ::changes - [:map {:title "changes"} - [:redo-changes vector?] - [:undo-changes seq?] - [:origin {:optional true} any?] - [:save-undo? {:optional true} boolean?] - [:stack-undo? {:optional true} boolean?] - [:undo-group {:optional true} any?]]) +(sm/register! + ^{::sm/type ::changes} + [:map {:title "changes"} + [:redo-changes vector?] + [:undo-changes seq?] + [:origin {:optional true} any?] + [:save-undo? {:optional true} boolean?] + [:stack-undo? {:optional true} boolean?] + [:undo-group {:optional true} any?]]) (def check-changes! (sm/check-fn ::changes)) diff --git a/common/src/app/common/geom/point.cljc b/common/src/app/common/geom/point.cljc index 3e6a4c727..0883e9cd8 100644 --- a/common/src/app/common/geom/point.cljc +++ b/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}] diff --git a/common/src/app/common/logging.cljc b/common/src/app/common/logging.cljc index 750a38133..77318c864 100644 --- a/common/src/app/common/logging.cljc +++ b/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) -(s/def ::props any? #_d/ordered-map?) -(s/def ::context (s/nilable (s/map-of keyword? any?))) -(s/def ::level #{:trace :debug :info :warn :error :fatal}) -(s/def ::logger string?) -(s/def ::timestamp ::us/integer) -(s/def ::cause (s/nilable ex/exception?)) -(s/def ::message delay?) -(s/def ::record - (s/keys :req [::id ::props ::logger ::level] - :opt [::cause ::context])) +(def ^:private schema:record + [:map + [::id ::sm/uuid] + [::props :any] + [::logger :string] + [::timestamp ::sm/int] + [::level [:enum :trace :debug :info :warn :error :fatal]] + [::message [:fn delay?]] + [::cause {:optional true} [:maybe [:fn ex/exception?]]] + [::context {:optional true} [:maybe [:map-of :keyword :any]]]]) + +(def valid-record? + (sm/validator schema:record)) (defn current-timestamp [] diff --git a/common/src/app/common/schema.cljc b/common/src/app/common/schema.cljc index 761456827..6c1ab3746 100644 --- a/common/src/app/common/schema.cljc +++ b/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] - (let [s (if (map? s) - (cond - (= :set (:type s)) - (m/-collection-schema s) +(defn type-schema + [& {:as params}] + (m/-simple-schema params)) - (= :vector (:type s)) - (m/-collection-schema s) +(defn coll-schema + [& {:as params}] + (m/-collection-schema params)) - :else - (m/-simple-schema s)) - s)] +(defn register! + ([params] + (cond + (map? params) + (let [type (get params :type)] + (assert (qualified-keyword? type) "expected qualified keyword for `type`") + (let [s (m/-simple-schema params)] + (swap! sr/registry assoc type s) + nil)) - (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)) - validator (delay (m/validator @schema)) - explainer (delay (m/explainer @schema))] + (let [schema (schema s) + validator (delay (m/validator 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)) - (-entry-parser [_] (m/-entry-parser @schema)) + (-entries [_] (m/-entries schema)) + (-entry-parser [_] (m/-entry-parser schema)) m/Cached - (-cache [_] (m/-cache @schema)) + (-cache [_] (m/-cache schema)) m/LensSchema - (-keep [_] (m/-keep @schema)) - (-get [_ key default] (m/-get @schema key default)) - (-set [_ key value] (m/-set @schema key value)) + (-keep [_] (m/-keep schema)) + (-get [_ key default] (m/-get schema key default)) + (-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,20 +399,20 @@ (some->> (re-matches uuid-rx s) uuid/uuid) s)) -(register! ::uuid - {:type ::uuid - :pred uuid? - :type-properties - {:title "uuid" - :description "UUID formatted string" - :error/message "should be an uuid" - :gen/gen (sg/uuid) - :decode/string parse-uuid - :decode/json parse-uuid - :encode/string str - :encode/json str - ::oapi/type "string" - ::oapi/format "uuid"}}) +(register! + {:type ::uuid + :pred uuid? + :type-properties + {:title "uuid" + :description "UUID formatted string" + :error/message "should be an uuid" + :gen/gen (sg/uuid) + :decode/string parse-uuid + :decode/json parse-uuid + :encode/string str + :encode/json str + ::oapi/type "string" + ::oapi/format "uuid"}}) (def email-re #"[a-zA-Z0-9_.+-\\\\]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+") @@ -380,25 +427,25 @@ (and (string? s) (re-seq email-re s))) -(register! ::email - {:type :string - :pred email-string? - :property-pred - (fn [{:keys [max] :as props}] - (if (some? max) - (fn [value] - (<= (count value) max)) - (constantly true))) +(register! + {:type ::email + :pred email-string? + :property-pred + (fn [{:keys [max] :as props}] + (if (some? max) + (fn [value] + (<= (count value) max)) + (constantly true))) - :type-properties - {:title "email" - :description "string with valid email address" - :error/code "errors.invalid-email" - :gen/gen (sg/email) - :decode/string (fn [v] (or (parse-email v) v)) - :decode/json (fn [v] (or (parse-email v) v)) - ::oapi/type "string" - ::oapi/format "email"}}) + :type-properties + {:title "email" + :description "string with valid email address" + :error/code "errors.invalid-email" + :gen/gen (sg/email) + :decode/string (fn [v] (or (parse-email v) v)) + :decode/json (fn [v] (or (parse-email v) v)) + ::oapi/type "string" + ::oapi/format "email"}}) (def xf:filter-word-strings (comp @@ -408,254 +455,254 @@ ;; NOTE: this is general purpose set spec and should be used over the other -(def type:set - {:type :set - :min 0 - :max 1 - :compile - (fn [{:keys [kind max min] :as props} children _] - (let [kind (or (last children) kind) +(register! + (coll-schema + :type ::set + :min 0 + :max 1 + :compile + (fn [{:keys [kind max min] :as props} children _] + (let [kind (or (last children) kind) - pred - (cond - (fn? kind) kind - (nil? kind) any? - :else (validator kind)) + pred + (cond + (fn? kind) kind + (nil? kind) any? + :else (validator kind)) - pred - (cond - (and max min) - (fn [value] - (let [size (count value)] - (and (set? value) - (<= min size max) - (every? pred value)))) + pred + (cond + (and max min) + (fn [value] + (let [size (count value)] + (and (set? value) + (<= min size max) + (every? pred value)))) - min - (fn [value] - (let [size (count value)] - (and (set? value) - (<= min size) - (every? pred value)))) + min + (fn [value] + (let [size (count value)] + (and (set? value) + (<= min size) + (every? pred value)))) - max - (fn [value] - (let [size (count value)] - (and (set? value) - (<= size max) - (every? pred value)))) + max + (fn [value] + (let [size (count value)] + (and (set? value) + (<= size max) + (every? pred value)))) - :else - (fn [value] - (every? pred value))) + :else + (fn [value] + (every? pred value))) - decode - (fn [v] - (cond - (string? v) - (let [v (str/split v #"[\s,]+")] - (into #{} xf:filter-word-strings v)) + decode + (fn [v] + (cond + (string? v) + (let [v (str/split v #"[\s,]+")] + (into #{} xf:filter-word-strings v)) - (set? v) - v + (set? v) + v - (coll? v) - (into #{} v) + (coll? v) + (into #{} v) - :else - v)) + :else + v)) - encode-string-child - (encoder kind string-transformer) + encode-string-child + (encoder kind string-transformer) - encode-string - (fn [o] - (if (set? o) - (str/join ", " (map encode-string-child o)) - o))] + encode-string + (fn [o] + (if (set? o) + (str/join ", " (map encode-string-child o)) + o))] - {:pred pred - :empty #{} - :type-properties - {:title "set" - :description "Set of Strings" - :error/message "should be a set of strings" - :gen/gen (-> kind sg/generator sg/set) - :decode/string decode - :decode/json decode - :encode/string encode-string - :encode/json identity - ::oapi/type "array" - ::oapi/format "set" - ::oapi/items {:type "string"} - ::oapi/unique-items true}}))}) + {:pred pred + :empty #{} + :type-properties + {:title "set" + :description "Set of Strings" + :error/message "should be a set of strings" + :gen/gen (-> kind sg/generator sg/set) + :decode/string decode + :decode/json decode + :encode/string encode-string + :encode/json identity + ::oapi/type "array" + ::oapi/format "set" + ::oapi/items {:type "string"} + ::oapi/unique-items true}})))) -(def type:vec - {:type :vector - :min 0 - :max 1 - :compile - (fn [{:keys [kind max min] :as props} children _] - (let [kind (or (last children) kind) - pred - (cond - (fn? kind) kind - (nil? kind) any? - :else (validator kind)) +(register! + (coll-schema + :type ::vec + :min 0 + :max 1 + :compile + (fn [{:keys [kind max min] :as props} children _] + (let [kind (or (last children) kind) + pred + (cond + (fn? kind) kind + (nil? kind) any? + :else (validator kind)) - pred - (cond - (and max min) - (fn [value] - (let [size (count value)] - (and (set? value) - (<= min size max) - (every? pred value)))) + pred + (cond + (and max min) + (fn [value] + (let [size (count value)] + (and (set? value) + (<= min size max) + (every? pred value)))) - min - (fn [value] - (let [size (count value)] - (and (set? value) - (<= min size) - (every? pred value)))) + min + (fn [value] + (let [size (count value)] + (and (set? value) + (<= min size) + (every? pred value)))) - max - (fn [value] - (let [size (count value)] - (and (set? value) - (<= size max) - (every? pred value)))) + max + (fn [value] + (let [size (count value)] + (and (set? value) + (<= size max) + (every? pred value)))) - :else - (fn [value] - (every? pred value))) + :else + (fn [value] + (every? pred value))) - decode - (fn [v] - (cond - (string? v) - (let [v (str/split v #"[\s,]+")] - (into [] xf:filter-word-strings v)) + decode + (fn [v] + (cond + (string? v) + (let [v (str/split v #"[\s,]+")] + (into [] xf:filter-word-strings v)) - (vector? v) - v + (vector? v) + v - (coll? v) - (into [] v) + (coll? v) + (into [] v) - :else - v)) + :else + v)) - encode-string-child - (encoder kind string-transformer) + encode-string-child + (encoder kind string-transformer) - encode-string - (fn [o] - (if (vector? o) - (str/join ", " (map encode-string-child o)) - o))] + encode-string + (fn [o] + (if (vector? o) + (str/join ", " (map encode-string-child o)) + o))] - {:pred pred - :type-properties - {:title "set" - :description "Set of Strings" - :error/message "should be a set of strings" - :gen/gen (-> kind sg/generator sg/set) - :decode/string decode - :decode/json decode - :encode/string encode-string - :encode/json identity - ::oapi/type "array" - ::oapi/format "set" - ::oapi/items {:type "string"} - ::oapi/unique-items true}}))}) + {:pred pred + :type-properties + {:title "set" + :description "Set of Strings" + :error/message "should be a set of strings" + :gen/gen (-> kind sg/generator sg/set) + :decode/string decode + :decode/json decode + :encode/string encode-string + :encode/json identity + ::oapi/type "array" + ::oapi/format "set" + ::oapi/items {:type "string"} + ::oapi/unique-items true}})))) -(register! ::set type:set) -(register! ::vec type:vec) +(register! + {:type ::set-of-strings + :pred #(and (set? %) (every? string? %)) + :type-properties + {:title "set[string]" + :description "Set of Strings" + :error/message "should be a set of strings" + :gen/gen (-> :string sg/generator sg/set) + :decode/string (fn [v] + (let [v (if (string? v) (str/split v #"[\s,]+") v)] + (into #{} xf:filter-word-strings v))) + ::oapi/type "array" + ::oapi/format "set" + ::oapi/items {:type "string"} + ::oapi/unique-items true}}) -(register! ::set-of-strings - {:type ::set-of-strings - :pred #(and (set? %) (every? string? %)) - :type-properties - {:title "set[string]" - :description "Set of Strings" - :error/message "should be a set of strings" - :gen/gen (-> :string sg/generator sg/set) - :decode/string (fn [v] - (let [v (if (string? v) (str/split v #"[\s,]+") v)] - (into #{} xf:filter-word-strings v))) - ::oapi/type "array" - ::oapi/format "set" - ::oapi/items {:type "string"} - ::oapi/unique-items true}}) +(register! + {:type ::set-of-keywords + :pred #(and (set? %) (every? keyword? %)) + :type-properties + {:title "set[string]" + :description "Set of Strings" + :error/message "should be a set of strings" + :gen/gen (-> :keyword sg/generator sg/set) + :decode/string (fn [v] + (let [v (if (string? v) (str/split v #"[\s,]+") v)] + (into #{} (comp xf:filter-word-strings (map keyword)) v))) + ::oapi/type "array" + ::oapi/format "set" + ::oapi/items {:type "string" :format "keyword"} + ::oapi/unique-items true}}) -(register! ::set-of-keywords - {:type ::set-of-keywords - :pred #(and (set? %) (every? keyword? %)) - :type-properties - {:title "set[string]" - :description "Set of Strings" - :error/message "should be a set of strings" - :gen/gen (-> :keyword sg/generator sg/set) - :decode/string (fn [v] - (let [v (if (string? v) (str/split v #"[\s,]+") v)] - (into #{} (comp xf:filter-word-strings (map keyword)) v))) - ::oapi/type "array" - ::oapi/format "set" - ::oapi/items {:type "string" :format "keyword"} - ::oapi/unique-items true}}) +(register! + {:type ::set-of-uuid + :pred #(and (set? %) (every? uuid? %)) + :type-properties + {:title "set[uuid]" + :description "Set of UUID" + :error/message "should be a set of UUID instances" + :gen/gen (-> ::uuid sg/generator sg/set) + :decode/string (fn [v] + (let [v (if (string? v) (str/split v #"[\s,]+") v)] + (into #{} (keep parse-uuid) v))) + ::oapi/type "array" + ::oapi/format "set" + ::oapi/items {:type "string" :format "uuid"} + ::oapi/unique-items true}}) -(register! ::set-of-uuid - {:type ::set-of-uuid - :pred #(and (set? %) (every? uuid? %)) - :type-properties - {:title "set[uuid]" - :description "Set of UUID" - :error/message "should be a set of UUID instances" - :gen/gen (-> ::uuid sg/generator sg/set) - :decode/string (fn [v] - (let [v (if (string? v) (str/split v #"[\s,]+") v)] - (into #{} (keep parse-uuid) v))) - ::oapi/type "array" - ::oapi/format "set" - ::oapi/items {:type "string" :format "uuid"} - ::oapi/unique-items true}}) +(register! + {:type ::coll-of-uuid + :pred (partial every? uuid?) + :type-properties + {:title "[uuid]" + :description "Coll of UUID" + :error/message "should be a coll of UUID instances" + :gen/gen (-> ::uuid sg/generator sg/set) + :decode/string (fn [v] + (let [v (if (string? v) (str/split v #"[\s,]+") v)] + (into [] (keep parse-uuid) v))) + ::oapi/type "array" + ::oapi/format "array" + ::oapi/items {:type "string" :format "uuid"} + ::oapi/unique-items false}}) -(register! ::coll-of-uuid - {:type ::set-of-uuid - :pred (partial every? uuid?) - :type-properties - {:title "[uuid]" - :description "Coll of UUID" - :error/message "should be a coll of UUID instances" - :gen/gen (-> ::uuid sg/generator sg/set) - :decode/string (fn [v] - (let [v (if (string? v) (str/split v #"[\s,]+") v)] - (into [] (keep parse-uuid) v))) - ::oapi/type "array" - ::oapi/format "array" - ::oapi/items {:type "string" :format "uuid"} - ::oapi/unique-items false}}) - -(register! ::one-of - {:type ::one-of - :min 1 - :max 1 - :compile (fn [props children _] - (let [options (into #{} (last children)) - format (:format props "keyword") - decode (if (= format "keyword") - keyword - identity)] - {:pred #(contains? options %) - :type-properties - {:title "one-of" - :description "One of the Set" - :gen/gen (sg/elements options) - :decode/string decode - :decode/json decode - ::oapi/type "string" - ::oapi/format (:format props "keyword")}}))}) +(register! + {:type ::one-of + :min 1 + :max 1 + :compile + (fn [props children _] + (let [options (into #{} (last children)) + format (:format props "keyword") + decode (if (= format "keyword") + keyword + identity)] + {:pred #(contains? options %) + :type-properties + {:title "one-of" + :description "One of the Set" + :gen/gen (sg/elements options) + :decode/string decode + :decode/json decode + ::oapi/type "string" + ::oapi/format (:format props "keyword")}}))}) ;; Integer/MAX_VALUE (def max-safe-int 2147483647) @@ -670,35 +717,35 @@ v)) v)) -(def type:int - {:type :int - :min 0 - :max 0 - :compile - (fn [{:keys [max min] :as props} _ _] - (let [pred int? - pred (if (some? min) - (fn [v] - (and (pred v) - (>= v min))) - pred) - pred (if (some? max) - (fn [v] - (and (pred v) - (>= max v))) - pred)] +(register! + {:type ::int + :min 0 + :max 0 + :compile + (fn [{:keys [max min] :as props} _ _] + (let [pred int? + pred (if (some? min) + (fn [v] + (and (pred v) + (>= v min))) + pred) + pred (if (some? max) + (fn [v] + (and (pred v) + (>= max v))) + pred)] - {:pred pred - :type-properties - {:title "int" - :description "int" - :error/message "expected to be int/long" - :error/code "errors.invalid-integer" - :gen/gen (sg/small-int :max max :min min) - :decode/string parse-long - :decode/json parse-long - ::oapi/type "integer" - ::oapi/format "int64"}}))}) + {:pred pred + :type-properties + {:title "int" + :description "int" + :error/message "expected to be int/long" + :error/code "errors.invalid-integer" + :gen/gen (sg/small-int :max max :min min) + :decode/string parse-long + :decode/json parse-long + ::oapi/type "integer" + ::oapi/format "int64"}}))}) (defn parse-double [v] @@ -708,72 +755,64 @@ v)) v)) -(def 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 (pred v) - (>= v min))) - pred) - pred (if (some? max) - (fn [v] - (and (pred v) - (>= max v))) - pred)] +(register! + {:type ::double + :compile + (fn [{:keys [max min] :as props} _ _] + (let [pred double? + pred (if (some? min) + (fn [v] + (and (pred v) + (>= v min))) + pred) + pred (if (some? max) + (fn [v] + (and (pred v) + (>= max v))) + pred)] - {:pred pred - :type-properties - {:title "doble" - :description "double number" - :error/message "expected to be double" - :error/code "errors.invalid-double" - :gen/gen (sg/small-double :max max :min min) - :decode/string parse-double - :decode/json parse-double - ::oapi/type "number" - ::oapi/format "double"}}))}) + {:pred pred + :type-properties + {:title "doble" + :description "double number" + :error/message "expected to be double" + :error/code "errors.invalid-double" + :gen/gen (sg/small-double :max max :min min) + :decode/string parse-double + :decode/json parse-double + ::oapi/type "number" + ::oapi/format "double"}}))}) -(def 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 (pred v) - (>= v min))) - pred) - pred (if (some? max) - (fn [v] - (and (pred v) - (>= max v))) - pred) +(register! + {:type ::number + :compile + (fn [{:keys [max min] :as props} _ _] + (let [pred number? + pred (if (some? min) + (fn [v] + (and (pred v) + (>= v min))) + pred) + pred (if (some? max) + (fn [v] + (and (pred v) + (>= max v))) + pred) - gen (sg/one-of - (sg/small-int :max max :min min) - (sg/small-double :max max :min min))] + gen (sg/one-of + (sg/small-int :max max :min min) + (sg/small-double :max max :min min))] - {:pred pred - :type-properties - {:title "int" - :description "int" - :error/message "expected to be number" - :error/code "errors.invalid-number" - :gen/gen gen - :decode/string parse-double - :decode/json parse-double - ::oapi/type "number"}}))}) - -(register! ::int type:int) -(register! ::double type:double) -(register! ::number type:number) + {:pred pred + :type-properties + {:title "int" + :description "int" + :error/message "expected to be number" + :error/code "errors.invalid-number" + :gen/gen gen + :decode/string parse-double + :decode/json parse-double + ::oapi/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}]) @@ -788,77 +827,72 @@ v) v)) -(def type:boolean - {:type :boolean - :pred boolean? - :type-properties - {:title "boolean" - :description "boolean" - :error/message "expected boolean" - :error/code "errors.invalid-boolean" - :gen/gen sg/boolean - :decode/string parse-boolean - :decode/json parse-boolean - :encode/string str - ::oapi/type "boolean"}}) +(register! + {:type ::boolean + :pred boolean? + :type-properties + {:title "boolean" + :description "boolean" + :error/message "expected boolean" + :error/code "errors.invalid-boolean" + :gen/gen sg/boolean + :decode/string parse-boolean + :decode/json parse-boolean + :encode/string str + ::oapi/type "boolean"}}) -(register! ::boolean type:boolean) +(register! + {:type ::contains-any + :min 1 + :max 1 + :compile (fn [props children _] + (let [choices (last children) + pred (if (:strict props) + #(some (fn [prop] + (some? (get % prop))) + choices) + #(some (fn [prop] + (contains? % prop)) + choices))] + {:pred pred + :type-properties + {:title "contains" + :description "contains predicate"}}))}) -(def type:contains-any - {:type ::contains-any - :min 1 - :max 1 - :compile (fn [props children _] - (let [choices (last children) - pred (if (:strict props) - #(some (fn [prop] - (some? (get % prop))) - choices) - #(some (fn [prop] - (contains? % prop)) - choices))] - {:pred pred - :type-properties - {:title "contains" - :description "contains predicate"}}))}) +(register! + {:type ::inst + :pred inst? + :type-properties + {:title "inst" + :description "Satisfies Inst protocol" + :error/message "should be an instant" + :gen/gen (->> (sg/small-int) + (sg/fmap (fn [v] (tm/parse-instant v)))) -(register! ::contains-any type:contains-any) + :decode/string tm/parse-instant + :encode/string tm/format-instant + :decode/json tm/parse-instant + :encode/json tm/format-instant + ::oapi/type "string" + ::oapi/format "iso"}}) -(def type:inst - {:type ::inst - :pred inst? - :type-properties - {:title "inst" - :description "Satisfies Inst protocol" - :error/message "should be an instant" - :gen/gen (->> (sg/small-int) - (sg/fmap (fn [v] (tm/parse-instant v)))) - - :decode/string tm/parse-instant - :encode/string tm/format-instant - :decode/json tm/parse-instant - :encode/json tm/format-instant - ::oapi/type "string" - ::oapi/format "iso"}}) - -(register! ::inst type:inst) - -(register! ::fn [:schema fn?]) +(register! + {:type ::fn + :pred fn?}) ;; FIXME: deprecated, replace with ::text -(register! ::word-string - {:type ::word-string - :pred #(and (string? %) (not (str/blank? %))) - :property-pred (m/-min-max-pred count) - :type-properties - {:title "string" - :description "string" - :error/message "expected a non empty string" - :gen/gen (sg/word-string) - ::oapi/type "string" - ::oapi/format "string"}}) - +(register! + {:type ::word-string + :pred #(and (string? %) (not (str/blank? %))) + :property-pred (m/-min-max-pred count) + :type-properties + {:title "string" + :description "string" + :error/message "expected a non empty string" + :gen/gen (sg/word-string) + ::oapi/type "string" + ::oapi/format "string"}}) (defn decode-uri [val] @@ -866,54 +900,17 @@ val (-> val str/trim u/uri))) -(register! ::uri - {:type ::uri - :pred u/uri? - :property-pred - (fn [{:keys [min max prefix] :as props}] - (if (seq props) - (fn [value] - (let [value (str value) - size (count value)] +(register! + {:type ::uri + :pred u/uri? + :property-pred + (fn [{:keys [min max prefix] :as props}] + (if (seq props) + (fn [value] + (let [value (str value) + size (count value)] - (and - (cond - (and min max) - (<= min size max) - - min - (<= min size) - - max - (<= size max)) - - (cond - (d/regexp? prefix) - (some? (re-seq prefix value)) - - :else - true)))) - - (constantly true))) - - :type-properties - {:title "uri" - :description "URI formatted string" - :error/code "errors.invalid-uri" - :gen/gen (sg/uri) - :decode/string decode-uri - :decode/json decode-uri - ::oapi/type "string" - ::oapi/format "uri"}}) - -(register! ::text - {:type :string - :pred #(and (string? %) (not (str/blank? %))) - :property-pred - (fn [{:keys [min max] :as props}] - (if (seq props) - (fn [value] - (let [size (count value)] + (and (cond (and min max) (<= min size max) @@ -922,47 +919,91 @@ (<= min size) max - (<= size max)))) - (constantly true))) + (<= size max)) - :type-properties - {:title "string" - :description "not whitespace string" - :gen/gen (sg/word-string) - :error/code "errors.invalid-text" - :error/fn - (fn [{:keys [value schema]}] - (let [{:keys [max min] :as props} (properties schema)] - (cond - (and (string? value) - (number? max) - (> (count value) max)) - ["errors.field-max-length" max] + (cond + (d/regexp? prefix) + (some? (re-seq prefix value)) - (and (string? value) - (number? min) - (< (count value) min)) - ["errors.field-min-length" min] + :else + true)))) - (and (string? value) - (str/blank? value)) - "errors.field-not-all-whitespace")))}}) + (constantly true))) -(register! ::password - {:type :string - :pred - (fn [value] - (and (string? value) - (>= (count value) 8) - (not (str/blank? value)))) - :type-properties - {:title "password" - :gen/gen (->> (sg/word-string) - (sg/filter #(>= (count %) 8))) - :error/code "errors.password-too-short" - ::oapi/type "string" - ::oapi/format "password"}}) + :type-properties + {:title "uri" + :description "URI formatted string" + :error/code "errors.invalid-uri" + :gen/gen (sg/uri) + :decode/string decode-uri + :decode/json decode-uri + ::oapi/type "string" + ::oapi/format "uri"}}) +(register! + {:type ::text + :pred #(and (string? %) (not (str/blank? %))) + :property-pred + (fn [{:keys [min max] :as props}] + (if (seq props) + (fn [value] + (let [size (count value)] + (cond + (and min max) + (<= min size max) + + min + (<= min size) + + max + (<= size max)))) + (constantly true))) + + :type-properties + {:title "string" + :description "not whitespace string" + :gen/gen (sg/word-string) + :error/code "errors.invalid-text" + :error/fn + (fn [{:keys [value schema]}] + (let [{:keys [max min] :as props} (properties schema)] + (cond + (and (string? value) + (number? max) + (> (count value) max)) + ["errors.field-max-length" max] + + (and (string? value) + (number? min) + (< (count value) min)) + ["errors.field-min-length" min] + + (and (string? value) + (str/blank? value)) + "errors.field-not-all-whitespace")))}}) + +(register! + {:type ::password + :pred + (fn [value] + (and (string? value) + (>= (count value) 8) + (not (str/blank? value)))) + :type-properties + {:title "password" + :gen/gen (->> (sg/word-string) + (sg/filter #(>= (count %) 8))) + :error/code "errors.password-too-short" + ::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 diff --git a/common/src/app/common/types/container.cljc b/common/src/app/common/types/container.cljc index 9cecfac38..ca0181604 100644 --- a/common/src/app/common/types/container.cljc +++ b/common/src/app/common/types/container.cljc @@ -27,17 +27,18 @@ (def valid-container-types #{:page :component}) -(sm/register! ::container - [:map - [:id ::sm/uuid] - [:type {:optional true} - [::sm/one-of valid-container-types]] - [:name :string] - [:path {:optional true} [:maybe :string]] - [:modified-at {:optional true} ::sm/inst] - [:objects {:optional true} - [:map-of {:gen/max 10} ::sm/uuid :map]] - [:plugin-data {:optional true} ::ctpg/plugin-data]]) +(sm/register! + ^{::sm/type ::container} + [:map + [:id ::sm/uuid] + [:type {:optional true} + [::sm/one-of valid-container-types]] + [:name :string] + [:path {:optional true} [:maybe :string]] + [:modified-at {:optional true} ::sm/inst] + [:objects {:optional true} + [:map-of {:gen/max 10} ::sm/uuid :map]] + [:plugin-data {:optional true} ::ctpg/plugin-data]]) (def check-container! (sm/check-fn ::container)) diff --git a/common/src/app/common/types/shape/blur.cljc b/common/src/app/common/types/shape/blur.cljc index 796c0d170..1b319502f 100644 --- a/common/src/app/common/types/shape/blur.cljc +++ b/common/src/app/common/types/shape/blur.cljc @@ -26,9 +26,10 @@ ;; SCHEMA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(sm/register! ::blur - [:map {:title "Blur"} - [:id ::sm/uuid] - [:type [:= :layer-blur]] - [:value ::sm/safe-number] - [:hidden :boolean]]) +(sm/register! + ^{::sm/type ::blur} + [:map {:title "Blur"} + [:id ::sm/uuid] + [:type [:= :layer-blur]] + [:value ::sm/safe-number] + [:hidden :boolean]]) diff --git a/common/src/app/common/types/shape/layout.cljc b/common/src/app/common/types/shape/layout.cljc index 9a71931cc..1101fd55a 100644 --- a/common/src/app/common/types/shape/layout.cljc +++ b/common/src/app/common/types/shape/layout.cljc @@ -86,35 +86,36 @@ :layout-item-absolute :layout-item-z-index]) -(sm/register! ::layout-attrs - [:map {:title "LayoutAttrs"} - [:layout {:optional true} [::sm/one-of layout-types]] - [:layout-flex-dir {:optional true} [::sm/one-of flex-direction-types]] - [:layout-gap {:optional true} - [:map - [:row-gap {:optional true} ::sm/safe-number] - [:column-gap {:optional true} ::sm/safe-number]]] - [:layout-gap-type {:optional true} [::sm/one-of gap-types]] - [:layout-wrap-type {:optional true} [::sm/one-of wrap-types]] - [:layout-padding-type {:optional true} [::sm/one-of padding-type]] - [:layout-padding {:optional true} - [:map - [:p1 ::sm/safe-number] - [:p2 ::sm/safe-number] - [:p3 ::sm/safe-number] - [:p4 ::sm/safe-number]]] - [:layout-justify-content {:optional true} [::sm/one-of justify-content-types]] - [:layout-justify-items {:optional true} [::sm/one-of justify-items-types]] - [:layout-align-content {:optional true} [::sm/one-of align-content-types]] - [:layout-align-items {:optional true} [::sm/one-of align-items-types]] +(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]] + [:layout-gap {:optional true} + [:map + [:row-gap {:optional true} ::sm/safe-number] + [:column-gap {:optional true} ::sm/safe-number]]] + [:layout-gap-type {:optional true} [::sm/one-of gap-types]] + [:layout-wrap-type {:optional true} [::sm/one-of wrap-types]] + [:layout-padding-type {:optional true} [::sm/one-of padding-type]] + [:layout-padding {:optional true} + [:map + [:p1 ::sm/safe-number] + [:p2 ::sm/safe-number] + [:p3 ::sm/safe-number] + [:p4 ::sm/safe-number]]] + [:layout-justify-content {:optional true} [::sm/one-of justify-content-types]] + [:layout-justify-items {:optional true} [::sm/one-of justify-items-types]] + [:layout-align-content {:optional true} [::sm/one-of align-content-types]] + [:layout-align-items {:optional true} [::sm/one-of align-items-types]] - [:layout-grid-dir {:optional true} [::sm/one-of grid-direction-types]] - [:layout-grid-rows {:optional true} - [:vector {:gen/max 2} ::grid-track]] - [:layout-grid-columns {:optional true} - [:vector {:gen/max 2} ::grid-track]] - [:layout-grid-cells {:optional true} - [:map-of {:gen/max 5} ::sm/uuid ::grid-cell]]]) + [:layout-grid-dir {:optional true} [::sm/one-of grid-direction-types]] + [:layout-grid-rows {:optional true} + [:vector {:gen/max 2} ::grid-track]] + [:layout-grid-columns {:optional true} + [:vector {:gen/max 2} ::grid-track]] + [:layout-grid-cells {:optional true} + [:map-of {:gen/max 5} ::sm/uuid ::grid-cell]]]) ;; Grid types (def grid-track-types @@ -129,24 +130,26 @@ (def grid-cell-justify-self-types #{:auto :start :center :end :stretch}) -(sm/register! ::grid-cell - [:map {:title "GridCell"} - [:id ::sm/uuid] - [:area-name {:optional true} :string] - [:row ::sm/safe-int] - [:row-span ::sm/safe-int] - [:column ::sm/safe-int] - [:column-span ::sm/safe-int] - [:position {:optional true} [::sm/one-of grid-position-types]] - [:align-self {:optional true} [::sm/one-of grid-cell-align-self-types]] - [:justify-self {:optional true} [::sm/one-of grid-cell-justify-self-types]] - [:shapes - [:vector {:gen/max 1} ::sm/uuid]]]) +(sm/register! + ^{::sm/type ::grid-cell} + [:map {:title "GridCell"} + [:id ::sm/uuid] + [:area-name {:optional true} :string] + [:row ::sm/safe-int] + [:row-span ::sm/safe-int] + [:column ::sm/safe-int] + [:column-span ::sm/safe-int] + [:position {:optional true} [::sm/one-of grid-position-types]] + [:align-self {:optional true} [::sm/one-of grid-cell-align-self-types]] + [:justify-self {:optional true} [::sm/one-of grid-cell-justify-self-types]] + [:shapes + [:vector {:gen/max 1} ::sm/uuid]]]) -(sm/register! ::grid-track - [:map {:title "GridTrack"} - [:type [::sm/one-of grid-track-types]] - [:value {:optional true} [:maybe ::sm/safe-number]]]) +(sm/register! + ^{::sm/type ::grid-track} + [:map {:title "GridTrack"} + [:type [::sm/one-of grid-track-types]] + [:value {:optional true} [:maybe ::sm/safe-number]]]) (def check-grid-track! (sm/check-fn ::grid-track)) @@ -165,24 +168,25 @@ (def item-align-self-types #{:start :end :center :stretch}) -(sm/register! ::layout-child-attrs - [:map {:title "LayoutChildAttrs"} - [:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]] - [:layout-item-margin {:optional true} - [:map - [:m1 {:optional true} ::sm/safe-number] - [:m2 {:optional true} ::sm/safe-number] - [:m3 {:optional true} ::sm/safe-number] - [:m4 {:optional true} ::sm/safe-number]]] - [:layout-item-max-h {:optional true} ::sm/safe-number] - [:layout-item-min-h {:optional true} ::sm/safe-number] - [:layout-item-max-w {:optional true} ::sm/safe-number] - [:layout-item-min-w {:optional true} ::sm/safe-number] - [:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]] - [:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]] - [:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]] - [:layout-item-absolute {:optional true} :boolean] - [:layout-item-z-index {:optional true} ::sm/safe-number]]) +(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} + [:map + [:m1 {:optional true} ::sm/safe-number] + [:m2 {:optional true} ::sm/safe-number] + [:m3 {:optional true} ::sm/safe-number] + [:m4 {:optional true} ::sm/safe-number]]] + [:layout-item-max-h {:optional true} ::sm/safe-number] + [:layout-item-min-h {:optional true} ::sm/safe-number] + [:layout-item-max-w {:optional true} ::sm/safe-number] + [:layout-item-min-w {:optional true} ::sm/safe-number] + [:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]] + [:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]] + [:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]] + [:layout-item-absolute {:optional true} :boolean] + [:layout-item-z-index {:optional true} ::sm/safe-number]]) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SCHEMAS @@ -191,8 +195,7 @@ (def valid-layouts #{:flex :grid}) -(sm/register! ::layout - [::sm/one-of valid-layouts]) +(sm/register! ::layout [::sm/one-of valid-layouts]) (defn flex-layout? ([objects id] diff --git a/common/src/app/common/types/shape/text.cljc b/common/src/app/common/types/shape/text.cljc index 99d3a55b5..1042e6f69 100644 --- a/common/src/app/common/types/shape/text.cljc +++ b/common/src/app/common/types/shape/text.cljc @@ -16,68 +16,70 @@ (def node-types #{"root" "paragraph-set" "paragraph"}) -(sm/register! ::content +(sm/register! + ^{::sm/type ::content} + [:map + [:type [:= "root"]] + [:key {:optional true} :string] + [:children + {:optional true} + [:maybe + [:vector {:min 1 :gen/max 2 :gen/min 1} + [:map + [:type [:= "paragraph-set"]] + [:key {:optional true} :string] + [:children + [:vector {:min 1 :gen/max 2 :gen/min 1} + [:map + [:type [:= "paragraph"]] + [:key {:optional true} :string] + [:fills {:optional true} + [:maybe + [:vector {:gen/max 2} ::shape/fill]]] + [:font-family {:optional true} :string] + [:font-size {:optional true} :string] + [:font-style {:optional true} :string] + [:font-weight {:optional true} :string] + [:direction {:optional true} :string] + [:text-decoration {:optional true} :string] + [:text-transform {:optional true} :string] + [:typography-ref-id {:optional true} [:maybe ::sm/uuid]] + [:typography-ref-file {:optional true} [:maybe ::sm/uuid]] + [:children + [:vector {:min 1 :gen/max 2 :gen/min 1} + [:map + [:text :string] + [:key {:optional true} :string] + [:fills {:optional true} + [:maybe + [:vector {:gen/max 2} ::shape/fill]]] + [:font-family {:optional true} :string] + [:font-size {:optional true} :string] + [:font-style {:optional true} :string] + [:font-weight {:optional true} :string] + [:direction {:optional true} :string] + [:text-decoration {:optional true} :string] + [:text-transform {:optional true} :string] + [:typography-ref-id {:optional true} [:maybe ::sm/uuid]] + [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]]]]]]]]]]]]) + + + +(sm/register! + ^{::sm/type ::position-data} + [:vector {:min 1 :gen/max 2} [:map - [:type [:= "root"]] - [:key {:optional true} :string] - [:children - {:optional true} - [:maybe - [:vector {:min 1 :gen/max 2 :gen/min 1} - [:map - [:type [:= "paragraph-set"]] - [:key {:optional true} :string] - [:children - [:vector {:min 1 :gen/max 2 :gen/min 1} - [:map - [:type [:= "paragraph"]] - [:key {:optional true} :string] - [:fills {:optional true} - [:maybe - [:vector {:gen/max 2} ::shape/fill]]] - [:font-family {:optional true} :string] - [:font-size {:optional true} :string] - [:font-style {:optional true} :string] - [:font-weight {:optional true} :string] - [:direction {:optional true} :string] - [:text-decoration {:optional true} :string] - [:text-transform {:optional true} :string] - [:typography-ref-id {:optional true} [:maybe ::sm/uuid]] - [:typography-ref-file {:optional true} [:maybe ::sm/uuid]] - [:children - [:vector {:min 1 :gen/max 2 :gen/min 1} - [:map - [:text :string] - [:key {:optional true} :string] - [:fills {:optional true} - [:maybe - [:vector {:gen/max 2} ::shape/fill]]] - [:font-family {:optional true} :string] - [:font-size {:optional true} :string] - [:font-style {:optional true} :string] - [:font-weight {:optional true} :string] - [:direction {:optional true} :string] - [:text-decoration {:optional true} :string] - [:text-transform {:optional true} :string] - [:typography-ref-id {:optional true} [:maybe ::sm/uuid]] - [:typography-ref-file {:optional true} [:maybe ::sm/uuid]]]]]]]]]]]]]) - - - -(sm/register! ::position-data - [:vector {:min 1 :gen/max 2} - [:map - [:x ::sm/safe-number] - [:y ::sm/safe-number] - [:width ::sm/safe-number] - [:height ::sm/safe-number] - [:fills [:vector {:gen/max 2} ::shape/fill]] - [:font-family {:optional true} :string] - [:font-size {:optional true} :string] - [:font-style {:optional true} :string] - [:font-weight {:optional true} :string] - [:rtl {:optional true} :boolean] - [:text {:optional true} :string] - [:text-decoration {:optional true} :string] - [:text-transform {:optional true} :string]]]) + [:x ::sm/safe-number] + [:y ::sm/safe-number] + [:width ::sm/safe-number] + [:height ::sm/safe-number] + [:fills [:vector {:gen/max 2} ::shape/fill]] + [:font-family {:optional true} :string] + [:font-size {:optional true} :string] + [:font-style {:optional true} :string] + [:font-weight {:optional true} :string] + [:rtl {:optional true} :boolean] + [:text {:optional true} :string] + [:text-decoration {:optional true} :string] + [:text-transform {:optional true} :string]]]) diff --git a/common/src/app/common/types/token.cljc b/common/src/app/common/types/token.cljc index 20be853b8..1075ba461 100644 --- a/common/src/app/common/types/token.cljc +++ b/common/src/app/common/types/token.cljc @@ -64,89 +64,102 @@ (string? n)) ;; TODO Move this to tokens-lib -(sm/register! ::token - [:map {:title "Token"} - [:name token-name-ref] - [:type [::sm/one-of token-types]] - [:value :any] - [:description {:optional true} [:maybe :string]] - [:modified-at {:optional true} ::sm/inst]]) +(sm/register! + ^{::sm/type ::token} + [:map {:title "Token"} + [:name token-name-ref] + [:type [::sm/one-of token-types]] + [:value :any] + [:description {:optional true} [:maybe :string]] + [:modified-at {:optional true} ::sm/inst]]) -(sm/register! ::color - [:map - [:fill {:optional true} token-name-ref] - [:stroke-color {:optional true} token-name-ref]]) +(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 - [:map - [:rx {:optional true} token-name-ref] - [:ry {:optional true} token-name-ref] - [:r1 {:optional true} token-name-ref] - [:r2 {:optional true} token-name-ref] - [:r3 {:optional true} token-name-ref] - [:r4 {:optional true} token-name-ref]]) +(sm/register! + ^{::sm/type ::border-radius} + [:map + [:rx {:optional true} token-name-ref] + [:ry {:optional true} token-name-ref] + [:r1 {:optional true} token-name-ref] + [:r2 {:optional true} token-name-ref] + [:r3 {:optional true} token-name-ref] + [:r4 {:optional true} token-name-ref]]) (def border-radius-keys (schema-keys ::border-radius)) -(sm/register! ::stroke-width - [:map - [:stroke-width {:optional true} token-name-ref]]) +(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 - [:map - [:width {:optional true} token-name-ref] - [:height {:optional true} token-name-ref] - [:layout-item-min-w {:optional true} token-name-ref] - [:layout-item-max-w {:optional true} token-name-ref] - [:layout-item-min-h {:optional true} token-name-ref] - [:layout-item-max-h {:optional true} token-name-ref]]) +(sm/register! + ^{::sm/type ::sizing} + [:map + [:width {:optional true} token-name-ref] + [:height {:optional true} token-name-ref] + [:layout-item-min-w {:optional true} token-name-ref] + [:layout-item-max-w {:optional true} token-name-ref] + [:layout-item-min-h {:optional true} token-name-ref] + [:layout-item-max-h {:optional true} token-name-ref]]) (def sizing-keys (schema-keys ::sizing)) -(sm/register! ::opacity - [:map - [:opacity {:optional true} token-name-ref]]) +(sm/register! + ^{::sm/type ::opacity} + [:map + [:opacity {:optional true} token-name-ref]]) (def opacity-keys (schema-keys ::opacity)) -(sm/register! ::spacing - [:map - [:row-gap {:optional true} token-name-ref] - [:column-gap {:optional true} token-name-ref] - [:p1 {:optional true} token-name-ref] - [:p2 {:optional true} token-name-ref] - [:p3 {:optional true} token-name-ref] - [:p4 {:optional true} token-name-ref] - [:x {:optional true} token-name-ref] - [:y {:optional true} token-name-ref]]) +(sm/register! + ^{::sm/type ::spacing} + [:map + [:row-gap {:optional true} token-name-ref] + [:column-gap {:optional true} token-name-ref] + [:p1 {:optional true} token-name-ref] + [:p2 {:optional true} token-name-ref] + [:p3 {:optional true} token-name-ref] + [:p4 {:optional true} token-name-ref] + [:x {:optional true} token-name-ref] + [:y {:optional true} token-name-ref]]) (def spacing-keys (schema-keys ::spacing)) -(sm/register! ::dimensions - (merge-schemas ::sizing - ::spacing - ::stroke-width - ::border-radius)) +(sm/register! + ^{::sm/type ::dimensions} + [:merge + ::sizing + ::spacing + ::stroke-width + ::border-radius]) (def dimensions-keys (schema-keys ::dimensions)) -(sm/register! ::rotation - [:map - [:rotation {:optional true} token-name-ref]]) +(sm/register! + ^{::sm/type ::rotation} + [:map + [:rotation {:optional true} token-name-ref]]) (def rotation-keys (schema-keys ::rotation)) -(sm/register! ::tokens - [:map {:title "Applied Tokens"}]) +(sm/register! + ^{::sm/type ::tokens} + [:map {:title "Applied Tokens"}]) -(sm/register! ::applied-tokens - (merge-schemas ::tokens - ::border-radius - ::sizing - ::spacing - ::rotation - ::dimensions)) +(sm/register! + ^{::sm/type ::applied-tokens} + [:merge + ::tokens + ::border-radius + ::sizing + ::spacing + ::rotation + ::dimensions]) diff --git a/common/src/app/common/types/token_theme.cljc b/common/src/app/common/types/token_theme.cljc index ed7388995..0482fa8c5 100644 --- a/common/src/app/common/types/token_theme.cljc +++ b/common/src/app/common/types/token_theme.cljc @@ -8,18 +8,20 @@ (:require [app.common.schema :as sm])) -(sm/register! ::token-theme - [:map {:title "TokenTheme"} - [:name :string] - [:group :string] - [:description [:maybe :string]] - [:is-source :boolean] - [:modified-at {:optional true} ::sm/inst] - [:sets :any]]) +(sm/register! + ^{::sm/type ::token-theme} + [:map {:title "TokenTheme"} + [:name :string] + [:group :string] + [:description [:maybe :string]] + [:is-source :boolean] + [:modified-at {:optional true} ::sm/inst] + [:sets :any]]) -(sm/register! ::token-set - [:map {:title "TokenSet"} - [:name :string] - [:description {:optional true} [:maybe :string]] - [:modified-at {:optional true} ::sm/inst] - [:tokens :any]]) +(sm/register! + ^{::sm/type ::token-set} + [:map {:title "TokenSet"} + [:name :string] + [:description {:optional true} [:maybe :string]] + [:modified-at {:optional true} ::sm/inst] + [:tokens :any]]) diff --git a/exporter/scripts/wait-and-start.sh b/exporter/scripts/wait-and-start.sh index 7a96d4dd0..c04935367 100755 --- a/exporter/scripts/wait-and-start.sh +++ b/exporter/scripts/wait-and-start.sh @@ -1,7 +1,5 @@ #!/usr/bin/env bash -export PENPOT_TENANT=dev - bb -i '(babashka.wait/wait-for-port "localhost" 9630)'; bb -i '(babashka.wait/wait-for-path "target/app.js")'; sleep 2; diff --git a/frontend/src/app/main/data/comments.cljs b/frontend/src/app/main/data/comments.cljs index f73836d65..3b7dfba2b 100644 --- a/frontend/src/app/main/data/comments.cljs +++ b/frontend/src/app/main/data/comments.cljs @@ -95,7 +95,7 @@ ([params] (create-thread-on-workspace params identity true)) ([params on-thread-created open?] - (dm/assert! (sm/check! schema:create-thread-on-workspace params)) + (dm/assert! (sm/check schema:create-thread-on-workspace params)) (ptk/reify ::create-thread-on-workspace ptk/WatchEvent @@ -149,7 +149,7 @@ (defn create-thread-on-viewer [params] (dm/assert! - (sm/check! schema:create-thread-on-viewer params)) + (sm/check schema:create-thread-on-viewer params)) (ptk/reify ::create-thread-on-viewer ptk/WatchEvent @@ -481,7 +481,7 @@ (defn create-draft [params] (dm/assert! - (sm/check! schema:create-draft params)) + (sm/check schema:create-draft params)) (ptk/reify ::create-draft ptk/UpdateEvent (update [_ state] diff --git a/frontend/src/app/main/data/users.cljs b/frontend/src/app/main/data/users.cljs index a3b7e4ad7..237cdde46 100644 --- a/frontend/src/app/main/data/users.cljs +++ b/frontend/src/app/main/data/users.cljs @@ -274,7 +274,7 @@ (dm/assert! "expected valid params" - (sm/check! schema:login-with-ldap params)) + (sm/check schema:login-with-ldap params)) (ptk/reify ::login-with-ldap ptk/WatchEvent @@ -468,7 +468,7 @@ [data] (dm/assert! "expected valid parameters" - (sm/check! schema:update-password data)) + (sm/check schema:update-password data)) (ptk/reify ::update-password ev/Event @@ -615,7 +615,7 @@ (dm/assert! "expected valid parameters" - (sm/check! schema:request-profile-recovery data)) + (sm/check schema:request-profile-recovery data)) (ptk/reify ::request-profile-recovery ptk/WatchEvent @@ -640,7 +640,7 @@ [data] (dm/assert! "expected valid arguments" - (sm/check! schema:recover-profile data)) + (sm/check schema:recover-profile data)) (ptk/reify ::recover-profile ptk/WatchEvent diff --git a/frontend/src/app/main/data/viewer.cljs b/frontend/src/app/main/data/viewer.cljs index d2a9bdd59..f247e70f5 100644 --- a/frontend/src/app/main/data/viewer.cljs +++ b/frontend/src/app/main/data/viewer.cljs @@ -58,7 +58,7 @@ [{:keys [file-id share-id interactions-show?] :as params}] (dm/assert! "expected valid params" - (sm/check! schema:initialize params)) + (sm/check schema:initialize params)) (ptk/reify ::initialize ptk/UpdateEvent @@ -111,7 +111,7 @@ (dm/assert! "expected valid params" - (sm/check! schema:fetch-bundle params)) + (sm/check schema:fetch-bundle params)) (ptk/reify ::fetch-bundle ptk/WatchEvent diff --git a/frontend/src/app/main/data/workspace/media.cljs b/frontend/src/app/main/data/workspace/media.cljs index 976dc2cfe..8ff1195b6 100644 --- a/frontend/src/app/main/data/workspace/media.cljs +++ b/frontend/src/app/main/data/workspace/media.cljs @@ -211,7 +211,7 @@ (defn- process-media-objects [{:keys [uris on-error] :as params}] (dm/assert! - (and (sm/check! schema:process-media-objects params) + (and (sm/check schema:process-media-objects params) (or (contains? params :blobs) (contains? params :uris)))) @@ -433,7 +433,7 @@ (defn clone-media-object [{:keys [file-id object-id] :as params}] (dm/assert! - (sm/check! schema:clone-media-object params)) + (sm/check schema:clone-media-object params)) (ptk/reify ::clone-media-objects ptk/WatchEvent diff --git a/frontend/src/app/worker.cljs b/frontend/src/app/worker.cljs index cb7a7c5aa..502e3d67e 100644 --- a/frontend/src/app/worker.cljs +++ b/frontend/src/app/worker.cljs @@ -93,7 +93,7 @@ [{:keys [sender-id] :as message}] (dm/assert! "expected valid message" - (sm/check! schema:message message)) + (sm/check schema:message message)) (.postMessage js/self (wm/encode {:reply-to sender-id :dropped true})))