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