mirror of
https://github.com/penpot/penpot.git
synced 2025-01-04 13:50:12 -05:00
♻️ Update integrant to latest version
This upgrade also includes complete elimination of use spec from the backend codebase, completing the long running migration to fully use malli for validation and decoding.
This commit is contained in:
parent
8ed508012e
commit
88fb5e7ab5
79 changed files with 2249 additions and 2117 deletions
|
@ -161,7 +161,7 @@ jobs:
|
||||||
name: "tests"
|
name: "tests"
|
||||||
working_directory: "./backend"
|
working_directory: "./backend"
|
||||||
command: |
|
command: |
|
||||||
clojure -M:dev:test
|
clojure -M:dev:test --reporter kaocha.report/documentation
|
||||||
|
|
||||||
environment:
|
environment:
|
||||||
PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
|
PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
|
||||||
|
|
|
@ -4,7 +4,6 @@
|
||||||
:remove-consecutive-blank-lines? false
|
:remove-consecutive-blank-lines? false
|
||||||
:extra-indents {rumext.v2/fnc [[:inner 0]]
|
:extra-indents {rumext.v2/fnc [[:inner 0]]
|
||||||
cljs.test/async [[:inner 0]]
|
cljs.test/async [[:inner 0]]
|
||||||
app.common.schema/register! [[:inner 0] [:inner 1]]
|
|
||||||
promesa.exec/thread [[:inner 0]]
|
promesa.exec/thread [[:inner 0]]
|
||||||
specify! [[:inner 0] [:inner 1]]}
|
specify! [[:inner 0] [:inner 1]]}
|
||||||
}
|
}
|
||||||
|
|
|
@ -137,7 +137,6 @@
|
||||||
;; :v6 v6
|
;; :v6 v6
|
||||||
;; }])))
|
;; }])))
|
||||||
|
|
||||||
|
|
||||||
(defn calculate-frames
|
(defn calculate-frames
|
||||||
[{:keys [data]}]
|
[{:keys [data]}]
|
||||||
(->> (vals (:pages-index data))
|
(->> (vals (:pages-index data))
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
#!/usr/bin/env bash
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
export PENPOT_HOST=devenv
|
export PENPOT_HOST=devenv
|
||||||
export PENPOT_TENANT=dev
|
|
||||||
export PENPOT_FLAGS="\
|
export PENPOT_FLAGS="\
|
||||||
$PENPOT_FLAGS \
|
$PENPOT_FLAGS \
|
||||||
enable-login-with-ldap \
|
enable-login-with-ldap \
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
#!/usr/bin/env bash
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
export PENPOT_HOST=devenv
|
export PENPOT_HOST=devenv
|
||||||
export PENPOT_TENANT=dev
|
|
||||||
export PENPOT_FLAGS="\
|
export PENPOT_FLAGS="\
|
||||||
$PENPOT_FLAGS \
|
$PENPOT_FLAGS \
|
||||||
enable-prepl-server \
|
enable-prepl-server \
|
||||||
|
@ -10,6 +9,7 @@ export PENPOT_FLAGS="\
|
||||||
enable-webhooks \
|
enable-webhooks \
|
||||||
enable-backend-asserts \
|
enable-backend-asserts \
|
||||||
enable-audit-log \
|
enable-audit-log \
|
||||||
|
enable-login-with-ldap \
|
||||||
enable-transit-readable-response \
|
enable-transit-readable-response \
|
||||||
enable-demo-users \
|
enable-demo-users \
|
||||||
enable-feature-fdata-pointer-map \
|
enable-feature-fdata-pointer-map \
|
||||||
|
|
|
@ -8,9 +8,8 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[clj-ldap.client :as ldap]
|
[clj-ldap.client :as ldap]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[clojure.string]
|
[clojure.string]
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
|
@ -58,21 +57,26 @@
|
||||||
:email email
|
:email email
|
||||||
:backend "ldap"})))
|
:backend "ldap"})))
|
||||||
|
|
||||||
(s/def ::fullname ::us/not-empty-string)
|
(def ^:private schema:info-data
|
||||||
(s/def ::email ::us/email)
|
[:map
|
||||||
(s/def ::backend ::us/not-empty-string)
|
[:fullname ::sm/text]
|
||||||
|
[:email ::sm/email]
|
||||||
|
[:backend ::sm/text]])
|
||||||
|
|
||||||
(s/def ::info-data
|
(def ^:private valid-info-data?
|
||||||
(s/keys :req-un [::fullname ::email ::backend]))
|
(sm/lazy-validator schema:info-data))
|
||||||
|
|
||||||
|
(def ^:private explain-info-data
|
||||||
|
(sm/lazy-explainer schema:info-data))
|
||||||
|
|
||||||
(defn authenticate
|
(defn authenticate
|
||||||
[cfg params]
|
[cfg params]
|
||||||
(with-open [conn (connect cfg)]
|
(with-open [conn (connect cfg)]
|
||||||
(when-let [user (-> (assoc cfg ::conn conn)
|
(when-let [user (-> (assoc cfg ::conn conn)
|
||||||
(retrieve-user params))]
|
(retrieve-user params))]
|
||||||
(when-not (s/valid? ::info-data user)
|
(when-not (valid-info-data? user)
|
||||||
(let [explain (s/explain-str ::info-data user)]
|
(let [explain (explain-info-data user)]
|
||||||
(l/warn ::l/raw (str "invalid response from ldap, looks like ldap is not configured correctly\n" explain))
|
(l/warn :hint "invalid response from ldap, looks like ldap is not configured correctly" :data user)
|
||||||
(ex/raise :type :restriction
|
(ex/raise :type :restriction
|
||||||
:code :wrong-ldap-response
|
:code :wrong-ldap-response
|
||||||
:explain explain)))
|
:explain explain)))
|
||||||
|
@ -102,38 +106,31 @@
|
||||||
:host (:host cfg) :port (:port cfg) :cause cause)
|
:host (:host cfg) :port (:port cfg) :cause cause)
|
||||||
nil))))
|
nil))))
|
||||||
|
|
||||||
(s/def ::enabled? ::us/boolean)
|
(def ^:private schema:params
|
||||||
(s/def ::host ::us/string)
|
[:map
|
||||||
(s/def ::port ::us/integer)
|
[:host {:optional true} :string]
|
||||||
(s/def ::ssl ::us/boolean)
|
[:port {:optional true} ::sm/int]
|
||||||
(s/def ::tls ::us/boolean)
|
[:bind-dn {:optional true} :string]
|
||||||
(s/def ::query ::us/string)
|
[:bind-passwor {:optional true} :string]
|
||||||
(s/def ::base-dn ::us/string)
|
[:query {:optional true} :string]
|
||||||
(s/def ::bind-dn ::us/string)
|
[:base-dn {:optional true} :string]
|
||||||
(s/def ::bind-password ::us/string)
|
[:attrs-email {:optional true} :string]
|
||||||
(s/def ::attrs-email ::us/string)
|
[:attrs-username {:optional true} :string]
|
||||||
(s/def ::attrs-fullname ::us/string)
|
[:attrs-fullname {:optional true} :string]
|
||||||
(s/def ::attrs-username ::us/string)
|
[:ssl {:optional true} ::sm/boolean]
|
||||||
|
[:tls {:optional true} ::sm/boolean]])
|
||||||
|
|
||||||
(s/def ::provider-params
|
(def ^:private check-params
|
||||||
(s/keys :opt-un [::host ::port
|
(sm/check-fn schema:params :hint "Invalid LDAP provider parameters"))
|
||||||
::ssl ::tls
|
|
||||||
::enabled?
|
|
||||||
::bind-dn
|
|
||||||
::bind-password
|
|
||||||
::query
|
|
||||||
::attrs-email
|
|
||||||
::attrs-username
|
|
||||||
::attrs-fullname]))
|
|
||||||
|
|
||||||
(s/def ::provider
|
(defmethod ig/assert-key ::provider
|
||||||
(s/nilable ::provider-params))
|
[_ params]
|
||||||
|
(when (:enabled params)
|
||||||
(defmethod ig/pre-init-spec ::provider
|
(some->> params check-params)))
|
||||||
[_]
|
|
||||||
(s/spec ::provider))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::provider
|
(defmethod ig/init-key ::provider
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
(when (:enabled? cfg)
|
(when (:enabled cfg)
|
||||||
(try-connectivity cfg)))
|
(try-connectivity cfg)))
|
||||||
|
|
||||||
|
(sm/register! ::provider schema:params)
|
||||||
|
|
|
@ -12,7 +12,7 @@
|
||||||
[app.common.data.macros :as dm]
|
[app.common.data.macros :as dm]
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uri :as u]
|
[app.common.uri :as u]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
|
@ -32,7 +32,6 @@
|
||||||
[buddy.sign.jwk :as jwk]
|
[buddy.sign.jwk :as jwk]
|
||||||
[buddy.sign.jwt :as jwt]
|
[buddy.sign.jwt :as jwt]
|
||||||
[clojure.set :as set]
|
[clojure.set :as set]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[yetti.request :as yreq]
|
[yetti.request :as yreq]
|
||||||
|
@ -140,8 +139,9 @@
|
||||||
(l/warn :hint "unable to retrieve JWKs (unexpected exception)"
|
(l/warn :hint "unable to retrieve JWKs (unexpected exception)"
|
||||||
:cause cause)))))
|
:cause cause)))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::providers/generic [_]
|
(defmethod ig/assert-key ::providers/generic
|
||||||
(s/keys :req [::http/client]))
|
[_ params]
|
||||||
|
(assert (http/client? (::http/client params)) "expected a valid http client"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::providers/generic
|
(defmethod ig/init-key ::providers/generic
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
@ -197,6 +197,10 @@
|
||||||
;; GITHUB AUTH PROVIDER
|
;; GITHUB AUTH PROVIDER
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defn- int-in-range?
|
||||||
|
[val start end]
|
||||||
|
(and (<= start val) (< val end)))
|
||||||
|
|
||||||
(defn- retrieve-github-email
|
(defn- retrieve-github-email
|
||||||
[cfg tdata props]
|
[cfg tdata props]
|
||||||
(or (some-> props :github/email)
|
(or (some-> props :github/email)
|
||||||
|
@ -207,7 +211,7 @@
|
||||||
|
|
||||||
{:keys [status body]} (http/req! cfg params {:sync? true})]
|
{: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
|
(ex/raise :type :internal
|
||||||
:code :unable-to-retrieve-github-emails
|
:code :unable-to-retrieve-github-emails
|
||||||
:hint "unable to retrieve github emails"
|
:hint "unable to retrieve github emails"
|
||||||
|
@ -217,8 +221,9 @@
|
||||||
|
|
||||||
(->> body json/decode (filter :primary) first :email))))
|
(->> body json/decode (filter :primary) first :email))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::providers/github [_]
|
(defmethod ig/assert-key ::providers/github
|
||||||
(s/keys :req [::http/client]))
|
[_ params]
|
||||||
|
(assert (http/client? (::http/client params)) "expected a valid http client"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::providers/github
|
(defmethod ig/init-key ::providers/github
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
@ -394,7 +399,7 @@
|
||||||
:status (:status response)
|
:status (:status response)
|
||||||
:body (:body 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
|
(ex/raise :type :internal
|
||||||
:code :unable-to-retrieve-user-info
|
:code :unable-to-retrieve-user-info
|
||||||
:hint "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)"
|
(l/warn :hint "unable to get user info from JWT token (unexpected exception)"
|
||||||
:cause cause))))
|
:cause cause))))
|
||||||
|
|
||||||
(s/def ::backend ::us/not-empty-string)
|
(def ^:private schema:info
|
||||||
(s/def ::email ::us/not-empty-string)
|
[:map
|
||||||
(s/def ::fullname ::us/not-empty-string)
|
[:backend ::sm/text]
|
||||||
(s/def ::props (s/map-of ::us/keyword any?))
|
[:email ::sm/email]
|
||||||
(s/def ::info
|
[:fullname ::sm/text]
|
||||||
(s/keys :req-un [::backend
|
[:props [:map-of :keyword :any]]])
|
||||||
::email
|
|
||||||
::fullname
|
(def ^:private valid-info?
|
||||||
::props]))
|
(sm/validator schema:info))
|
||||||
|
|
||||||
(defn- get-info
|
(defn- get-info
|
||||||
[{:keys [::provider ::setup/props] :as cfg} {:keys [params] :as request}]
|
[{:keys [::provider ::setup/props] :as cfg} {:keys [params] :as request}]
|
||||||
|
@ -444,7 +449,7 @@
|
||||||
|
|
||||||
(l/trc :hint "user info" :info info)
|
(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)
|
(l/warn :hint "received incomplete profile info object (please set correct scopes)" :info info)
|
||||||
(ex/raise :type :internal
|
(ex/raise :type :internal
|
||||||
:code :incomplete-user-info
|
:code :incomplete-user-info
|
||||||
|
@ -655,46 +660,37 @@
|
||||||
:provider provider
|
:provider provider
|
||||||
:hint "provider not configured"))))))})
|
:hint "provider not configured"))))))})
|
||||||
|
|
||||||
(s/def ::client-id ::us/string)
|
(def ^:private schema:provider
|
||||||
(s/def ::client-secret ::us/string)
|
[:map {:title "provider"}
|
||||||
(s/def ::base-uri ::us/string)
|
[:client-id ::sm/text]
|
||||||
(s/def ::token-uri ::us/string)
|
[:client-secret ::sm/text]
|
||||||
(s/def ::auth-uri ::us/string)
|
[:base-uri {:optional true} ::sm/text]
|
||||||
(s/def ::user-uri ::us/string)
|
[:token-uri {:optional true} ::sm/text]
|
||||||
(s/def ::scopes ::us/set-of-strings)
|
[:auth-uri {:optional true} ::sm/text]
|
||||||
(s/def ::roles ::us/set-of-strings)
|
[:user-uri {:optional true} ::sm/text]
|
||||||
(s/def ::roles-attr ::us/string)
|
[:scopes {:optional true}
|
||||||
(s/def ::email-attr ::us/string)
|
[::sm/set ::sm/text]]
|
||||||
(s/def ::name-attr ::us/string)
|
[:roles {:optional true}
|
||||||
|
[::sm/set ::sm/text]]
|
||||||
|
[:roles-attr {:optional true} ::sm/text]
|
||||||
|
[:email-attr {:optional true} ::sm/text]
|
||||||
|
[:name-attr {:optional true} ::sm/text]])
|
||||||
|
|
||||||
(s/def ::provider
|
(def ^:private schema:routes-params
|
||||||
(s/keys :req-un [::client-id
|
[:map
|
||||||
::client-secret]
|
::session/manager
|
||||||
:opt-un [::base-uri
|
::http/client
|
||||||
::token-uri
|
::setup/props
|
||||||
::auth-uri
|
::db/pool
|
||||||
::user-uri
|
[::providers [:map-of :keyword [:maybe schema:provider]]]])
|
||||||
::scopes
|
|
||||||
::roles
|
|
||||||
::roles-attr
|
|
||||||
::email-attr
|
|
||||||
::name-attr]))
|
|
||||||
|
|
||||||
(s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider)))
|
(defmethod ig/assert-key ::routes
|
||||||
|
[_ params]
|
||||||
(s/def ::routes vector?)
|
(assert (sm/check schema:routes-params params)))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::routes
|
|
||||||
[_]
|
|
||||||
(s/keys :req [::session/manager
|
|
||||||
::http/client
|
|
||||||
::setup/props
|
|
||||||
::db/pool
|
|
||||||
::providers]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::routes
|
(defmethod ig/init-key ::routes
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
(let [cfg (update cfg :provider d/without-nils)]
|
(let [cfg (update cfg :providers d/without-nils)]
|
||||||
["" {:middleware [[session/authz cfg]
|
["" {:middleware [[session/authz cfg]
|
||||||
[provider-lookup cfg]]}
|
[provider-lookup cfg]]}
|
||||||
["/auth/oauth"
|
["/auth/oauth"
|
||||||
|
|
|
@ -26,11 +26,11 @@
|
||||||
[_ data]
|
[_ data]
|
||||||
(d/without-nils data))
|
(d/without-nils data))
|
||||||
|
|
||||||
(defmethod ig/prep-key :default
|
(defmethod ig/expand-key :default
|
||||||
[_ data]
|
[k v]
|
||||||
(if (map? data)
|
{k (if (map? v)
|
||||||
(d/without-nils data)
|
(d/without-nils v)
|
||||||
data))
|
v)})
|
||||||
|
|
||||||
(def default
|
(def default
|
||||||
{:database-uri "postgresql://postgres/penpot"
|
{:database-uri "postgresql://postgres/penpot"
|
||||||
|
@ -126,7 +126,7 @@
|
||||||
[:worker-webhook-parallelism {:optional true} ::sm/int]
|
[:worker-webhook-parallelism {:optional true} ::sm/int]
|
||||||
|
|
||||||
[:database-password {:optional true} [:maybe :string]]
|
[:database-password {:optional true} [:maybe :string]]
|
||||||
[:database-uri {:optional true} :string]
|
[:database-uri {:optional true} ::sm/uri]
|
||||||
[:database-username {:optional true} [:maybe :string]]
|
[:database-username {:optional true} [:maybe :string]]
|
||||||
[:database-readonly {:optional true} ::sm/boolean]
|
[:database-readonly {:optional true} ::sm/boolean]
|
||||||
[:database-min-pool-size {:optional true} ::sm/int]
|
[:database-min-pool-size {:optional true} ::sm/int]
|
||||||
|
@ -190,7 +190,7 @@
|
||||||
[:profile-complaint-max-age {:optional true} ::dt/duration]
|
[:profile-complaint-max-age {:optional true} ::dt/duration]
|
||||||
[:profile-complaint-threshold {:optional true} ::sm/int]
|
[: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-blacklist {:optional true} ::fs/path]
|
||||||
[:email-domain-whitelist {:optional true} ::fs/path]
|
[:email-domain-whitelist {:optional true} ::fs/path]
|
||||||
|
@ -218,14 +218,14 @@
|
||||||
[:storage-assets-fs-directory {:optional true} :string]
|
[:storage-assets-fs-directory {:optional true} :string]
|
||||||
[:storage-assets-s3-bucket {:optional true} :string]
|
[:storage-assets-s3-bucket {:optional true} :string]
|
||||||
[:storage-assets-s3-region {:optional true} :keyword]
|
[: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]
|
[:storage-assets-s3-io-threads {:optional true} ::sm/int]
|
||||||
|
|
||||||
[:objects-storage-backend {:optional true} :keyword]
|
[:objects-storage-backend {:optional true} :keyword]
|
||||||
[:objects-storage-fs-directory {:optional true} :string]
|
[:objects-storage-fs-directory {:optional true} :string]
|
||||||
[:objects-storage-s3-bucket {:optional true} :string]
|
[:objects-storage-s3-bucket {:optional true} :string]
|
||||||
[:objects-storage-s3-region {:optional true} :keyword]
|
[: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]]))
|
[:objects-storage-s3-io-threads {:optional true} ::sm/int]]))
|
||||||
|
|
||||||
(def default-flags
|
(def default-flags
|
||||||
|
|
|
@ -11,7 +11,7 @@
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.geom.point :as gpt]
|
[app.common.geom.point :as gpt]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.transit :as t]
|
[app.common.transit :as t]
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[app.db.sql :as sql]
|
[app.db.sql :as sql]
|
||||||
|
@ -20,7 +20,6 @@
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.java.io :as io]
|
[clojure.java.io :as io]
|
||||||
[clojure.set :as set]
|
[clojure.set :as set]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[next.jdbc :as jdbc]
|
[next.jdbc :as jdbc]
|
||||||
[next.jdbc.date-time :as jdbc-dt])
|
[next.jdbc.date-time :as jdbc-dt])
|
||||||
|
@ -49,27 +48,17 @@
|
||||||
;; Initialization
|
;; Initialization
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::connection-timeout ::us/integer)
|
(def ^:private schema:pool-options
|
||||||
(s/def ::max-size ::us/integer)
|
[:map {:title "pool-options"}
|
||||||
(s/def ::min-size ::us/integer)
|
[::connect-timeout {:optional true} ::sm/int]
|
||||||
(s/def ::name keyword?)
|
[::max-size {:optional true} ::sm/int]
|
||||||
(s/def ::password ::us/string)
|
[::min-size {:optional true} ::sm/int]
|
||||||
(s/def ::uri ::us/not-empty-string)
|
[::name {:optional true} :keyword]
|
||||||
(s/def ::username ::us/string)
|
[::uri {:optional true} ::sm/uri]
|
||||||
(s/def ::validation-timeout ::us/integer)
|
[::password {:optional true} :string]
|
||||||
(s/def ::read-only? ::us/boolean)
|
[::username {:optional true} :string]
|
||||||
|
[::validation-timeout {:optional true} ::sm/int]
|
||||||
(s/def ::pool-options
|
[::read-only {:optional true} ::sm/boolean]])
|
||||||
(s/keys :opt [::uri
|
|
||||||
::name
|
|
||||||
::min-size
|
|
||||||
::max-size
|
|
||||||
::connection-timeout
|
|
||||||
::validation-timeout
|
|
||||||
::username
|
|
||||||
::password
|
|
||||||
::mtx/metrics
|
|
||||||
::read-only?]))
|
|
||||||
|
|
||||||
(def defaults
|
(def defaults
|
||||||
{::name :main
|
{::name :main
|
||||||
|
@ -79,27 +68,26 @@
|
||||||
::validation-timeout 10000
|
::validation-timeout 10000
|
||||||
::idle-timeout 120000 ; 2min
|
::idle-timeout 120000 ; 2min
|
||||||
::max-lifetime 1800000 ; 30m
|
::max-lifetime 1800000 ; 30m
|
||||||
::read-only? false})
|
::read-only false})
|
||||||
|
|
||||||
(defmethod ig/prep-key ::pool
|
(defmethod ig/assert-key ::pool
|
||||||
[_ cfg]
|
[_ options]
|
||||||
(merge defaults (d/without-nils cfg)))
|
(assert (sm/check schema:pool-options options)))
|
||||||
|
|
||||||
;; Don't validate here, just validate that a map is received.
|
|
||||||
(defmethod ig/pre-init-spec ::pool [_] ::pool-options)
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::pool
|
(defmethod ig/init-key ::pool
|
||||||
[_ {:keys [::uri ::read-only?] :as cfg}]
|
[_ cfg]
|
||||||
(when uri
|
(let [{:keys [::uri ::read-only] :as cfg}
|
||||||
(l/info :hint "initialize connection pool"
|
(merge defaults cfg)]
|
||||||
:name (d/name (::name cfg))
|
(when uri
|
||||||
:uri uri
|
(l/info :hint "initialize connection pool"
|
||||||
:read-only read-only?
|
:name (d/name (::name cfg))
|
||||||
:with-credentials (and (contains? cfg ::username)
|
:uri (str uri)
|
||||||
(contains? cfg ::password))
|
:read-only read-only
|
||||||
:min-size (::min-size cfg)
|
:credentials (and (contains? cfg ::username)
|
||||||
:max-size (::max-size cfg))
|
(contains? cfg ::password))
|
||||||
(create-pool cfg)))
|
:min-size (::min-size cfg)
|
||||||
|
:max-size (::max-size cfg))
|
||||||
|
(create-pool cfg))))
|
||||||
|
|
||||||
(defmethod ig/halt-key! ::pool
|
(defmethod ig/halt-key! ::pool
|
||||||
[_ pool]
|
[_ pool]
|
||||||
|
@ -115,13 +103,15 @@
|
||||||
"SET idle_in_transaction_session_timeout = 300000;"))
|
"SET idle_in_transaction_session_timeout = 300000;"))
|
||||||
|
|
||||||
(defn- create-datasource-config
|
(defn- create-datasource-config
|
||||||
[{:keys [::mtx/metrics ::uri] :as cfg}]
|
[{:keys [::uri] :as cfg}]
|
||||||
|
|
||||||
|
;; (app.common.pprint/pprint cfg)
|
||||||
(let [config (HikariConfig.)]
|
(let [config (HikariConfig.)]
|
||||||
(doto config
|
(doto config
|
||||||
(.setJdbcUrl (str "jdbc:" uri))
|
(.setJdbcUrl (str "jdbc:" uri))
|
||||||
(.setPoolName (d/name (::name cfg)))
|
(.setPoolName (d/name (::name cfg)))
|
||||||
(.setAutoCommit true)
|
(.setAutoCommit true)
|
||||||
(.setReadOnly (::read-only? cfg))
|
(.setReadOnly (::read-only cfg))
|
||||||
(.setConnectionTimeout (::connection-timeout cfg))
|
(.setConnectionTimeout (::connection-timeout cfg))
|
||||||
(.setValidationTimeout (::validation-timeout cfg))
|
(.setValidationTimeout (::validation-timeout cfg))
|
||||||
(.setIdleTimeout (::idle-timeout cfg))
|
(.setIdleTimeout (::idle-timeout cfg))
|
||||||
|
@ -132,8 +122,8 @@
|
||||||
(.setInitializationFailTimeout -1))
|
(.setInitializationFailTimeout -1))
|
||||||
|
|
||||||
;; When metrics namespace is provided
|
;; When metrics namespace is provided
|
||||||
(when metrics
|
(when-let [instance (::mtx/metrics cfg)]
|
||||||
(->> (::mtx/registry metrics)
|
(->> (mtx/get-registry instance)
|
||||||
(PrometheusMetricsTrackerFactory.)
|
(PrometheusMetricsTrackerFactory.)
|
||||||
(.setMetricsTrackerFactory config)))
|
(.setMetricsTrackerFactory config)))
|
||||||
|
|
||||||
|
@ -150,10 +140,22 @@
|
||||||
[conn]
|
[conn]
|
||||||
(instance? Connection conn))
|
(instance? Connection conn))
|
||||||
|
|
||||||
(s/def ::conn some?)
|
(defn connectable?
|
||||||
(s/def ::nilable-pool (s/nilable ::pool))
|
[o]
|
||||||
(s/def ::pool pool?)
|
(or (connection? o)
|
||||||
(s/def ::connectable some?)
|
(pool? o)))
|
||||||
|
|
||||||
|
(sm/register!
|
||||||
|
{:type ::conn
|
||||||
|
:pred connection?})
|
||||||
|
|
||||||
|
(sm/register!
|
||||||
|
{:type ::connectable
|
||||||
|
:pred connectable?})
|
||||||
|
|
||||||
|
(sm/register!
|
||||||
|
{:type ::pool
|
||||||
|
:pred pool?})
|
||||||
|
|
||||||
(defn closed?
|
(defn closed?
|
||||||
[pool]
|
[pool]
|
||||||
|
|
|
@ -12,18 +12,12 @@
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.pprint :as pp]
|
[app.common.pprint :as pp]
|
||||||
[app.common.schema :as sm]
|
[app.common.schema :as sm]
|
||||||
[app.common.spec :as us]
|
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.db.sql :as sql]
|
[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.util.template :as tmpl]
|
||||||
[app.worker :as wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.java.io :as io]
|
[clojure.java.io :as io]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig])
|
[integrant.core :as ig])
|
||||||
(:import
|
(:import
|
||||||
|
@ -223,50 +217,47 @@
|
||||||
[{:type "text/html"
|
[{:type "text/html"
|
||||||
:content html}]))}))
|
:content html}]))}))
|
||||||
|
|
||||||
(s/def ::priority #{:high :low})
|
(def ^:private schema:context
|
||||||
(s/def ::to (s/or :single ::us/email
|
[:map
|
||||||
:multi (s/coll-of ::us/email)))
|
[:to [:or ::sm/email [::sm/vec ::sm/email]]]
|
||||||
(s/def ::from ::us/email)
|
[:reply-to {:optional true} ::sm/email]
|
||||||
(s/def ::reply-to ::us/email)
|
[:from {:optional true} ::sm/email]
|
||||||
(s/def ::lang string?)
|
[:lang {:optional true} ::sm/text]
|
||||||
(s/def ::extra-data ::us/string)
|
[:priority {:optional true} [:enum :high :low]]
|
||||||
|
[:extra-data {:optional true} ::sm/text]])
|
||||||
|
|
||||||
(s/def ::context
|
(def ^:private valid-context?
|
||||||
(s/keys :req-un [::to]
|
(sm/validator schema:context))
|
||||||
:opt-un [::reply-to ::from ::lang ::priority ::extra-data]))
|
|
||||||
|
|
||||||
(defn template-factory
|
(defn template-factory
|
||||||
([id] (template-factory id {}))
|
[& {:keys [id schema]}]
|
||||||
([id extra-context]
|
(assert (keyword? id) "id should be provided and it should be a keyword")
|
||||||
(s/assert keyword? id)
|
(let [check-fn (if schema
|
||||||
(fn [context]
|
(sm/check-fn schema)
|
||||||
(us/verify ::context context)
|
(constantly nil))]
|
||||||
(when-let [spec (s/get-spec id)]
|
(fn [context]
|
||||||
(s/assert spec context))
|
(assert (valid-context? context) "expected a valid context")
|
||||||
|
(check-fn context)
|
||||||
|
|
||||||
(let [context (merge (if (fn? extra-context)
|
(let [email (build-email-template id context)]
|
||||||
(extra-context)
|
(when-not email
|
||||||
extra-context)
|
(ex/raise :type :internal
|
||||||
context)
|
:code :email-template-does-not-exists
|
||||||
email (build-email-template id context)]
|
:hint "seems like the template is wrong or does not exists."
|
||||||
(when-not email
|
:template-id id))
|
||||||
(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))
|
|
||||||
|
|
||||||
(:from context)
|
(cond-> (assoc email :id (name id))
|
||||||
(assoc :from (:from context))
|
(:extra-data context)
|
||||||
|
(assoc :extra-data (:extra-data context))
|
||||||
|
|
||||||
(:reply-to context)
|
(:from context)
|
||||||
(assoc :reply-to (:reply-to context))
|
(assoc :from (:from context))
|
||||||
|
|
||||||
(:to context)
|
(:reply-to context)
|
||||||
(assoc :to (:to context)))))))
|
(assoc :reply-to (:reply-to context))
|
||||||
|
|
||||||
|
(:to context)
|
||||||
|
(assoc :to (:to context)))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; PUBLIC HIGH-LEVEL API
|
;; PUBLIC HIGH-LEVEL API
|
||||||
|
@ -280,7 +271,8 @@
|
||||||
"Schedule an already defined email to be sent using asynchronously
|
"Schedule an already defined email to be sent using asynchronously
|
||||||
using worker task."
|
using worker task."
|
||||||
[{:keys [::conn ::factory] :as context}]
|
[{:keys [::conn ::factory] :as context}]
|
||||||
(us/verify some? conn)
|
(assert (db/connection? conn) "expected a valid database connection")
|
||||||
|
|
||||||
(let [email (if factory
|
(let [email (if factory
|
||||||
(factory context)
|
(factory context)
|
||||||
(dissoc context ::conn))]
|
(dissoc context ::conn))]
|
||||||
|
@ -297,8 +289,6 @@
|
||||||
|
|
||||||
(declare send-to-logger!)
|
(declare send-to-logger!)
|
||||||
|
|
||||||
(s/def ::sendmail fn?)
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::sendmail
|
(defmethod ig/init-key ::sendmail
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
(fn [params]
|
(fn [params]
|
||||||
|
@ -324,8 +314,9 @@
|
||||||
(when (contains? cf/flags :log-emails)
|
(when (contains? cf/flags :log-emails)
|
||||||
(send-to-logger! cfg params))))
|
(send-to-logger! cfg params))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::sendmail ::mtx/metrics]))
|
[_ params]
|
||||||
|
(assert (fn? (::sendmail params)) "expected valid sendmail handler"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ {:keys [::sendmail]}]
|
[_ {:keys [::sendmail]}]
|
||||||
|
@ -352,125 +343,113 @@
|
||||||
;; EMAIL FACTORIES
|
;; EMAIL FACTORIES
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::subject ::us/string)
|
(def ^:private schema:feedback
|
||||||
(s/def ::content ::us/string)
|
[:map
|
||||||
|
[:subject ::sm/text]
|
||||||
(s/def ::feedback
|
[:content ::sm/text]])
|
||||||
(s/keys :req-un [::subject ::content]))
|
|
||||||
|
|
||||||
(def feedback
|
(def feedback
|
||||||
"A profile feedback email."
|
"A profile feedback email."
|
||||||
(template-factory ::feedback))
|
(template-factory
|
||||||
|
:id ::feedback
|
||||||
|
:schema schema:feedback))
|
||||||
|
|
||||||
(s/def ::name ::us/string)
|
(def ^:private schema:register
|
||||||
(s/def ::register
|
[:map [:name ::sm/text]])
|
||||||
(s/keys :req-un [::name]))
|
|
||||||
|
|
||||||
(def register
|
(def register
|
||||||
"A new profile registration welcome email."
|
"A new profile registration welcome email."
|
||||||
(template-factory ::register))
|
(template-factory
|
||||||
|
:id ::register
|
||||||
|
:schema schema:register))
|
||||||
|
|
||||||
(s/def ::token ::us/string)
|
(def ^:private schema:password-recovery
|
||||||
(s/def ::password-recovery
|
[:map
|
||||||
(s/keys :req-un [::name ::token]))
|
[:name ::sm/text]
|
||||||
|
[:token ::sm/text]])
|
||||||
|
|
||||||
(def password-recovery
|
(def password-recovery
|
||||||
"A password recovery notification email."
|
"A password recovery notification email."
|
||||||
(template-factory ::password-recovery))
|
(template-factory
|
||||||
|
:id ::password-recovery
|
||||||
|
:schema schema:password-recovery))
|
||||||
|
|
||||||
(s/def ::pending-email ::us/email)
|
(def ^:private schema:change-email
|
||||||
(s/def ::change-email
|
[:map
|
||||||
(s/keys :req-un [::name ::pending-email ::token]))
|
[:name ::sm/text]
|
||||||
|
[:pending-email ::sm/email]
|
||||||
|
[:token ::sm/text]])
|
||||||
|
|
||||||
(def change-email
|
(def change-email
|
||||||
"Password change confirmation email"
|
"Password change confirmation email"
|
||||||
(template-factory ::change-email))
|
(template-factory
|
||||||
|
:id ::change-email
|
||||||
|
:schema schema:change-email))
|
||||||
|
|
||||||
(s/def ::email.invite-to-team/invited-by ::us/string)
|
(def ^:private schema:invite-to-team
|
||||||
(s/def ::email.invite-to-team/team ::us/string)
|
[:map
|
||||||
(s/def ::email.invite-to-team/token ::us/string)
|
[:invited-by ::sm/text]
|
||||||
|
[:team ::sm/text]
|
||||||
(s/def ::invite-to-team
|
[:token ::sm/text]])
|
||||||
(s/keys :req-un [::email.invite-to-team/invited-by
|
|
||||||
::email.invite-to-team/token
|
|
||||||
::email.invite-to-team/team]))
|
|
||||||
|
|
||||||
(def invite-to-team
|
(def invite-to-team
|
||||||
"Teams member invitation email."
|
"Teams member invitation email."
|
||||||
(template-factory ::invite-to-team))
|
(template-factory
|
||||||
|
:id ::invite-to-team
|
||||||
|
:schema schema:invite-to-team))
|
||||||
|
|
||||||
|
(def ^:private schema:join-team
|
||||||
(s/def ::email.join-team/invited-by ::us/string)
|
[:map
|
||||||
(s/def ::email.join-team/team ::us/string)
|
[:invited-by ::sm/text]
|
||||||
(s/def ::email.join-team/team-id ::us/uuid)
|
[:team ::sm/text]
|
||||||
|
[:team-id ::sm/uuid]])
|
||||||
(s/def ::join-team
|
|
||||||
(s/keys :req-un [::email.join-team/invited-by
|
|
||||||
::email.join-team/team-id
|
|
||||||
::email.join-team/team]))
|
|
||||||
|
|
||||||
(def join-team
|
(def join-team
|
||||||
"Teams member joined after request email."
|
"Teams member joined after request email."
|
||||||
(template-factory ::join-team))
|
(template-factory
|
||||||
|
:id ::join-team
|
||||||
|
:schema schema:join-team))
|
||||||
|
|
||||||
(s/def ::email.request-team-access/requested-by ::us/string)
|
(def ^:private schema:request-file-access
|
||||||
(s/def ::email.request-team-access/requested-by-email ::us/string)
|
[:map
|
||||||
(s/def ::email.request-team-access/team-name ::us/string)
|
[:requested-by ::sm/text]
|
||||||
(s/def ::email.request-team-access/team-id ::us/uuid)
|
[:requested-by-email ::sm/text]
|
||||||
(s/def ::email.request-team-access/file-name ::us/string)
|
[:team-name ::sm/text]
|
||||||
(s/def ::email.request-team-access/file-id ::us/uuid)
|
[:team-id ::sm/uuid]
|
||||||
(s/def ::email.request-team-access/page-id ::us/uuid)
|
[:file-name ::sm/text]
|
||||||
|
[:file-id ::sm/uuid]
|
||||||
(s/def ::request-file-access
|
[:page-id ::sm/uuid]])
|
||||||
(s/keys :req-un [::email.request-team-access/requested-by
|
|
||||||
::email.request-team-access/requested-by-email
|
|
||||||
::email.request-team-access/team-name
|
|
||||||
::email.request-team-access/team-id
|
|
||||||
::email.request-team-access/file-name
|
|
||||||
::email.request-team-access/file-id
|
|
||||||
::email.request-team-access/page-id]))
|
|
||||||
|
|
||||||
(def request-file-access
|
(def request-file-access
|
||||||
"File access request email."
|
"File access request email."
|
||||||
(template-factory ::request-file-access))
|
(template-factory
|
||||||
|
:id ::request-file-access
|
||||||
|
:schema schema:request-file-access))
|
||||||
(s/def ::request-file-access-yourpenpot
|
|
||||||
(s/keys :req-un [::email.request-team-access/requested-by
|
|
||||||
::email.request-team-access/requested-by-email
|
|
||||||
::email.request-team-access/team-name
|
|
||||||
::email.request-team-access/team-id
|
|
||||||
::email.request-team-access/file-name
|
|
||||||
::email.request-team-access/file-id
|
|
||||||
::email.request-team-access/page-id]))
|
|
||||||
|
|
||||||
(def request-file-access-yourpenpot
|
(def request-file-access-yourpenpot
|
||||||
"File access on Your Penpot request email."
|
"File access on Your Penpot request email."
|
||||||
(template-factory ::request-file-access-yourpenpot))
|
(template-factory
|
||||||
|
:id ::request-file-access-yourpenpot
|
||||||
(s/def ::request-file-access-yourpenpot-view
|
:schema schema:request-file-access))
|
||||||
(s/keys :req-un [::email.request-team-access/requested-by
|
|
||||||
::email.request-team-access/requested-by-email
|
|
||||||
::email.request-team-access/team-name
|
|
||||||
::email.request-team-access/team-id
|
|
||||||
::email.request-team-access/file-name
|
|
||||||
::email.request-team-access/file-id
|
|
||||||
::email.request-team-access/page-id]))
|
|
||||||
|
|
||||||
(def request-file-access-yourpenpot-view
|
(def request-file-access-yourpenpot-view
|
||||||
"File access on Your Penpot view mode request email."
|
"File access on Your Penpot view mode request email."
|
||||||
(template-factory ::request-file-access-yourpenpot-view))
|
(template-factory
|
||||||
|
:id ::request-file-access-yourpenpot-view
|
||||||
|
:schema schema:request-file-access))
|
||||||
|
|
||||||
(s/def ::request-team-access
|
(def ^:private schema:request-team-access
|
||||||
(s/keys :req-un [::email.request-team-access/requested-by
|
[:map
|
||||||
::email.request-team-access/requested-by-email
|
[:requested-by ::sm/text]
|
||||||
::email.request-team-access/team-name
|
[:requested-by-email ::sm/text]
|
||||||
::email.request-team-access/team-id]))
|
[:team-name ::sm/text]
|
||||||
|
[:team-id ::sm/uuid]])
|
||||||
|
|
||||||
(def request-team-access
|
(def request-team-access
|
||||||
"Team access request email."
|
"Team access request email."
|
||||||
(template-factory ::request-team-access))
|
(template-factory
|
||||||
|
:id ::request-team-access
|
||||||
|
:schema schema:request-team-access))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; BOUNCE/COMPLAINS HELPERS
|
;; BOUNCE/COMPLAINS HELPERS
|
||||||
|
|
|
@ -9,6 +9,7 @@
|
||||||
[app.auth.oidc :as-alias oidc]
|
[app.auth.oidc :as-alias oidc]
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
|
[app.common.schema :as sm]
|
||||||
[app.common.transit :as t]
|
[app.common.transit :as t]
|
||||||
[app.db :as-alias db]
|
[app.db :as-alias db]
|
||||||
[app.http.access-token :as actoken]
|
[app.http.access-token :as actoken]
|
||||||
|
@ -24,7 +25,6 @@
|
||||||
[app.rpc :as-alias rpc]
|
[app.rpc :as-alias rpc]
|
||||||
[app.rpc.doc :as-alias rpc.doc]
|
[app.rpc.doc :as-alias rpc.doc]
|
||||||
[app.setup :as-alias setup]
|
[app.setup :as-alias setup]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px]
|
[promesa.exec :as px]
|
||||||
[reitit.core :as r]
|
[reitit.core :as r]
|
||||||
|
@ -39,31 +39,28 @@
|
||||||
;; HTTP SERVER
|
;; HTTP SERVER
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::handler fn?)
|
(def default-params
|
||||||
(s/def ::router some?)
|
{::port 6060
|
||||||
(s/def ::port integer?)
|
::host "0.0.0.0"
|
||||||
(s/def ::host string?)
|
::max-body-size (* 1024 1024 30) ; default 30 MiB
|
||||||
(s/def ::name string?)
|
::max-multipart-body-size (* 1024 1024 120)}) ; default 120 MiB
|
||||||
|
|
||||||
(s/def ::max-body-size integer?)
|
(defmethod ig/expand-key ::server
|
||||||
(s/def ::max-multipart-body-size integer?)
|
[k v]
|
||||||
(s/def ::io-threads integer?)
|
{k (merge default-params (d/without-nils v))})
|
||||||
|
|
||||||
(defmethod ig/prep-key ::server
|
(def ^:private schema:server-params
|
||||||
[_ cfg]
|
[:map
|
||||||
(merge {::port 6060
|
[::port ::sm/int]
|
||||||
::host "0.0.0.0"
|
[::host ::sm/text]
|
||||||
::max-body-size (* 1024 1024 30) ; default 30 MiB
|
[::max-body-size {:optional true} ::sm/int]
|
||||||
::max-multipart-body-size (* 1024 1024 120)} ; default 120 MiB
|
[::max-multipart-body-size {:optional true} ::sm/int]
|
||||||
(d/without-nils cfg)))
|
[::router {:optional true} [:fn r/router?]]
|
||||||
|
[::handler {:optional true} ::sm/fn]])
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::server [_]
|
(defmethod ig/assert-key ::server
|
||||||
(s/keys :req [::port ::host]
|
[_ params]
|
||||||
:opt [::max-body-size
|
(assert (sm/check schema:server-params params)))
|
||||||
::max-multipart-body-size
|
|
||||||
::router
|
|
||||||
::handler
|
|
||||||
::io-threads]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::server
|
(defmethod ig/init-key ::server
|
||||||
[_ {:keys [::handler ::router ::host ::port] :as cfg}]
|
[_ {:keys [::handler ::router ::host ::port] :as cfg}]
|
||||||
|
@ -131,18 +128,26 @@
|
||||||
;; HTTP ROUTER
|
;; HTTP ROUTER
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::router [_]
|
(def ^:private schema:routes
|
||||||
(s/keys :req [::session/manager
|
[:vector :any])
|
||||||
::ws/routes
|
|
||||||
::rpc/routes
|
(def ^:private schema:router-params
|
||||||
::rpc.doc/routes
|
[:map
|
||||||
::oidc/routes
|
[::ws/routes schema:routes]
|
||||||
::setup/props
|
[::rpc/routes schema:routes]
|
||||||
::assets/routes
|
[::rpc.doc/routes schema:routes]
|
||||||
::debug/routes
|
[::oidc/routes schema:routes]
|
||||||
::db/pool
|
[::assets/routes schema:routes]
|
||||||
::mtx/routes
|
[::debug/routes schema:routes]
|
||||||
::awsns/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
|
(defmethod ig/init-key ::router
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -9,12 +9,10 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.spec :as us]
|
|
||||||
[app.common.uri :as u]
|
[app.common.uri :as u]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.storage :as sto]
|
[app.storage :as sto]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[yetti.response :as-alias yres]))
|
[yetti.response :as-alias yres]))
|
||||||
|
|
||||||
|
@ -95,11 +93,10 @@
|
||||||
|
|
||||||
;; --- Initialization
|
;; --- Initialization
|
||||||
|
|
||||||
(s/def ::path ::us/string)
|
(defmethod ig/assert-key ::routes
|
||||||
(s/def ::routes vector?)
|
[_ params]
|
||||||
|
(assert (sto/valid-storage? (::sto/storage params)) "expected valid storage instance")
|
||||||
(defmethod ig/pre-init-spec ::routes [_]
|
(assert (string? (::path params))))
|
||||||
(s/keys :req [::sto/storage ::path]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::routes
|
(defmethod ig/init-key ::routes
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -10,6 +10,7 @@
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.pprint :as pp]
|
[app.common.pprint :as pp]
|
||||||
|
[app.common.schema :as sm]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.db.sql :as sql]
|
[app.db.sql :as sql]
|
||||||
[app.http.client :as http]
|
[app.http.client :as http]
|
||||||
|
@ -18,7 +19,6 @@
|
||||||
[app.tokens :as tokens]
|
[app.tokens :as tokens]
|
||||||
[app.worker :as-alias wrk]
|
[app.worker :as-alias wrk]
|
||||||
[clojure.data.json :as j]
|
[clojure.data.json :as j]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px]
|
[promesa.exec :as px]
|
||||||
|
@ -30,10 +30,11 @@
|
||||||
(declare parse-notification)
|
(declare parse-notification)
|
||||||
(declare process-report)
|
(declare process-report)
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::routes [_]
|
(defmethod ig/assert-key ::routes
|
||||||
(s/keys :req [::http/client
|
[_ params]
|
||||||
::setup/props
|
(assert (http/client? (::http/client params)) "expect a valid http client")
|
||||||
::db/pool]))
|
(assert (sm/valid? ::setup/props (::setup/props params)) "expected valid setup props")
|
||||||
|
(assert (db/pool? (::db/pool params)) "expect valid database pool"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::routes
|
(defmethod ig/init-key ::routes
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -7,20 +7,20 @@
|
||||||
(ns app.http.client
|
(ns app.http.client
|
||||||
"Http client abstraction layer."
|
"Http client abstraction layer."
|
||||||
(:require
|
(:require
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[java-http-clj.core :as http]
|
[java-http-clj.core :as http]
|
||||||
[promesa.core :as p])
|
[promesa.core :as p])
|
||||||
(:import
|
(:import
|
||||||
java.net.http.HttpClient))
|
java.net.http.HttpClient))
|
||||||
|
|
||||||
(s/def ::client #(instance? HttpClient %))
|
(defn client?
|
||||||
(s/def ::client-holder
|
[o]
|
||||||
(s/keys :req [::client]))
|
(instance? HttpClient o))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::client [_]
|
(sm/register!
|
||||||
(s/keys :req []))
|
{:type ::client
|
||||||
|
:pred client?})
|
||||||
|
|
||||||
(defmethod ig/init-key ::client
|
(defmethod ig/init-key ::client
|
||||||
[_ _]
|
[_ _]
|
||||||
|
@ -30,7 +30,7 @@
|
||||||
(defn send!
|
(defn send!
|
||||||
([client req] (send! client req {}))
|
([client req] (send! client req {}))
|
||||||
([client req {:keys [response-type sync?] :or {response-type :string sync? false}}]
|
([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?
|
(if sync?
|
||||||
(http/send req {:client client :as response-type})
|
(http/send req {:client client :as response-type})
|
||||||
(try
|
(try
|
||||||
|
|
|
@ -26,7 +26,6 @@
|
||||||
[app.util.blob :as blob]
|
[app.util.blob :as blob]
|
||||||
[app.util.template :as tmpl]
|
[app.util.template :as tmpl]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[datoteka.io :as io]
|
[datoteka.io :as io]
|
||||||
[emoji.core :as emj]
|
[emoji.core :as emj]
|
||||||
|
@ -473,8 +472,10 @@
|
||||||
(ex/raise :type :authentication
|
(ex/raise :type :authentication
|
||||||
:code :only-admins-allowed)))))})
|
:code :only-admins-allowed)))))})
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::routes [_]
|
(defmethod ig/assert-key ::routes
|
||||||
(s/keys :req [::db/pool ::session/manager]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool")
|
||||||
|
(assert (session/manager? (::session/manager params)) "expected a valid session manager"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::routes
|
(defmethod ig/init-key ::routes
|
||||||
[_ {:keys [::db/pool] :as cfg}]
|
[_ {:keys [::db/pool] :as cfg}]
|
||||||
|
|
|
@ -9,7 +9,7 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uri :as u]
|
[app.common.uri :as u]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
|
@ -19,7 +19,6 @@
|
||||||
[app.setup :as-alias setup]
|
[app.setup :as-alias setup]
|
||||||
[app.tokens :as tokens]
|
[app.tokens :as tokens]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[yetti.request :as yreq]))
|
[yetti.request :as yreq]))
|
||||||
|
@ -51,21 +50,32 @@
|
||||||
(update! [_ data])
|
(update! [_ data])
|
||||||
(delete! [_ key]))
|
(delete! [_ key]))
|
||||||
|
|
||||||
(s/def ::manager #(satisfies? ISessionManager %))
|
(defn manager?
|
||||||
|
[o]
|
||||||
|
(satisfies? ISessionManager o))
|
||||||
|
|
||||||
|
(sm/register!
|
||||||
|
{:type ::manager
|
||||||
|
:pred manager?})
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; STORAGE IMPL
|
;; STORAGE IMPL
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::session-params
|
(def ^:private schema:params
|
||||||
(s/keys :req-un [::user-agent
|
[:map {:title "session-params"}
|
||||||
::profile-id
|
[:user-agent ::sm/text]
|
||||||
::created-at]))
|
[:profile-id ::sm/uuid]
|
||||||
|
[:created-at ::sm/inst]])
|
||||||
|
|
||||||
|
(def ^:private valid-params?
|
||||||
|
(sm/validator schema:params))
|
||||||
|
|
||||||
(defn- prepare-session-params
|
(defn- prepare-session-params
|
||||||
[key params]
|
[key params]
|
||||||
(us/assert! ::us/not-empty-string key)
|
(assert (string? key) "expected key to be a string")
|
||||||
(us/assert! ::session-params params)
|
(assert (not (str/blank? key)) "expected key to be not empty")
|
||||||
|
(assert (valid-params? params) "expected valid params")
|
||||||
|
|
||||||
{:user-agent (:user-agent params)
|
{:user-agent (:user-agent params)
|
||||||
:profile-id (:profile-id params)
|
:profile-id (:profile-id params)
|
||||||
|
@ -116,8 +126,9 @@
|
||||||
(swap! cache dissoc token)
|
(swap! cache dissoc token)
|
||||||
nil))))
|
nil))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::manager [_]
|
(defmethod ig/assert-key ::manager
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expect valid database pool"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::manager
|
(defmethod ig/init-key ::manager
|
||||||
[_ {:keys [::db/pool]}]
|
[_ {:keys [::db/pool]}]
|
||||||
|
@ -140,8 +151,8 @@
|
||||||
|
|
||||||
(defn create-fn
|
(defn create-fn
|
||||||
[{:keys [::manager ::setup/props]} profile-id]
|
[{:keys [::manager ::setup/props]} profile-id]
|
||||||
(us/assert! ::manager manager)
|
(assert (manager? manager) "expected valid session manager")
|
||||||
(us/assert! ::us/uuid profile-id)
|
(assert (uuid? profile-id) "expected valid uuid for profile-id")
|
||||||
|
|
||||||
(fn [request response]
|
(fn [request response]
|
||||||
(let [uagent (yreq/get-header request "user-agent")
|
(let [uagent (yreq/get-header request "user-agent")
|
||||||
|
@ -157,7 +168,7 @@
|
||||||
|
|
||||||
(defn delete-fn
|
(defn delete-fn
|
||||||
[{:keys [::manager]}]
|
[{:keys [::manager]}]
|
||||||
(us/assert! ::manager manager)
|
(assert (manager? manager) "expected valid session manager")
|
||||||
(fn [request response]
|
(fn [request response]
|
||||||
(let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
|
(let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
|
||||||
cookie (yreq/get-cookie request cname)]
|
cookie (yreq/get-cookie request cname)]
|
||||||
|
@ -198,7 +209,7 @@
|
||||||
|
|
||||||
(defn- wrap-soft-auth
|
(defn- wrap-soft-auth
|
||||||
[handler {:keys [::manager ::setup/props]}]
|
[handler {:keys [::manager ::setup/props]}]
|
||||||
(us/assert! ::manager manager)
|
(assert (manager? manager) "expected valid session manager")
|
||||||
(letfn [(handle-request [request]
|
(letfn [(handle-request [request]
|
||||||
(try
|
(try
|
||||||
(let [token (get-token request)
|
(let [token (get-token request)
|
||||||
|
@ -216,7 +227,7 @@
|
||||||
|
|
||||||
(defn- wrap-authz
|
(defn- wrap-authz
|
||||||
[handler {:keys [::manager]}]
|
[handler {:keys [::manager]}]
|
||||||
(us/assert! ::manager manager)
|
(assert (manager? manager) "expected valid session manager")
|
||||||
(fn [request]
|
(fn [request]
|
||||||
(let [session (get-session manager (::token request))
|
(let [session (get-session manager (::token request))
|
||||||
request (cond-> request
|
request (cond-> request
|
||||||
|
@ -307,16 +318,17 @@
|
||||||
;; TASK: SESSION GC
|
;; TASK: SESSION GC
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::tasks/max-age ::dt/duration)
|
;; FIXME: MOVE
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::tasks/gc [_]
|
(defmethod ig/assert-key ::tasks/gc
|
||||||
(s/keys :req [::db/pool]
|
[_ params]
|
||||||
:opt [::tasks/max-age]))
|
(assert (db/pool? (::db/pool params)) "expected valid database pool")
|
||||||
|
(assert (dt/duration? (::tasks/max-age params))))
|
||||||
|
|
||||||
(defmethod ig/prep-key ::tasks/gc
|
(defmethod ig/expand-key ::tasks/gc
|
||||||
[_ cfg]
|
[k v]
|
||||||
(let [max-age (cf/get :auth-token-cookie-max-age default-cookie-max-age)]
|
(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
|
(def ^:private
|
||||||
sql:delete-expired
|
sql:delete-expired
|
||||||
|
|
|
@ -18,7 +18,6 @@
|
||||||
[app.msgbus :as mbus]
|
[app.msgbus :as mbus]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.util.websocket :as ws]
|
[app.util.websocket :as ws]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec.csp :as sp]
|
[promesa.exec.csp :as sp]
|
||||||
[yetti.websocket :as yws]))
|
[yetti.websocket :as yws]))
|
||||||
|
@ -305,13 +304,17 @@
|
||||||
::profile-id profile-id
|
::profile-id profile-id
|
||||||
::session-id session-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
|
(defmethod ig/init-key ::routes
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -10,7 +10,7 @@
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.data.macros :as dm]
|
[app.common.data.macros :as dm]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
|
@ -25,9 +25,7 @@
|
||||||
[app.util.services :as-alias sv]
|
[app.util.services :as-alias sv]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.spec.alpha :as s]
|
[cuerdas.core :as str]))
|
||||||
[cuerdas.core :as str]
|
|
||||||
[integrant.core :as ig]))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; HELPERS
|
;; HELPERS
|
||||||
|
@ -95,46 +93,28 @@
|
||||||
;; --- SPECS
|
;; --- SPECS
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; COLLECTOR
|
;; COLLECTOR API
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
;; Defines a service that collects the audit/activity log using
|
;; Defines a service that collects the audit/activity log using
|
||||||
;; internal database. Later this audit log can be transferred to
|
;; internal database. Later this audit log can be transferred to
|
||||||
;; an external storage and data cleared.
|
;; an external storage and data cleared.
|
||||||
|
|
||||||
(s/def ::profile-id ::us/uuid)
|
(def ^:private schema:event
|
||||||
(s/def ::name ::us/string)
|
[:map {:title "event"}
|
||||||
(s/def ::type ::us/string)
|
[::type ::sm/text]
|
||||||
(s/def ::props (s/map-of ::us/keyword any?))
|
[::name ::sm/text]
|
||||||
(s/def ::ip-addr ::us/string)
|
[::profile-id ::sm/uuid]
|
||||||
|
[::ip-addr {:optional true} ::sm/text]
|
||||||
|
[::props {:optional true} [:map-of :keyword :any]]
|
||||||
|
[::context {:optional true} [:map-of :keyword :any]]
|
||||||
|
[::webhooks/event? {:optional true} ::sm/boolean]
|
||||||
|
[::webhooks/batch-timeout {:optional true} ::dt/duration]
|
||||||
|
[::webhooks/batch-key {:optional true}
|
||||||
|
[:or ::sm/fn ::sm/text :keyword]]])
|
||||||
|
|
||||||
(s/def ::webhooks/event? ::us/boolean)
|
(def ^:private check-event
|
||||||
(s/def ::webhooks/batch-timeout ::dt/duration)
|
(sm/check-fn schema:event))
|
||||||
(s/def ::webhooks/batch-key
|
|
||||||
(s/or :fn fn? :str string? :kw keyword?))
|
|
||||||
|
|
||||||
(s/def ::event
|
|
||||||
(s/keys :req [::type ::name ::profile-id]
|
|
||||||
:opt [::ip-addr
|
|
||||||
::props
|
|
||||||
::webhooks/event?
|
|
||||||
::webhooks/batch-timeout
|
|
||||||
::webhooks/batch-key]))
|
|
||||||
|
|
||||||
(s/def ::collector
|
|
||||||
(s/keys :req [::wrk/executor ::db/pool]))
|
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::collector [_]
|
|
||||||
(s/keys :req [::db/pool ::wrk/executor]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::collector
|
|
||||||
[_ {:keys [::db/pool] :as cfg}]
|
|
||||||
(cond
|
|
||||||
(db/read-only? pool)
|
|
||||||
(l/warn :hint "audit disabled (db is read-only)")
|
|
||||||
|
|
||||||
:else
|
|
||||||
cfg))
|
|
||||||
|
|
||||||
(defn prepare-event
|
(defn prepare-event
|
||||||
[cfg mdata params result]
|
[cfg mdata params result]
|
||||||
|
@ -273,12 +253,12 @@
|
||||||
"Submit audit event to the collector."
|
"Submit audit event to the collector."
|
||||||
[cfg event]
|
[cfg event]
|
||||||
(try
|
(try
|
||||||
(let [event (d/without-nils event)
|
(let [event (-> (d/without-nils event)
|
||||||
|
(check-event))
|
||||||
cfg (-> cfg
|
cfg (-> cfg
|
||||||
(assoc ::rtry/when rtry/conflict-exception?)
|
(assoc ::rtry/when rtry/conflict-exception?)
|
||||||
(assoc ::rtry/max-retries 6)
|
(assoc ::rtry/max-retries 6)
|
||||||
(assoc ::rtry/label "persist-audit-log"))]
|
(assoc ::rtry/label "persist-audit-log"))]
|
||||||
(us/verify! ::event event)
|
|
||||||
(rtry/invoke! cfg db/tx-run! handle-event! event))
|
(rtry/invoke! cfg db/tx-run! handle-event! event))
|
||||||
(catch Throwable cause
|
(catch Throwable cause
|
||||||
(l/error :hint "unexpected error processing event" :cause cause))))
|
(l/error :hint "unexpected error processing event" :cause cause))))
|
||||||
|
@ -289,8 +269,8 @@
|
||||||
logic."
|
logic."
|
||||||
[cfg event]
|
[cfg event]
|
||||||
(when (contains? cf/flags :audit-log)
|
(when (contains? cf/flags :audit-log)
|
||||||
(let [event (d/without-nils event)]
|
(let [event (-> (d/without-nils event)
|
||||||
(us/verify! ::event event)
|
(check-event))]
|
||||||
(db/run! cfg (fn [cfg]
|
(db/run! cfg (fn [cfg]
|
||||||
(let [tnow (dt/now)
|
(let [tnow (dt/now)
|
||||||
params (-> (event->params event)
|
params (-> (event->params event)
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
|
[app.common.schema :as sm]
|
||||||
[app.common.transit :as t]
|
[app.common.transit :as t]
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
|
@ -16,7 +17,6 @@
|
||||||
[app.setup :as-alias setup]
|
[app.setup :as-alias setup]
|
||||||
[app.tokens :as tokens]
|
[app.tokens :as tokens]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[lambdaisland.uri :as u]
|
[lambdaisland.uri :as u]
|
||||||
[promesa.exec :as px]))
|
[promesa.exec :as px]))
|
||||||
|
@ -108,8 +108,15 @@
|
||||||
(mark-archived! cfg rows)
|
(mark-archived! cfg rows)
|
||||||
(count events)))))))
|
(count events)))))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(def ^:private schema:handler-params
|
||||||
(s/keys :req [::db/pool ::setup/props ::http/client]))
|
[:map
|
||||||
|
::db/pool
|
||||||
|
::setup/props
|
||||||
|
::http/client])
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::handler
|
||||||
|
[_ params]
|
||||||
|
(assert (sm/valid? schema:handler-params params) "valid params expected for handler"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -8,7 +8,6 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(def ^:private sql:clean-archived
|
(def ^:private sql:clean-archived
|
||||||
|
@ -22,8 +21,9 @@
|
||||||
(l/debug :hint "delete archived audit log entries" :deleted result)
|
(l/debug :hint "delete archived audit log entries" :deleted result)
|
||||||
result))
|
result))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "valid database pool expected"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -12,7 +12,6 @@
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.pprint :as pp]
|
[app.common.pprint :as pp]
|
||||||
[app.common.schema :as sm]
|
[app.common.schema :as sm]
|
||||||
[app.common.spec :as us]
|
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[clojure.spec.alpha :as s]
|
[clojure.spec.alpha :as s]
|
||||||
|
@ -38,7 +37,7 @@
|
||||||
|
|
||||||
(defn record->report
|
(defn record->report
|
||||||
[{:keys [::l/context ::l/message ::l/props ::l/logger ::l/level ::l/cause] :as record}]
|
[{: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)
|
(if (or (instance? java.util.concurrent.CompletionException cause)
|
||||||
(instance? java.util.concurrent.ExecutionException cause))
|
(instance? java.util.concurrent.ExecutionException cause))
|
||||||
(-> record
|
(-> record
|
||||||
|
@ -91,8 +90,9 @@
|
||||||
(catch Throwable cause
|
(catch Throwable cause
|
||||||
(l/warn :hint "unexpected exception on database error logger" :cause cause))))
|
(l/warn :hint "unexpected exception on database error logger" :cause cause))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::reporter [_]
|
(defmethod ig/assert-key ::reporter
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expect valid database pool"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::reporter
|
(defmethod ig/init-key ::reporter
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -9,12 +9,10 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.http.client :as http]
|
[app.http.client :as http]
|
||||||
[app.loggers.database :as ldb]
|
[app.loggers.database :as ldb]
|
||||||
[app.util.json :as json]
|
[app.util.json :as json]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px]
|
[promesa.exec :as px]
|
||||||
[promesa.exec.csp :as sp]))
|
[promesa.exec.csp :as sp]))
|
||||||
|
@ -54,7 +52,7 @@
|
||||||
|
|
||||||
(defn record->report
|
(defn record->report
|
||||||
[{:keys [::l/context ::l/id ::l/cause] :as record}]
|
[{: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
|
{:id id
|
||||||
:tenant (cf/get :tenant)
|
:tenant (cf/get :tenant)
|
||||||
:host (cf/get :host)
|
:host (cf/get :host)
|
||||||
|
@ -75,8 +73,9 @@
|
||||||
(catch Throwable cause
|
(catch Throwable cause
|
||||||
(l/warn :hint "unhandled error" :cause cause)))))
|
(l/warn :hint "unhandled error" :cause cause)))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::reporter [_]
|
(defmethod ig/assert-key ::reporter
|
||||||
(s/keys :req [::http/client]))
|
[_ params]
|
||||||
|
(assert (http/client? (::http/client params)) "expect valid http client"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::reporter
|
(defmethod ig/init-key ::reporter
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -18,7 +18,6 @@
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.data.json :as json]
|
[clojure.data.json :as json]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
|
@ -60,8 +59,10 @@
|
||||||
(some->> (:project-id props) (lookup-webhooks-by-project pool))
|
(some->> (:project-id props) (lookup-webhooks-by-project pool))
|
||||||
(some->> (:file-id props) (lookup-webhooks-by-file pool))))
|
(some->> (:file-id props) (lookup-webhooks-by-file pool))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::process-event-handler [_]
|
(defmethod ig/assert-key ::process-event-handler
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expect valid database pool")
|
||||||
|
(assert (http/client? (::http/client params)) "expect valid http client"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::process-event-handler
|
(defmethod ig/init-key ::process-event-handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
@ -87,12 +88,14 @@
|
||||||
{:key-fn str/camel
|
{:key-fn str/camel
|
||||||
:indent true})
|
:indent true})
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::run-webhook-handler [_]
|
(defmethod ig/assert-key ::run-webhook-handler
|
||||||
(s/keys :req [::http/client ::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expect valid database pool")
|
||||||
|
(assert (http/client? (::http/client params)) "expect valid http client"))
|
||||||
|
|
||||||
(defmethod ig/prep-key ::run-webhook-handler
|
(defmethod ig/expand-key ::run-webhook-handler
|
||||||
[_ cfg]
|
[k v]
|
||||||
(merge {::max-errors 3} (d/without-nils cfg)))
|
{k (merge {::max-errors 3} (d/without-nils v))})
|
||||||
|
|
||||||
(defmethod ig/init-key ::run-webhook-handler
|
(defmethod ig/init-key ::run-webhook-handler
|
||||||
[_ {:keys [::db/pool ::max-errors] :as cfg}]
|
[_ {:keys [::db/pool ::max-errors] :as cfg}]
|
||||||
|
|
|
@ -9,6 +9,7 @@
|
||||||
[app.auth.ldap :as-alias ldap]
|
[app.auth.ldap :as-alias ldap]
|
||||||
[app.auth.oidc :as-alias oidc]
|
[app.auth.oidc :as-alias oidc]
|
||||||
[app.auth.oidc.providers :as-alias oidc.providers]
|
[app.auth.oidc.providers :as-alias oidc.providers]
|
||||||
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as-alias db]
|
[app.db :as-alias db]
|
||||||
|
@ -28,6 +29,7 @@
|
||||||
[app.msgbus :as-alias mbus]
|
[app.msgbus :as-alias mbus]
|
||||||
[app.redis :as-alias rds]
|
[app.redis :as-alias rds]
|
||||||
[app.rpc :as-alias rpc]
|
[app.rpc :as-alias rpc]
|
||||||
|
[app.rpc.climit :as-alias climit]
|
||||||
[app.rpc.doc :as-alias rpc.doc]
|
[app.rpc.doc :as-alias rpc.doc]
|
||||||
[app.setup :as-alias setup]
|
[app.setup :as-alias setup]
|
||||||
[app.srepl :as-alias srepl]
|
[app.srepl :as-alias srepl]
|
||||||
|
@ -169,7 +171,7 @@
|
||||||
{::db/uri (cf/get :database-uri)
|
{::db/uri (cf/get :database-uri)
|
||||||
::db/username (cf/get :database-username)
|
::db/username (cf/get :database-username)
|
||||||
::db/password (cf/get :database-password)
|
::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/min-size (cf/get :database-min-pool-size 0)
|
||||||
::db/max-size (cf/get :database-max-pool-size 60)
|
::db/max-size (cf/get :database-max-pool-size 60)
|
||||||
::mtx/metrics (ig/ref ::mtx/metrics)}
|
::mtx/metrics (ig/ref ::mtx/metrics)}
|
||||||
|
@ -245,7 +247,7 @@
|
||||||
:base-dn (cf/get :ldap-base-dn)
|
:base-dn (cf/get :ldap-base-dn)
|
||||||
:bind-dn (cf/get :ldap-bind-dn)
|
:bind-dn (cf/get :ldap-bind-dn)
|
||||||
:bind-password (cf/get :ldap-bind-password)
|
:bind-password (cf/get :ldap-bind-password)
|
||||||
:enabled? (contains? cf/flags :login-with-ldap)}
|
:enabled (contains? cf/flags :login-with-ldap)}
|
||||||
|
|
||||||
::oidc.providers/google
|
::oidc.providers/google
|
||||||
{}
|
{}
|
||||||
|
@ -302,9 +304,11 @@
|
||||||
::http.assets/cache-max-agesignature-max-age (dt/duration {:hours 24 :minutes 5})
|
::http.assets/cache-max-agesignature-max-age (dt/duration {:hours 24 :minutes 5})
|
||||||
::sto/storage (ig/ref ::sto/storage)}
|
::sto/storage (ig/ref ::sto/storage)}
|
||||||
|
|
||||||
:app.rpc/climit
|
::rpc/climit
|
||||||
{::mtx/metrics (ig/ref ::mtx/metrics)
|
{::mtx/metrics (ig/ref ::mtx/metrics)
|
||||||
::wrk/executor (ig/ref ::wrk/executor)}
|
::wrk/executor (ig/ref ::wrk/executor)
|
||||||
|
::climit/config (cf/get :rpc-climit-config)
|
||||||
|
::climit/enabled (contains? cf/flags :rpc-climit)}
|
||||||
|
|
||||||
:app.rpc/rlimit
|
:app.rpc/rlimit
|
||||||
{::wrk/executor (ig/ref ::wrk/executor)}
|
{::wrk/executor (ig/ref ::wrk/executor)}
|
||||||
|
@ -329,7 +333,7 @@
|
||||||
::email/whitelist (ig/ref ::email/whitelist)}
|
::email/whitelist (ig/ref ::email/whitelist)}
|
||||||
|
|
||||||
:app.rpc.doc/routes
|
:app.rpc.doc/routes
|
||||||
{:methods (ig/ref :app.rpc/methods)}
|
{:app.rpc/methods (ig/ref :app.rpc/methods)}
|
||||||
|
|
||||||
:app.rpc/routes
|
:app.rpc/routes
|
||||||
{::rpc/methods (ig/ref :app.rpc/methods)
|
{::rpc/methods (ig/ref :app.rpc/methods)
|
||||||
|
@ -378,8 +382,7 @@
|
||||||
::email/default-from (cf/get :smtp-default-from)}
|
::email/default-from (cf/get :smtp-default-from)}
|
||||||
|
|
||||||
::email/handler
|
::email/handler
|
||||||
{::email/sendmail (ig/ref ::email/sendmail)
|
{::email/sendmail (ig/ref ::email/sendmail)}
|
||||||
::mtx/metrics (ig/ref ::mtx/metrics)}
|
|
||||||
|
|
||||||
:app.tasks.tasks-gc/handler
|
:app.tasks.tasks-gc/handler
|
||||||
{::db/pool (ig/ref ::db/pool)}
|
{::db/pool (ig/ref ::db/pool)}
|
||||||
|
@ -516,11 +519,13 @@
|
||||||
::wrk/dispatcher
|
::wrk/dispatcher
|
||||||
{::rds/redis (ig/ref ::rds/redis)
|
{::rds/redis (ig/ref ::rds/redis)
|
||||||
::mtx/metrics (ig/ref ::mtx/metrics)
|
::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]
|
[::default ::wrk/runner]
|
||||||
{::wrk/parallelism (cf/get ::worker-default-parallelism 1)
|
{::wrk/parallelism (cf/get ::worker-default-parallelism 1)
|
||||||
::wrk/queue :default
|
::wrk/queue :default
|
||||||
|
::wrk/tenant (cf/get :tenant)
|
||||||
::rds/redis (ig/ref ::rds/redis)
|
::rds/redis (ig/ref ::rds/redis)
|
||||||
::wrk/registry (ig/ref ::wrk/registry)
|
::wrk/registry (ig/ref ::wrk/registry)
|
||||||
::mtx/metrics (ig/ref ::mtx/metrics)
|
::mtx/metrics (ig/ref ::mtx/metrics)
|
||||||
|
@ -529,6 +534,7 @@
|
||||||
[::webhook ::wrk/runner]
|
[::webhook ::wrk/runner]
|
||||||
{::wrk/parallelism (cf/get ::worker-webhook-parallelism 1)
|
{::wrk/parallelism (cf/get ::worker-webhook-parallelism 1)
|
||||||
::wrk/queue :webhooks
|
::wrk/queue :webhooks
|
||||||
|
::wrk/tenant (cf/get :tenant)
|
||||||
::rds/redis (ig/ref ::rds/redis)
|
::rds/redis (ig/ref ::rds/redis)
|
||||||
::wrk/registry (ig/ref ::wrk/registry)
|
::wrk/registry (ig/ref ::wrk/registry)
|
||||||
::mtx/metrics (ig/ref ::mtx/metrics)
|
::mtx/metrics (ig/ref ::mtx/metrics)
|
||||||
|
@ -546,7 +552,7 @@
|
||||||
(-> system-config
|
(-> system-config
|
||||||
(cond-> (contains? cf/flags :backend-worker)
|
(cond-> (contains? cf/flags :backend-worker)
|
||||||
(merge worker-config))
|
(merge worker-config))
|
||||||
(ig/prep)
|
(ig/expand)
|
||||||
(ig/init))))
|
(ig/init))))
|
||||||
(l/inf :hint "welcome to penpot"
|
(l/inf :hint "welcome to penpot"
|
||||||
:flags (str/join "," (map name cf/flags))
|
:flags (str/join "," (map name cf/flags))
|
||||||
|
@ -559,7 +565,7 @@
|
||||||
(alter-var-root #'system (fn [sys]
|
(alter-var-root #'system (fn [sys]
|
||||||
(when sys (ig/halt! sys))
|
(when sys (ig/halt! sys))
|
||||||
(-> config
|
(-> config
|
||||||
(ig/prep)
|
(ig/expand)
|
||||||
(ig/init)))))
|
(ig/init)))))
|
||||||
|
|
||||||
(defn stop
|
(defn stop
|
||||||
|
@ -615,12 +621,6 @@
|
||||||
|
|
||||||
(deref p))
|
(deref p))
|
||||||
(catch Throwable cause
|
(catch Throwable cause
|
||||||
(binding [*out* *err*]
|
(ex/print-throwable cause)
|
||||||
(println "==== ERROR ===="))
|
|
||||||
(.printStackTrace cause)
|
|
||||||
(when-let [cause' (ex-cause cause)]
|
|
||||||
(binding [*out* *err*]
|
|
||||||
(println "==== CAUSE ===="))
|
|
||||||
(.printStackTrace cause'))
|
|
||||||
(px/sleep 500)
|
(px/sleep 500)
|
||||||
(System/exit -1))))
|
(System/exit -1))))
|
||||||
|
|
|
@ -46,14 +46,15 @@
|
||||||
(s/keys :req-un [::path]
|
(s/keys :req-un [::path]
|
||||||
:opt-un [::mtype]))
|
:opt-un [::mtype]))
|
||||||
|
|
||||||
(sm/register! ::upload
|
(sm/register!
|
||||||
[:map {:title "Upload"}
|
^{::sm/type ::upload}
|
||||||
[:filename :string]
|
[:map {:title "Upload"}
|
||||||
[:size ::sm/int]
|
[:filename :string]
|
||||||
[:path ::fs/path]
|
[:size ::sm/int]
|
||||||
[:mtype {:optional true} :string]
|
[:path ::fs/path]
|
||||||
[:headers {:optional true}
|
[:mtype {:optional true} :string]
|
||||||
[:map-of :string :string]]])
|
[:headers {:optional true}
|
||||||
|
[:map-of :string :string]]])
|
||||||
|
|
||||||
(defn validate-media-type!
|
(defn validate-media-type!
|
||||||
([upload] (validate-media-type! upload cm/valid-image-types))
|
([upload] (validate-media-type! upload cm/valid-image-types))
|
||||||
|
|
|
@ -8,9 +8,8 @@
|
||||||
(:refer-clojure :exclude [run!])
|
(:refer-clojure :exclude [run!])
|
||||||
(:require
|
(:require
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.metrics.definition :as-alias mdef]
|
[app.metrics.definition :as-alias mdef]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig])
|
[integrant.core :as ig])
|
||||||
(:import
|
(:import
|
||||||
io.prometheus.client.CollectorRegistry
|
io.prometheus.client.CollectorRegistry
|
||||||
|
@ -34,41 +33,52 @@
|
||||||
(declare create-collector)
|
(declare create-collector)
|
||||||
(declare handler)
|
(declare handler)
|
||||||
|
|
||||||
|
(defprotocol IMetrics
|
||||||
|
(get-registry [_])
|
||||||
|
(get-collector [_ id])
|
||||||
|
(get-handler [_]))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; METRICS SERVICE PROVIDER
|
;; METRICS SERVICE PROVIDER
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::mdef/name string?)
|
(sm/register!
|
||||||
(s/def ::mdef/help string?)
|
{:type ::collector
|
||||||
(s/def ::mdef/labels (s/every string? :kind vector?))
|
:pred #(instance? SimpleCollector %)
|
||||||
(s/def ::mdef/type #{:gauge :counter :summary :histogram})
|
:type-properties
|
||||||
|
{:title "collector"
|
||||||
|
:description "An instance of SimpleCollector"}})
|
||||||
|
|
||||||
(s/def ::mdef/instance
|
(sm/register!
|
||||||
#(instance? SimpleCollector %))
|
{:type ::registry
|
||||||
|
:pred #(instance? CollectorRegistry %)
|
||||||
|
:type-properties
|
||||||
|
{:title "Metrics Registry"
|
||||||
|
:description "Instance of CollectorRegistry"}})
|
||||||
|
|
||||||
(s/def ::mdef/definition
|
(def ^:private schema:definitions
|
||||||
(s/keys :req [::mdef/name
|
[:map-of :keyword
|
||||||
::mdef/help
|
[:map {:title "definition"}
|
||||||
::mdef/type]
|
[::mdef/name :string]
|
||||||
:opt [::mdef/labels
|
[::mdef/help :string]
|
||||||
::mdef/instance]))
|
[::mdef/type [:enum :gauge :counter :summary :histogram]]
|
||||||
|
[::mdef/labels {:optional true} [::sm/vec :string]]
|
||||||
|
[::mdef/instance {:optional true} ::collector]]])
|
||||||
|
|
||||||
(s/def ::definitions
|
(defn metrics?
|
||||||
(s/map-of keyword? ::mdef/definition))
|
[o]
|
||||||
|
(satisfies? IMetrics o))
|
||||||
|
|
||||||
(s/def ::registry
|
(sm/register!
|
||||||
#(instance? CollectorRegistry %))
|
{:type ::metrics
|
||||||
|
:pred metrics?})
|
||||||
|
|
||||||
(s/def ::handler fn?)
|
(def ^:private valid-definitions?
|
||||||
(s/def ::metrics
|
(sm/validator schema:definitions))
|
||||||
(s/keys :req [::registry
|
|
||||||
::handler
|
|
||||||
::definitions]))
|
|
||||||
|
|
||||||
(s/def ::default ::definitions)
|
(defmethod ig/assert-key ::metrics
|
||||||
|
[_ {:keys [default]}]
|
||||||
(defmethod ig/pre-init-spec ::metrics [_]
|
(assert (valid-definitions? default) "expected valid definitions"))
|
||||||
(s/keys :req-un [::default]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::metrics
|
(defmethod ig/init-key ::metrics
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
@ -81,12 +91,14 @@
|
||||||
{}
|
{}
|
||||||
(:default cfg))]
|
(:default cfg))]
|
||||||
|
|
||||||
(us/verify! ::definitions definitions)
|
(reify
|
||||||
|
IMetrics
|
||||||
{::handler (partial handler registry)
|
(get-handler [_]
|
||||||
::definitions definitions
|
(partial handler registry))
|
||||||
::registry registry}))
|
(get-collector [_ id]
|
||||||
|
(get definitions id))
|
||||||
|
(get-registry [_]
|
||||||
|
registry))))
|
||||||
|
|
||||||
(defn- handler
|
(defn- handler
|
||||||
[registry _]
|
[registry _]
|
||||||
|
@ -96,17 +108,14 @@
|
||||||
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
|
{:headers {"content-type" TextFormat/CONTENT_TYPE_004}
|
||||||
:body (.toString writer)}))
|
:body (.toString writer)}))
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::routes
|
||||||
|
[_ {:keys [::metrics]}]
|
||||||
(s/def ::routes vector?)
|
(assert (metrics? metrics) "expected a valid instance for metrics"))
|
||||||
(defmethod ig/pre-init-spec ::routes [_]
|
|
||||||
(s/keys :req [::metrics]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::routes
|
(defmethod ig/init-key ::routes
|
||||||
[_ {:keys [::metrics]}]
|
[_ {:keys [::metrics]}]
|
||||||
(let [registry (::registry metrics)]
|
["/metrics" {:handler (get-handler metrics)
|
||||||
["/metrics" {:handler (partial handler registry)
|
:allowed-methods #{:get}}])
|
||||||
:allowed-methods #{:get}}]))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Implementation
|
;; Implementation
|
||||||
|
@ -126,8 +135,9 @@
|
||||||
(defmulti create-collector ::mdef/type)
|
(defmulti create-collector ::mdef/type)
|
||||||
|
|
||||||
(defn run!
|
(defn run!
|
||||||
[{:keys [::definitions]} & {:keys [id] :as params}]
|
[instance & {:keys [id] :as params}]
|
||||||
(when-let [mobj (get definitions id)]
|
(assert (metrics? instance) "expected valid metrics instance")
|
||||||
|
(when-let [mobj (get-collector instance id)]
|
||||||
(run-collector! mobj params)
|
(run-collector! mobj params)
|
||||||
true))
|
true))
|
||||||
|
|
||||||
|
|
|
@ -11,7 +11,6 @@
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.migrations.clj.migration-0023 :as mg0023]
|
[app.migrations.clj.migration-0023 :as mg0023]
|
||||||
[app.util.migrations :as mg]
|
[app.util.migrations :as mg]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(def migrations
|
(def migrations
|
||||||
|
@ -435,9 +434,9 @@
|
||||||
(mg/setup! conn)
|
(mg/setup! conn)
|
||||||
(mg/migrate! conn {:name name :steps migrations})))
|
(mg/migrate! conn {:name name :steps migrations})))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::migrations
|
(defmethod ig/assert-key ::migrations
|
||||||
[_]
|
[_ {:keys [::db/pool]}]
|
||||||
(s/keys :req [::db/pool]))
|
(assert (db/pool? pool) "expected valid pool"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::migrations
|
(defmethod ig/init-key ::migrations
|
||||||
[module {:keys [::db/pool]}]
|
[module {:keys [::db/pool]}]
|
||||||
|
|
|
@ -9,22 +9,27 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.transit :as t]
|
[app.common.transit :as t]
|
||||||
[app.config :as cfg]
|
[app.config :as cfg]
|
||||||
[app.redis :as rds]
|
[app.redis :as rds]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.core :as p]
|
[promesa.core :as p]
|
||||||
[promesa.exec :as px]
|
[promesa.exec :as px]
|
||||||
[promesa.exec.csp :as sp]))
|
[promesa.exec.csp :as sp]))
|
||||||
|
|
||||||
(set! *warn-on-reflection* true)
|
(set! *warn-on-reflection* true)
|
||||||
|
|
||||||
(def ^:private prefix (cfg/get :tenant))
|
(def ^:private prefix (cfg/get :tenant))
|
||||||
|
|
||||||
|
(defprotocol IMsgBus
|
||||||
|
(-sub [_ topics chan])
|
||||||
|
(-pub [_ topic message])
|
||||||
|
(-purge [_ chans]))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(defn- prefix-topic
|
(defn- prefix-topic
|
||||||
[topic]
|
[topic]
|
||||||
(str prefix "." topic))
|
(str prefix "." topic))
|
||||||
|
@ -32,30 +37,33 @@
|
||||||
(def ^:private xform-prefix-topic
|
(def ^:private xform-prefix-topic
|
||||||
(map (fn [obj] (update obj :topic prefix-topic))))
|
(map (fn [obj] (update obj :topic prefix-topic))))
|
||||||
|
|
||||||
(declare ^:private redis-pub!)
|
(declare ^:private redis-pub)
|
||||||
(declare ^:private redis-sub!)
|
(declare ^:private redis-sub)
|
||||||
(declare ^:private redis-unsub!)
|
(declare ^:private redis-unsub)
|
||||||
(declare ^:private start-io-loop!)
|
(declare ^:private start-io-loop)
|
||||||
(declare ^:private subscribe-to-topics)
|
(declare ^:private subscribe-to-topics)
|
||||||
(declare ^:private unsubscribe-channels)
|
(declare ^:private unsubscribe-channels)
|
||||||
|
|
||||||
(s/def ::cmd-ch sp/chan?)
|
(defn msgbus?
|
||||||
(s/def ::rcv-ch sp/chan?)
|
[o]
|
||||||
(s/def ::pub-ch sp/chan?)
|
(satisfies? IMsgBus o))
|
||||||
(s/def ::state ::us/agent)
|
|
||||||
(s/def ::pconn ::rds/connection-holder)
|
|
||||||
(s/def ::sconn ::rds/connection-holder)
|
|
||||||
(s/def ::msgbus
|
|
||||||
(s/keys :req [::cmd-ch ::rcv-ch ::pub-ch ::state ::pconn ::sconn ::wrk/executor]))
|
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::msgbus [_]
|
(sm/register!
|
||||||
(s/keys :req [::rds/redis ::wrk/executor]))
|
{:type ::msgbus
|
||||||
|
:pred msgbus?})
|
||||||
|
|
||||||
(defmethod ig/prep-key ::msgbus
|
(defmethod ig/expand-key ::msgbus
|
||||||
[_ cfg]
|
[k v]
|
||||||
(-> cfg
|
{k (-> (d/without-nils v)
|
||||||
(assoc ::buffer-size 128)
|
(assoc ::buffer-size 128)
|
||||||
(assoc ::timeout (dt/duration {:seconds 30}))))
|
(assoc ::timeout (dt/duration {:seconds 30})))})
|
||||||
|
|
||||||
|
(def ^:private schema:params
|
||||||
|
[:map ::rds/redis ::wrk/executor])
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::msgbus
|
||||||
|
[_ params]
|
||||||
|
(assert (sm/check schema:params params)))
|
||||||
|
|
||||||
(defmethod ig/init-key ::msgbus
|
(defmethod ig/init-key ::msgbus
|
||||||
[_ {:keys [::buffer-size ::wrk/executor ::timeout ::rds/redis] :as cfg}]
|
[_ {:keys [::buffer-size ::wrk/executor ::timeout ::rds/redis] :as cfg}]
|
||||||
|
@ -66,47 +74,66 @@
|
||||||
:xf xform-prefix-topic)
|
:xf xform-prefix-topic)
|
||||||
state (agent {})
|
state (agent {})
|
||||||
|
|
||||||
pconn (rds/connect redis :timeout timeout)
|
pconn (rds/connect redis :type :default :timeout timeout)
|
||||||
sconn (rds/connect redis :type :pubsub :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 ::pconn pconn)
|
||||||
(assoc ::sconn sconn)
|
(assoc ::sconn sconn)
|
||||||
(assoc ::cmd-ch cmd-ch)
|
(assoc ::cmd-ch cmd-ch)
|
||||||
(assoc ::rcv-ch rcv-ch)
|
(assoc ::rcv-ch rcv-ch)
|
||||||
(assoc ::pub-ch pub-ch)
|
(assoc ::pub-ch pub-ch)
|
||||||
(assoc ::state state)
|
(assoc ::state state))
|
||||||
(assoc ::wrk/executor executor))]
|
|
||||||
|
|
||||||
(set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/sync? true))
|
io-thr (start-io-loop cfg)]
|
||||||
(set-error-mode! state :continue)
|
|
||||||
|
|
||||||
(assoc msgbus ::io-thr (start-io-loop! msgbus))))
|
(reify
|
||||||
|
java.lang.AutoCloseable
|
||||||
|
(close [_]
|
||||||
|
(px/interrupt! io-thr)
|
||||||
|
(sp/close! cmd-ch)
|
||||||
|
(sp/close! rcv-ch)
|
||||||
|
(sp/close! pub-ch)
|
||||||
|
(d/close! pconn)
|
||||||
|
(d/close! sconn))
|
||||||
|
|
||||||
|
IMsgBus
|
||||||
|
(-sub [_ topics chan]
|
||||||
|
(l/debug :hint "subscribe" :topics topics :chan (hash chan))
|
||||||
|
(send-via executor state subscribe-to-topics cfg topics chan))
|
||||||
|
|
||||||
|
(-pub [_ topic message]
|
||||||
|
(let [message (assoc message :topic topic)]
|
||||||
|
(sp/put! pub-ch {:topic topic :message message})))
|
||||||
|
|
||||||
|
(-purge [_ chans]
|
||||||
|
(l/debug :hint "purge" :chans (count chans))
|
||||||
|
(send-via executor state unsubscribe-channels cfg chans)))))
|
||||||
|
|
||||||
(defmethod ig/halt-key! ::msgbus
|
(defmethod ig/halt-key! ::msgbus
|
||||||
[_ msgbus]
|
[_ instance]
|
||||||
(px/interrupt! (::io-thr msgbus))
|
(d/close! instance))
|
||||||
(sp/close! (::cmd-ch msgbus))
|
|
||||||
(sp/close! (::rcv-ch msgbus))
|
|
||||||
(sp/close! (::pub-ch msgbus))
|
|
||||||
(d/close! (::pconn msgbus))
|
|
||||||
(d/close! (::sconn msgbus)))
|
|
||||||
|
|
||||||
(defn sub!
|
(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))]
|
(let [topics (into [] (map prefix-topic) (if topic [topic] topics))]
|
||||||
(l/debug :hint "subscribe" :topics topics :chan (hash chan))
|
(-sub instance topics chan)
|
||||||
(send-via executor state subscribe-to-topics cfg topics chan)
|
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(defn pub!
|
(defn pub!
|
||||||
[{::keys [pub-ch]} & {:keys [topic] :as params}]
|
[instance & {:keys [topic message]}]
|
||||||
(let [params (update params :message assoc :topic topic)]
|
(assert (satisfies? IMsgBus instance) "expected valid msgbus instance")
|
||||||
(sp/put! pub-ch params)))
|
(-pub instance topic message))
|
||||||
|
|
||||||
(defn purge!
|
(defn purge!
|
||||||
[{:keys [::state ::wrk/executor] :as msgbus} chans]
|
[instance chans]
|
||||||
(l/debug :hint "purge" :chans (count chans))
|
(assert (satisfies? IMsgBus instance) "expected valid msgbus instance")
|
||||||
(send-via executor state unsubscribe-channels msgbus chans)
|
(assert (every? sp/chan? chans) "expected a seq of chans")
|
||||||
|
(-purge instance chans)
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
;; --- IMPL
|
;; --- IMPL
|
||||||
|
@ -119,7 +146,7 @@
|
||||||
(let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
|
(let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
|
||||||
(when (= 1 (count nsubs))
|
(when (= 1 (count nsubs))
|
||||||
(l/trace :hint "open subscription" :topic topic ::l/sync? true)
|
(l/trace :hint "open subscription" :topic topic ::l/sync? true)
|
||||||
(redis-sub! cfg topic))
|
(redis-sub cfg topic))
|
||||||
nsubs))
|
nsubs))
|
||||||
|
|
||||||
(defn- disj-subscription
|
(defn- disj-subscription
|
||||||
|
@ -130,7 +157,7 @@
|
||||||
(let [nsubs (disj nsubs chan)]
|
(let [nsubs (disj nsubs chan)]
|
||||||
(when (empty? nsubs)
|
(when (empty? nsubs)
|
||||||
(l/trace :hint "close subscription" :topic topic ::l/sync? true)
|
(l/trace :hint "close subscription" :topic topic ::l/sync? true)
|
||||||
(redis-unsub! cfg topic))
|
(redis-unsub cfg topic))
|
||||||
nsubs))
|
nsubs))
|
||||||
|
|
||||||
(defn- subscribe-to-topics
|
(defn- subscribe-to-topics
|
||||||
|
@ -171,7 +198,7 @@
|
||||||
(when-not (sp/offer! rcv-ch val)
|
(when-not (sp/offer! rcv-ch val)
|
||||||
(l/warn :msg "dropping message on subscription loop"))))))
|
(l/warn :msg "dropping message on subscription loop"))))))
|
||||||
|
|
||||||
(defn- process-input!
|
(defn- process-input
|
||||||
[{:keys [::state ::wrk/executor] :as cfg} topic message]
|
[{:keys [::state ::wrk/executor] :as cfg} topic message]
|
||||||
(let [chans (get-in @state [:topics topic])]
|
(let [chans (get-in @state [:topics topic])]
|
||||||
(when-let [closed (loop [chans (seq chans)
|
(when-let [closed (loop [chans (seq chans)
|
||||||
|
@ -184,9 +211,9 @@
|
||||||
(send-via executor state unsubscribe-channels cfg closed))))
|
(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}]
|
[{: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
|
(px/thread
|
||||||
{:name "penpot/msgbus/io-loop"
|
{:name "penpot/msgbus/io-loop"
|
||||||
|
@ -210,12 +237,12 @@
|
||||||
|
|
||||||
(identical? port rcv-ch)
|
(identical? port rcv-ch)
|
||||||
(let [{:keys [topic message]} val]
|
(let [{:keys [topic message]} val]
|
||||||
(process-input! cfg topic message)
|
(process-input cfg topic message)
|
||||||
(recur))
|
(recur))
|
||||||
|
|
||||||
(identical? port pub-ch)
|
(identical? port pub-ch)
|
||||||
(do
|
(do
|
||||||
(redis-pub! cfg val)
|
(redis-pub cfg val)
|
||||||
(recur)))))
|
(recur)))))
|
||||||
|
|
||||||
(catch InterruptedException _
|
(catch InterruptedException _
|
||||||
|
@ -231,12 +258,12 @@
|
||||||
|
|
||||||
(l/debug :hint "io-loop thread terminated")))))
|
(l/debug :hint "io-loop thread terminated")))))
|
||||||
|
|
||||||
(defn- redis-pub!
|
(defn- redis-pub
|
||||||
"Publish a message to the redis server. Asynchronous operation,
|
"Publish a message to the redis server. Asynchronous operation,
|
||||||
intended to be used in core.async go blocks."
|
intended to be used in core.async go blocks."
|
||||||
[{:keys [::pconn] :as cfg} {:keys [topic message]}]
|
[{:keys [::pconn] :as cfg} {:keys [topic message]}]
|
||||||
(try
|
(try
|
||||||
(p/await! (rds/publish! pconn topic (t/encode message)))
|
(p/await! (rds/publish pconn topic (t/encode message)))
|
||||||
(catch InterruptedException cause
|
(catch InterruptedException cause
|
||||||
(throw cause))
|
(throw cause))
|
||||||
(catch Throwable cause
|
(catch Throwable cause
|
||||||
|
@ -244,23 +271,23 @@
|
||||||
:message message
|
:message message
|
||||||
:cause cause))))
|
:cause cause))))
|
||||||
|
|
||||||
(defn- redis-sub!
|
(defn- redis-sub
|
||||||
"Create redis subscription. Blocking operation, intended to be used
|
"Create redis subscription. Blocking operation, intended to be used
|
||||||
inside an agent."
|
inside an agent."
|
||||||
[{:keys [::sconn] :as cfg} topic]
|
[{:keys [::sconn] :as cfg} topic]
|
||||||
(try
|
(try
|
||||||
(rds/subscribe! sconn topic)
|
(rds/subscribe sconn [topic])
|
||||||
(catch InterruptedException cause
|
(catch InterruptedException cause
|
||||||
(throw cause))
|
(throw cause))
|
||||||
(catch Throwable cause
|
(catch Throwable cause
|
||||||
(l/trace :hint "exception on subscribing" :topic topic :cause 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
|
"Removes redis subscription. Blocking operation, intended to be used
|
||||||
inside an agent."
|
inside an agent."
|
||||||
[{:keys [::sconn] :as cfg} topic]
|
[{:keys [::sconn] :as cfg} topic]
|
||||||
(try
|
(try
|
||||||
(rds/unsubscribe! sconn topic)
|
(rds/unsubscribe sconn [topic])
|
||||||
(catch InterruptedException cause
|
(catch InterruptedException cause
|
||||||
(throw cause))
|
(throw cause))
|
||||||
(catch Throwable cause
|
(catch Throwable cause
|
||||||
|
|
|
@ -6,11 +6,12 @@
|
||||||
|
|
||||||
(ns app.redis
|
(ns app.redis
|
||||||
"The msgbus abstraction implemented using redis as underlying backend."
|
"The msgbus abstraction implemented using redis as underlying backend."
|
||||||
|
(:refer-clojure :exclude [eval])
|
||||||
(:require
|
(:require
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.metrics :as mtx]
|
[app.metrics :as mtx]
|
||||||
[app.redis.script :as-alias rscript]
|
[app.redis.script :as-alias rscript]
|
||||||
[app.util.cache :as cache]
|
[app.util.cache :as cache]
|
||||||
|
@ -18,13 +19,11 @@
|
||||||
[app.worker :as-alias wrk]
|
[app.worker :as-alias wrk]
|
||||||
[clojure.core :as c]
|
[clojure.core :as c]
|
||||||
[clojure.java.io :as io]
|
[clojure.java.io :as io]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.core :as p]
|
[promesa.core :as p]
|
||||||
[promesa.exec :as px])
|
[promesa.exec :as px])
|
||||||
(:import
|
(:import
|
||||||
clojure.lang.IDeref
|
|
||||||
clojure.lang.MapEntry
|
clojure.lang.MapEntry
|
||||||
io.lettuce.core.KeyValue
|
io.lettuce.core.KeyValue
|
||||||
io.lettuce.core.RedisClient
|
io.lettuce.core.RedisClient
|
||||||
|
@ -53,79 +52,24 @@
|
||||||
|
|
||||||
(set! *warn-on-reflection* true)
|
(set! *warn-on-reflection* true)
|
||||||
|
|
||||||
(declare initialize-resources)
|
(declare ^:private initialize-resources)
|
||||||
(declare shutdown-resources)
|
(declare ^:private shutdown-resources)
|
||||||
(declare connect*)
|
(declare ^:private impl-eval)
|
||||||
|
|
||||||
(s/def ::timer
|
(defprotocol IRedis
|
||||||
#(instance? Timer %))
|
(-connect [_ options])
|
||||||
|
(-get-or-connect [_ key options]))
|
||||||
|
|
||||||
(s/def ::default-connection
|
(defprotocol IConnection
|
||||||
#(or (instance? StatefulRedisConnection %)
|
(publish [_ topic message])
|
||||||
(and (instance? IDeref %)
|
(rpush [_ key payload])
|
||||||
(instance? StatefulRedisConnection (deref %)))))
|
(blpop [_ timeout keys])
|
||||||
|
(eval [_ script]))
|
||||||
|
|
||||||
(s/def ::pubsub-connection
|
(defprotocol IPubSubConnection
|
||||||
#(or (instance? StatefulRedisPubSubConnection %)
|
(add-listener [_ listener])
|
||||||
(and (instance? IDeref %)
|
(subscribe [_ topics])
|
||||||
(instance? StatefulRedisPubSubConnection (deref %)))))
|
(unsubscribe [_ topics]))
|
||||||
|
|
||||||
(s/def ::connection
|
|
||||||
(s/or :default ::default-connection
|
|
||||||
:pubsub ::pubsub-connection))
|
|
||||||
|
|
||||||
(s/def ::connection-holder
|
|
||||||
(s/keys :req [::connection]))
|
|
||||||
|
|
||||||
(s/def ::redis-uri
|
|
||||||
#(instance? RedisURI %))
|
|
||||||
|
|
||||||
(s/def ::resources
|
|
||||||
#(instance? ClientResources %))
|
|
||||||
|
|
||||||
(s/def ::pubsub-listener
|
|
||||||
#(instance? RedisPubSubListener %))
|
|
||||||
|
|
||||||
(s/def ::uri ::us/not-empty-string)
|
|
||||||
(s/def ::timeout ::dt/duration)
|
|
||||||
(s/def ::connect? ::us/boolean)
|
|
||||||
(s/def ::io-threads ::us/integer)
|
|
||||||
(s/def ::worker-threads ::us/integer)
|
|
||||||
(s/def ::cache cache/cache?)
|
|
||||||
|
|
||||||
(s/def ::redis
|
|
||||||
(s/keys :req [::resources
|
|
||||||
::redis-uri
|
|
||||||
::timer
|
|
||||||
::mtx/metrics]
|
|
||||||
:opt [::connection
|
|
||||||
::cache]))
|
|
||||||
|
|
||||||
(defmethod ig/prep-key ::redis
|
|
||||||
[_ cfg]
|
|
||||||
(let [cpus (px/get-available-processors)
|
|
||||||
threads (max 1 (int (* cpus 0.2)))]
|
|
||||||
(merge {::timeout (dt/duration "10s")
|
|
||||||
::io-threads (max 3 threads)
|
|
||||||
::worker-threads (max 3 threads)}
|
|
||||||
(d/without-nils cfg))))
|
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::redis [_]
|
|
||||||
(s/keys :req [::uri ::mtx/metrics]
|
|
||||||
:opt [::timeout
|
|
||||||
::connect?
|
|
||||||
::io-threads
|
|
||||||
::worker-threads]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::redis
|
|
||||||
[_ {:keys [::connect?] :as cfg}]
|
|
||||||
(let [state (initialize-resources cfg)]
|
|
||||||
(cond-> state
|
|
||||||
connect? (assoc ::connection (connect* cfg {})))))
|
|
||||||
|
|
||||||
(defmethod ig/halt-key! ::redis
|
|
||||||
[_ state]
|
|
||||||
(shutdown-resources state))
|
|
||||||
|
|
||||||
(def default-codec
|
(def default-codec
|
||||||
(RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE))
|
(RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE))
|
||||||
|
@ -133,23 +77,76 @@
|
||||||
(def string-codec
|
(def string-codec
|
||||||
(RedisCodec/of StringCodec/UTF8 StringCodec/UTF8))
|
(RedisCodec/of StringCodec/UTF8 StringCodec/UTF8))
|
||||||
|
|
||||||
(defn- create-cache
|
(sm/register!
|
||||||
[{:keys [::wrk/executor] :as cfg}]
|
{:type ::connection
|
||||||
(letfn [(on-remove [key val cause]
|
:pred #(satisfies? IConnection %)
|
||||||
(l/trace :hint "evict connection (cache)" :key key :reason cause)
|
:type-properties
|
||||||
(some-> val d/close!))]
|
{:title "connection"
|
||||||
(cache/create :executor executor
|
:description "redis connection instance"}})
|
||||||
:on-remove on-remove
|
|
||||||
:keepalive "5m")))
|
(sm/register!
|
||||||
|
{:type ::pubsub-connection
|
||||||
|
:pred #(satisfies? IPubSubConnection %)
|
||||||
|
:type-properties
|
||||||
|
{:title "connection"
|
||||||
|
:description "redis connection instance"}})
|
||||||
|
|
||||||
|
(defn redis?
|
||||||
|
[o]
|
||||||
|
(satisfies? IRedis o))
|
||||||
|
|
||||||
|
(sm/register!
|
||||||
|
{:type ::redis
|
||||||
|
:pred redis?})
|
||||||
|
|
||||||
|
(def ^:private schema:script
|
||||||
|
[:map {:title "script"}
|
||||||
|
[::rscript/name qualified-keyword?]
|
||||||
|
[::rscript/path ::sm/text]
|
||||||
|
[::rscript/keys {:optional true} [:vector :any]]
|
||||||
|
[::rscript/vals {:optional true} [:vector :any]]])
|
||||||
|
|
||||||
|
(def valid-script?
|
||||||
|
(sm/lazy-validator schema:script))
|
||||||
|
|
||||||
|
(defmethod ig/expand-key ::redis
|
||||||
|
[k v]
|
||||||
|
(let [cpus (px/get-available-processors)
|
||||||
|
threads (max 1 (int (* cpus 0.2)))]
|
||||||
|
{k (-> (d/without-nils v)
|
||||||
|
(assoc ::timeout (dt/duration "10s"))
|
||||||
|
(assoc ::io-threads (max 3 threads))
|
||||||
|
(assoc ::worker-threads (max 3 threads)))}))
|
||||||
|
|
||||||
|
(def ^:private schema:redis-params
|
||||||
|
[:map {:title "redis-params"}
|
||||||
|
::wrk/executor
|
||||||
|
::mtx/metrics
|
||||||
|
[::uri ::sm/uri]
|
||||||
|
[::worker-threads ::sm/int]
|
||||||
|
[::io-threads ::sm/int]
|
||||||
|
[::timeout ::dt/duration]])
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::redis
|
||||||
|
[_ params]
|
||||||
|
(assert (sm/check schema:redis-params params)))
|
||||||
|
|
||||||
|
(defmethod ig/init-key ::redis
|
||||||
|
[_ params]
|
||||||
|
(initialize-resources params))
|
||||||
|
|
||||||
|
(defmethod ig/halt-key! ::redis
|
||||||
|
[_ instance]
|
||||||
|
(d/close! instance))
|
||||||
|
|
||||||
(defn- initialize-resources
|
(defn- initialize-resources
|
||||||
"Initialize redis connection resources"
|
"Initialize redis connection resources"
|
||||||
[{:keys [::uri ::io-threads ::worker-threads ::connect?] :as cfg}]
|
[{:keys [::uri ::io-threads ::worker-threads ::wrk/executor ::mtx/metrics] :as params}]
|
||||||
(l/info :hint "initialize redis resources"
|
|
||||||
:uri uri
|
(l/inf :hint "initialize redis resources"
|
||||||
:io-threads io-threads
|
:uri (str uri)
|
||||||
:worker-threads worker-threads
|
:io-threads io-threads
|
||||||
:connect? connect?)
|
:worker-threads worker-threads)
|
||||||
|
|
||||||
(let [timer (HashedWheelTimer.)
|
(let [timer (HashedWheelTimer.)
|
||||||
resources (.. (DefaultClientResources/builder)
|
resources (.. (DefaultClientResources/builder)
|
||||||
|
@ -158,147 +155,134 @@
|
||||||
(timer ^Timer timer)
|
(timer ^Timer timer)
|
||||||
(build))
|
(build))
|
||||||
|
|
||||||
redis-uri (RedisURI/create ^String uri)
|
redis-uri (RedisURI/create ^String (str uri))
|
||||||
cfg (-> cfg
|
|
||||||
(assoc ::resources resources)
|
|
||||||
(assoc ::timer timer)
|
|
||||||
(assoc ::redis-uri redis-uri))]
|
|
||||||
|
|
||||||
(assoc cfg ::cache (create-cache cfg))))
|
shutdown (fn [client conn]
|
||||||
|
(ex/ignoring (.close ^StatefulConnection conn))
|
||||||
|
(ex/ignoring (.close ^RedisClient client))
|
||||||
|
(l/trc :hint "disconnect" :hid (hash client)))
|
||||||
|
|
||||||
(defn- shutdown-resources
|
on-remove (fn [key val cause]
|
||||||
[{:keys [::resources ::cache ::timer]}]
|
(l/trace :hint "evict connection (cache)" :key key :reason cause)
|
||||||
(cache/invalidate! cache)
|
(some-> val d/close!))
|
||||||
|
|
||||||
(when resources
|
cache (cache/create :executor executor
|
||||||
(.shutdown ^ClientResources resources))
|
:on-remove on-remove
|
||||||
|
:keepalive "5m")]
|
||||||
(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)
|
|
||||||
(reify
|
(reify
|
||||||
IDeref
|
java.lang.AutoCloseable
|
||||||
(deref [_] conn)
|
|
||||||
|
|
||||||
AutoCloseable
|
|
||||||
(close [_]
|
(close [_]
|
||||||
(ex/ignoring (.close ^StatefulConnection conn))
|
(ex/ignoring (cache/invalidate! cache))
|
||||||
(ex/ignoring (.shutdown ^RedisClient client))
|
(ex/ignoring (.shutdown ^ClientResources resources))
|
||||||
(l/trc :hint "disconnect" :hid (hash client))))))
|
(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
|
(defn connect
|
||||||
[state & {:as opts}]
|
[instance & {:as opts}]
|
||||||
(let [connection (connect* state opts)]
|
(assert (satisfies? IRedis instance) "expected valid redis instance")
|
||||||
(-> state
|
(-connect instance opts))
|
||||||
(assoc ::connection connection)
|
|
||||||
(dissoc ::cache)
|
|
||||||
(vary-meta assoc `d/close! (fn [_] (d/close! connection))))))
|
|
||||||
|
|
||||||
(defn get-or-connect
|
(defn get-or-connect
|
||||||
[{:keys [::cache] :as state} key options]
|
[instance key & {:as opts}]
|
||||||
(us/assert! ::redis state)
|
(assert (satisfies? IRedis instance) "expected valid redis instance")
|
||||||
(let [create (fn [_] (connect* state options))
|
(-get-or-connect instance key opts))
|
||||||
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))
|
|
||||||
|
|
||||||
(defn pubsub-listener
|
(defn pubsub-listener
|
||||||
[& {:keys [on-message on-subscribe on-unsubscribe]}]
|
[& {:keys [on-message on-subscribe on-unsubscribe]}]
|
||||||
|
@ -328,26 +312,10 @@
|
||||||
(on-unsubscribe nil topic count)))))
|
(on-unsubscribe nil topic count)))))
|
||||||
|
|
||||||
(def ^:private scripts-cache (atom {}))
|
(def ^:private scripts-cache (atom {}))
|
||||||
(def noop-fn (constantly nil))
|
|
||||||
|
|
||||||
(s/def ::rscript/name qualified-keyword?)
|
(defn- impl-eval
|
||||||
(s/def ::rscript/path ::us/not-empty-string)
|
[^StatefulRedisConnection connection metrics script]
|
||||||
(s/def ::rscript/keys (s/every any? :kind vector?))
|
(let [cmd (.async ^StatefulRedisConnection connection)
|
||||||
(s/def ::rscript/vals (s/every any? :kind vector?))
|
|
||||||
|
|
||||||
(s/def ::rscript/script
|
|
||||||
(s/keys :req [::rscript/name
|
|
||||||
::rscript/path]
|
|
||||||
:opt [::rscript/keys
|
|
||||||
::rscript/vals]))
|
|
||||||
|
|
||||||
(defn eval!
|
|
||||||
[{:keys [::mtx/metrics ::connection] :as state} script]
|
|
||||||
(us/assert! ::redis state)
|
|
||||||
(us/assert! ::default-connection connection)
|
|
||||||
(us/assert! ::rscript/script script)
|
|
||||||
|
|
||||||
(let [cmd (.async ^StatefulRedisConnection @connection)
|
|
||||||
keys (into-array String (map str (::rscript/keys script)))
|
keys (into-array String (map str (::rscript/keys script)))
|
||||||
vals (into-array String (map str (::rscript/vals script)))
|
vals (into-array String (map str (::rscript/vals script)))
|
||||||
sname (::rscript/name script)]
|
sname (::rscript/name script)]
|
||||||
|
|
|
@ -257,33 +257,42 @@
|
||||||
(map (partial process-method cfg))
|
(map (partial process-method cfg))
|
||||||
(into {}))))
|
(into {}))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::methods [_]
|
(def ^:private schema:methods-params
|
||||||
(s/keys :req [::session/manager
|
[:map {:title "methods-params"}
|
||||||
::http.client/client
|
::session/manager
|
||||||
::db/pool
|
::http.client/client
|
||||||
::mbus/msgbus
|
::db/pool
|
||||||
::ldap/provider
|
::mbus/msgbus
|
||||||
::sto/storage
|
::ldap/provider
|
||||||
::mtx/metrics
|
::sto/storage
|
||||||
::setup/props]
|
::mtx/metrics
|
||||||
:opt [::climit
|
[::climit [:maybe ::climit]]
|
||||||
::rlimit]))
|
[::rlimit [:maybe ::rlimit]]
|
||||||
|
::setup/props])
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::methods
|
||||||
|
[_ params]
|
||||||
|
(assert (sm/check schema:methods-params params)))
|
||||||
|
|
||||||
(defmethod ig/init-key ::methods
|
(defmethod ig/init-key ::methods
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
(let [cfg (d/without-nils cfg)]
|
(let [cfg (d/without-nils cfg)]
|
||||||
(resolve-command-methods cfg)))
|
(resolve-command-methods cfg)))
|
||||||
|
|
||||||
(s/def ::methods
|
(def ^:private schema:methods
|
||||||
(s/map-of keyword? (s/tuple map? fn?)))
|
[:map-of :keyword [:tuple :map ::sm/fn]])
|
||||||
|
|
||||||
(s/def ::routes vector?)
|
(sm/register! ::methods schema:methods)
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::routes [_]
|
(def ^:private valid-methods?
|
||||||
(s/keys :req [::methods
|
(sm/validator schema:methods))
|
||||||
::db/pool
|
|
||||||
::setup/props
|
(defmethod ig/assert-key ::routes
|
||||||
::session/manager]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expect valid database pool")
|
||||||
|
(assert (some? (::setup/props params)))
|
||||||
|
(assert (session/manager? (::session/manager params)) "expect valid session manager")
|
||||||
|
(assert (valid-methods? (::methods params)) "expect valid methods map"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::routes
|
(defmethod ig/init-key ::routes
|
||||||
[_ {:keys [::methods] :as cfg}]
|
[_ {:keys [::methods] :as cfg}]
|
||||||
|
|
|
@ -10,18 +10,15 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.config :as cf]
|
|
||||||
[app.metrics :as mtx]
|
[app.metrics :as mtx]
|
||||||
[app.rpc :as-alias rpc]
|
[app.rpc :as-alias rpc]
|
||||||
[app.rpc.climit.config :as-alias config]
|
|
||||||
[app.util.cache :as cache]
|
[app.util.cache :as cache]
|
||||||
[app.util.services :as-alias sv]
|
[app.util.services :as-alias sv]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as-alias wrk]
|
[app.worker :as-alias wrk]
|
||||||
[clojure.edn :as edn]
|
[clojure.edn :as edn]
|
||||||
[clojure.set :as set]
|
[clojure.set :as set]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[datoteka.fs :as fs]
|
[datoteka.fs :as fs]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px]
|
[promesa.exec :as px]
|
||||||
|
@ -32,6 +29,62 @@
|
||||||
|
|
||||||
(set! *warn-on-reflection* true)
|
(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
|
(defn- id->str
|
||||||
([id]
|
([id]
|
||||||
(-> (str id)
|
(-> (str id)
|
||||||
|
@ -41,59 +94,23 @@
|
||||||
(str (-> (str id) (subs 1)) "/" key)
|
(str (-> (str id) (subs 1)) "/" key)
|
||||||
(id->str id))))
|
(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
|
(defn- create-limiter
|
||||||
[config [id skey]]
|
[config id]
|
||||||
(l/trc :hint "created" :id (id->str id skey))
|
(l/trc :hint "created" :id id)
|
||||||
(pbh/create :permits (or (:permits config) (:concurrency config))
|
(pbh/create :permits (or (:permits config) (:concurrency config))
|
||||||
:queue (or (:queue config) (:queue-size config))
|
:queue (or (:queue config) (:queue-size config))
|
||||||
:timeout (:timeout config)
|
:timeout (:timeout config)
|
||||||
:type :semaphore))
|
: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]
|
[metrics mlabels stats elapsed]
|
||||||
(let [mpermits (:max-permits stats)
|
(let [mpermits (:max-permits stats)
|
||||||
permits (:permits stats)
|
permits (:permits stats)
|
||||||
|
@ -117,8 +134,14 @@
|
||||||
:val (inst-ms elapsed)
|
:val (inst-ms elapsed)
|
||||||
:labels mlabels))))
|
:labels mlabels))))
|
||||||
|
|
||||||
(defn log!
|
(defn- prepare-params-for-debug
|
||||||
[action req-id stats limit-id limit-label params elapsed]
|
[params]
|
||||||
|
(-> (select-keys params [::rpc/profile-id :file-id :profile-id])
|
||||||
|
(set/rename-keys {::rpc/profile-id :profile-id})
|
||||||
|
(update-vals str)))
|
||||||
|
|
||||||
|
(defn- log
|
||||||
|
[action req-id stats limit-id limit-label limit-params elapsed]
|
||||||
(let [mpermits (:max-permits stats)
|
(let [mpermits (:max-permits stats)
|
||||||
queue (:queue stats)
|
queue (:queue stats)
|
||||||
queue (- queue mpermits)
|
queue (- queue mpermits)
|
||||||
|
@ -132,37 +155,42 @@
|
||||||
:label limit-label
|
:label limit-label
|
||||||
:queue queue
|
:queue queue
|
||||||
:elapsed (some-> elapsed dt/format-duration)
|
:elapsed (some-> elapsed dt/format-duration)
|
||||||
:params (-> (select-keys params [::rpc/profile-id :file-id :profile-id])
|
:params @limit-params)))
|
||||||
(set/rename-keys {::rpc/profile-id :profile-id})
|
|
||||||
(update-vals str)))))
|
|
||||||
|
|
||||||
(def ^:private idseq (AtomicLong. 0))
|
(def ^:private idseq (AtomicLong. 0))
|
||||||
|
|
||||||
(defn- invoke
|
(defn- impl-invoke
|
||||||
[limiter metrics limit-id limit-key limit-label handler params]
|
[metrics cache config handler]
|
||||||
(let [tpoint (dt/tpoint)
|
(let [limit-id (::id config)
|
||||||
mlabels (into-array String [(id->str limit-id)])
|
limit-key (::key config)
|
||||||
limit-id (id->str limit-id limit-key)
|
limit-label (::label config)
|
||||||
stats (pbh/get-stats limiter)
|
limit-params (delay
|
||||||
req-id (.incrementAndGet ^AtomicLong idseq)]
|
(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
|
(try
|
||||||
(measure! metrics mlabels stats nil)
|
(let [stats (pbh/get-stats limiter)]
|
||||||
(log! "enqueued" req-id stats limit-id limit-label params nil)
|
(measure metrics mlabels stats nil)
|
||||||
|
(log "enqueued" req-id stats limit-id limit-label limit-params nil))
|
||||||
|
|
||||||
(px/invoke! limiter (fn []
|
(px/invoke! limiter (fn []
|
||||||
(let [elapsed (tpoint)
|
(let [elapsed (tpoint)
|
||||||
stats (pbh/get-stats limiter)]
|
stats (pbh/get-stats limiter)]
|
||||||
|
(measure metrics mlabels stats elapsed)
|
||||||
(measure! metrics mlabels stats elapsed)
|
(log "acquired" req-id stats limit-id limit-label limit-params elapsed)
|
||||||
(log! "acquired" req-id stats limit-id limit-label params elapsed)
|
(handler))))
|
||||||
|
|
||||||
(handler params))))
|
|
||||||
|
|
||||||
(catch ExceptionInfo cause
|
(catch ExceptionInfo cause
|
||||||
(let [{:keys [type code]} (ex-data cause)]
|
(let [{:keys [type code]} (ex-data cause)]
|
||||||
(if (= :bulkhead-error type)
|
(if (= :bulkhead-error type)
|
||||||
(let [elapsed (tpoint)]
|
(let [elapsed (tpoint)
|
||||||
(log! "rejected" req-id stats limit-id limit-label params elapsed)
|
stats (pbh/get-stats limiter)]
|
||||||
|
(log "rejected" req-id stats limit-id limit-label limit-params elapsed)
|
||||||
(ex/raise :type :concurrency-limit
|
(ex/raise :type :concurrency-limit
|
||||||
:code code
|
:code code
|
||||||
:hint "concurrency limit reached"
|
:hint "concurrency limit reached"
|
||||||
|
@ -173,8 +201,8 @@
|
||||||
(let [elapsed (tpoint)
|
(let [elapsed (tpoint)
|
||||||
stats (pbh/get-stats limiter)]
|
stats (pbh/get-stats limiter)]
|
||||||
|
|
||||||
(measure! metrics mlabels stats nil)
|
(measure metrics mlabels stats nil)
|
||||||
(log! "finished" req-id stats limit-id limit-label params elapsed))))))
|
(log "finished" req-id stats limit-id limit-label limit-params elapsed))))))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; MIDDLEWARE
|
;; MIDDLEWARE
|
||||||
|
@ -204,71 +232,70 @@
|
||||||
(throw (IllegalArgumentException. "unable to normalize limit")))))
|
(throw (IllegalArgumentException. "unable to normalize limit")))))
|
||||||
|
|
||||||
(defn wrap
|
(defn wrap
|
||||||
[{:keys [::rpc/climit ::mtx/metrics]} handler mdata]
|
[cfg handler {label ::sv/name :as mdata}]
|
||||||
(let [cache (::cache climit)
|
(if-let [climit (::rpc/climit cfg)]
|
||||||
config (::config climit)
|
(reduce (fn [handler [limit-id key-fn]]
|
||||||
label (::sv/name mdata)]
|
(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
|
(if (and (= key-fn ::rpc/profile-id)
|
||||||
(reduce (fn [handler [limit-id key-fn]]
|
(false? (::rpc/auth mdata true)))
|
||||||
(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)
|
;; We don't enforce by-profile limit on methods that does
|
||||||
(false? (::rpc/auth mdata true)))
|
;; not require authentication
|
||||||
|
handler
|
||||||
|
|
||||||
;; We don't enforce by-profile limit on methods that does
|
(fn [cfg params]
|
||||||
;; not require authentication
|
(let [config (-> config
|
||||||
handler
|
(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]
|
(do
|
||||||
(let [limit-key (key-fn params)
|
(l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
|
||||||
cache-key [limit-id limit-key]
|
handler)))
|
||||||
limiter (cache/get cache cache-key (partial create-limiter config))
|
handler
|
||||||
handler (partial handler cfg)]
|
(concat global-limits (get-limits mdata)))
|
||||||
(invoke limiter metrics limit-id limit-key label handler params)))))
|
|
||||||
|
|
||||||
(do
|
handler))
|
||||||
(l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
|
|
||||||
handler)))
|
|
||||||
|
|
||||||
handler
|
|
||||||
(concat global-limits (get-limits mdata)))
|
|
||||||
handler)))
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; PUBLIC API
|
;; PUBLIC API
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defn- build-exec-chain
|
(defn- build-exec-chain
|
||||||
[{:keys [::label ::rpc/climit ::mtx/metrics] :as cfg} f]
|
[{:keys [::label ::rpc/climit] :as cfg} f]
|
||||||
(let [config (get climit ::config)
|
(reduce (fn [handler [limit-id limit-key]]
|
||||||
cache (get climit ::cache)]
|
(if-let [config (get-config climit limit-id)]
|
||||||
(reduce (fn [handler [limit-id limit-key :as ckey]]
|
(let [config (-> config
|
||||||
(if-let [config (get config limit-id)]
|
(assoc ::key limit-key)
|
||||||
|
(assoc ::label label))]
|
||||||
(fn [cfg params]
|
(fn [cfg params]
|
||||||
(let [limiter (cache/get cache ckey (partial create-limiter config))
|
(let [config (assoc config ::params params)]
|
||||||
handler (partial handler cfg)]
|
(invoke climit config (partial handler cfg params)))))
|
||||||
(invoke limiter metrics limit-id limit-key label handler params)))
|
(do
|
||||||
(do
|
(l/wrn :hint "config not found" :label label :id limit-id)
|
||||||
(l/wrn :hint "config not found" :label label :id limit-id)
|
f)))
|
||||||
f)))
|
f
|
||||||
f
|
(get-limits cfg)))
|
||||||
(get-limits cfg))))
|
|
||||||
|
|
||||||
(defn invoke!
|
(defn invoke!
|
||||||
"Run a function in context of climit.
|
"Run a function in context of climit.
|
||||||
Intended to be used in virtual threads."
|
Intended to be used in virtual threads."
|
||||||
[{:keys [::executor] :as cfg} f params]
|
[{:keys [::executor ::rpc/climit] :as cfg} f params]
|
||||||
(let [f (if (some? executor)
|
(let [f (if climit
|
||||||
(fn [cfg params] (px/await! (px/submit! executor (fn [] (f cfg params)))))
|
(let [f (if (some? executor)
|
||||||
f)
|
(fn [cfg params] (px/await! (px/submit! executor (fn [] (f cfg params)))))
|
||||||
f (build-exec-chain cfg f)]
|
f)]
|
||||||
|
(build-exec-chain cfg f))
|
||||||
|
f)]
|
||||||
(f cfg params)))
|
(f cfg params)))
|
||||||
|
|
|
@ -202,10 +202,9 @@
|
||||||
;; MODULE INIT
|
;; MODULE INIT
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::routes vector?)
|
(defmethod ig/assert-key ::routes
|
||||||
|
[_ params]
|
||||||
(defmethod ig/pre-init-spec ::routes [_]
|
(assert (sm/valid? ::rpc/methods (::rpc/methods params)) "expected valid methods"))
|
||||||
(s/keys :req-un [::rpc/methods]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::routes
|
(defmethod ig/init-key ::routes
|
||||||
[_ {:keys [methods] :as cfg}]
|
[_ {:keys [methods] :as cfg}]
|
||||||
|
|
|
@ -8,25 +8,24 @@
|
||||||
"A permission checking helper factories."
|
"A permission checking helper factories."
|
||||||
(:require
|
(:require
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.schema :as sm]
|
[app.common.schema :as sm]))
|
||||||
[app.common.spec :as us]
|
|
||||||
[clojure.spec.alpha :as s]))
|
|
||||||
|
|
||||||
(sm/register! ::permissions
|
(sm/register!
|
||||||
[:map {:title "Permissions"}
|
^{::sm/type ::permissions}
|
||||||
[:type {:gen/elements [:membership :share-link]} :keyword]
|
[:map {:title "Permissions"}
|
||||||
[:is-owner ::sm/boolean]
|
[:type {:gen/elements [:membership :share-link]} :keyword]
|
||||||
[:is-admin ::sm/boolean]
|
[:is-owner ::sm/boolean]
|
||||||
[:can-edit ::sm/boolean]
|
[:is-admin ::sm/boolean]
|
||||||
[:can-read ::sm/boolean]
|
[:can-edit ::sm/boolean]
|
||||||
[:is-logged ::sm/boolean]])
|
[:can-read ::sm/boolean]
|
||||||
|
[:is-logged ::sm/boolean]])
|
||||||
|
|
||||||
|
(def valid-roles
|
||||||
(s/def ::role #{:admin :owner :editor :viewer})
|
#{:admin :owner :editor :viewer})
|
||||||
|
|
||||||
(defn assign-role-flags
|
(defn assign-role-flags
|
||||||
[params role]
|
[params role]
|
||||||
(us/verify ::role role)
|
(assert (contains? valid-roles role) "expected a valid role")
|
||||||
(cond-> params
|
(cond-> params
|
||||||
(= role :owner)
|
(= role :owner)
|
||||||
(assoc :is-owner true
|
(assoc :is-owner true
|
||||||
|
@ -51,7 +50,7 @@
|
||||||
(defn make-admin-predicate-fn
|
(defn make-admin-predicate-fn
|
||||||
"A simple factory for admin permission predicate functions."
|
"A simple factory for admin permission predicate functions."
|
||||||
[qfn]
|
[qfn]
|
||||||
(us/assert fn? qfn)
|
(assert (fn? qfn) "expected a function")
|
||||||
(fn check
|
(fn check
|
||||||
([perms] (:is-admin perms))
|
([perms] (:is-admin perms))
|
||||||
([conn & args] (check (apply qfn conn args)))))
|
([conn & args] (check (apply qfn conn args)))))
|
||||||
|
@ -59,7 +58,7 @@
|
||||||
(defn make-edition-predicate-fn
|
(defn make-edition-predicate-fn
|
||||||
"A simple factory for edition permission predicate functions."
|
"A simple factory for edition permission predicate functions."
|
||||||
[qfn]
|
[qfn]
|
||||||
(us/assert fn? qfn)
|
(assert (fn? qfn) "expected a function")
|
||||||
(fn check
|
(fn check
|
||||||
([perms] (:can-edit perms))
|
([perms] (:can-edit perms))
|
||||||
([conn & args] (check (apply qfn conn args)))))
|
([conn & args] (check (apply qfn conn args)))))
|
||||||
|
@ -67,7 +66,7 @@
|
||||||
(defn make-read-predicate-fn
|
(defn make-read-predicate-fn
|
||||||
"A simple factory for read permission predicate functions."
|
"A simple factory for read permission predicate functions."
|
||||||
[qfn]
|
[qfn]
|
||||||
(us/assert fn? qfn)
|
(assert (fn? qfn) "expected a function")
|
||||||
(fn check
|
(fn check
|
||||||
([perms] (:can-read perms))
|
([perms] (:can-read perms))
|
||||||
([conn & args] (check (apply qfn conn args)))))
|
([conn & args] (check (apply qfn conn args)))))
|
||||||
|
@ -75,7 +74,7 @@
|
||||||
(defn make-comment-predicate-fn
|
(defn make-comment-predicate-fn
|
||||||
"A simple factory for comment permission predicate functions."
|
"A simple factory for comment permission predicate functions."
|
||||||
[qfn]
|
[qfn]
|
||||||
(us/assert fn? qfn)
|
(assert (fn? qfn) "expected a function")
|
||||||
(fn check
|
(fn check
|
||||||
([perms]
|
([perms]
|
||||||
(and (:is-logged perms) (= (:who-comment perms) "all")))
|
(and (:is-logged perms) (= (:who-comment perms) "all")))
|
||||||
|
|
|
@ -46,7 +46,7 @@
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uri :as uri]
|
[app.common.uri :as uri]
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
|
@ -61,7 +61,6 @@
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.edn :as edn]
|
[clojure.edn :as edn]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[datoteka.fs :as fs]
|
[datoteka.fs :as fs]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
|
@ -95,9 +94,46 @@
|
||||||
(defmulti parse-limit (fn [[_ strategy _]] strategy))
|
(defmulti parse-limit (fn [[_ strategy _]] strategy))
|
||||||
(defmulti process-limit (fn [_ _ _ o] (::strategy o)))
|
(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
|
(defmethod parse-limit :window
|
||||||
[[name strategy opts :as vlimit]]
|
[[name strategy opts :as vlimit]]
|
||||||
(us/assert! ::limit-tuple vlimit)
|
(assert (valid-limit-tuple? vlimit) "expected valid limit tuple")
|
||||||
|
|
||||||
(merge
|
(merge
|
||||||
{::name name
|
{::name name
|
||||||
::strategy strategy}
|
::strategy strategy}
|
||||||
|
@ -118,7 +154,8 @@
|
||||||
|
|
||||||
(defmethod parse-limit :bucket
|
(defmethod parse-limit :bucket
|
||||||
[[name strategy opts :as vlimit]]
|
[[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)]
|
(if-let [[_ capacity rate interval] (re-find bucket-opts-re opts)]
|
||||||
(let [interval (dt/duration interval)
|
(let [interval (dt/duration interval)
|
||||||
rate (parse-long rate)
|
rate (parse-long rate)
|
||||||
|
@ -140,7 +177,7 @@
|
||||||
(let [script (-> bucket-rate-limit-script
|
(let [script (-> bucket-rate-limit-script
|
||||||
(assoc ::rscript/keys [(str key "." service "." user-id)])
|
(assoc ::rscript/keys [(str key "." service "." user-id)])
|
||||||
(assoc ::rscript/vals (conj params (dt/->seconds now))))
|
(assoc ::rscript/vals (conj params (dt/->seconds now))))
|
||||||
result (rds/eval! redis script)
|
result (rds/eval redis script)
|
||||||
allowed? (boolean (nth result 0))
|
allowed? (boolean (nth result 0))
|
||||||
remaining (nth result 1)
|
remaining (nth result 1)
|
||||||
reset (* (/ (inst-ms interval) rate)
|
reset (* (/ (inst-ms interval) rate)
|
||||||
|
@ -164,7 +201,7 @@
|
||||||
script (-> window-rate-limit-script
|
script (-> window-rate-limit-script
|
||||||
(assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))])
|
(assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))])
|
||||||
(assoc ::rscript/vals [nreq (dt/->seconds ttl)]))
|
(assoc ::rscript/vals [nreq (dt/->seconds ttl)]))
|
||||||
result (rds/eval! redis script)
|
result (rds/eval redis script)
|
||||||
allowed? (boolean (nth result 0))
|
allowed? (boolean (nth result 0))
|
||||||
remaining (nth result 1)]
|
remaining (nth result 1)]
|
||||||
(l/trace :hint "limit processed"
|
(l/trace :hint "limit processed"
|
||||||
|
@ -245,8 +282,8 @@
|
||||||
|
|
||||||
(defn wrap
|
(defn wrap
|
||||||
[{:keys [::rpc/rlimit ::rds/redis] :as cfg} f mdata]
|
[{:keys [::rpc/rlimit ::rds/redis] :as cfg} f mdata]
|
||||||
(us/assert! ::rpc/rlimit rlimit)
|
(assert (rds/redis? redis) "expected a valid redis instance")
|
||||||
(us/assert! ::rds/redis redis)
|
(assert (or (nil? rlimit) (valid-rlimit-instance? rlimit)) "expected a valid rlimit instance")
|
||||||
|
|
||||||
(if rlimit
|
(if rlimit
|
||||||
(let [skey (keyword (::rpc/type cfg) (->> mdata ::sv/spec name))
|
(let [skey (keyword (::rpc/type cfg) (->> mdata ::sv/spec name))
|
||||||
|
@ -275,42 +312,19 @@
|
||||||
;; CONFIG WATCHER
|
;; CONFIG WATCHER
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::strategy (s/and ::us/keyword #{:window :bucket}))
|
(def ^:private schema:config
|
||||||
(s/def ::capacity ::us/integer)
|
[:map-of
|
||||||
(s/def ::rate ::us/integer)
|
[:or :keyword [:set :keyword]]
|
||||||
(s/def ::interval ::dt/duration)
|
[:vector schema:limit-tuple]])
|
||||||
(s/def ::key ::us/string)
|
|
||||||
(s/def ::opts ::us/string)
|
|
||||||
(s/def ::params vector?)
|
|
||||||
(s/def ::unit #{:days :hours :minutes :seconds :weeks})
|
|
||||||
(s/def ::nreq ::us/integer)
|
|
||||||
(s/def ::refresh ::dt/duration)
|
|
||||||
|
|
||||||
(s/def ::limit-tuple
|
(def ^:private check-config
|
||||||
(s/tuple ::us/keyword ::strategy string?))
|
(sm/check-fn schema:config))
|
||||||
|
|
||||||
(s/def ::limits
|
(def ^:private check-refresh
|
||||||
(s/map-of keyword? (s/every ::limit :kind vector?)))
|
(sm/check-fn ::dt/duration))
|
||||||
|
|
||||||
(s/def ::limit
|
(def ^:private check-limits
|
||||||
(s/and
|
(sm/check-fn schema:limits))
|
||||||
(s/keys :req [::name ::strategy ::key ::opts])
|
|
||||||
(s/or :bucket
|
|
||||||
(s/keys :req [::capacity
|
|
||||||
::rate
|
|
||||||
::interval
|
|
||||||
::params])
|
|
||||||
:window
|
|
||||||
(s/keys :req [::nreq
|
|
||||||
::unit]))))
|
|
||||||
|
|
||||||
(s/def ::rpc/rlimit
|
|
||||||
(s/nilable
|
|
||||||
#(instance? clojure.lang.Agent %)))
|
|
||||||
|
|
||||||
(s/def ::config
|
|
||||||
(s/map-of (s/or :kw keyword? :set set?)
|
|
||||||
(s/every ::limit-tuple :kind vector?)))
|
|
||||||
|
|
||||||
(defn read-config
|
(defn read-config
|
||||||
[path]
|
[path]
|
||||||
|
@ -336,13 +350,9 @@
|
||||||
{}
|
{}
|
||||||
config)))]
|
config)))]
|
||||||
|
|
||||||
(when-let [config (some->> path slurp edn/read-string)]
|
(when-let [config (some->> path slurp edn/read-string check-config)]
|
||||||
(us/verify! ::config config)
|
(let [refresh (->> config meta :refresh dt/duration check-refresh)
|
||||||
(let [refresh (->> config meta :refresh dt/duration)
|
limits (->> config compile-pass-1 compile-pass-2 check-limits)]
|
||||||
limits (->> config compile-pass-1 compile-pass-2)]
|
|
||||||
|
|
||||||
(us/verify! ::limits limits)
|
|
||||||
(us/verify! ::refresh refresh)
|
|
||||||
|
|
||||||
{::refresh refresh
|
{::refresh refresh
|
||||||
::limits limits}))))
|
::limits limits}))))
|
||||||
|
@ -385,8 +395,9 @@
|
||||||
(when-let [path (cf/get :rpc-rlimit-config)]
|
(when-let [path (cf/get :rpc-rlimit-config)]
|
||||||
(and (fs/exists? path) (fs/regular-file? path) path)))
|
(and (fs/exists? path) (fs/regular-file? path) path)))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec :app.rpc/rlimit [_]
|
(defmethod ig/assert-key :app.rpc/rlimit
|
||||||
(s/keys :req [::wrk/executor]))
|
[_ {:keys [::wrk/executor]}]
|
||||||
|
(assert (sm/valid? ::wrk/executor executor) "expect valid executor"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::rpc/rlimit
|
(defmethod ig/init-key ::rpc/rlimit
|
||||||
[_ {:keys [::wrk/executor] :as cfg}]
|
[_ {:keys [::wrk/executor] :as cfg}]
|
||||||
|
|
|
@ -9,7 +9,7 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.main :as-alias main]
|
[app.main :as-alias main]
|
||||||
|
@ -17,7 +17,6 @@
|
||||||
[app.setup.templates]
|
[app.setup.templates]
|
||||||
[buddy.core.codecs :as bc]
|
[buddy.core.codecs :as bc]
|
||||||
[buddy.core.nonce :as bn]
|
[buddy.core.nonce :as bn]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(defn- generate-random-key
|
(defn- generate-random-key
|
||||||
|
@ -73,12 +72,10 @@
|
||||||
(db/run! system (fn [{:keys [::db/conn]}]
|
(db/run! system (fn [{:keys [::db/conn]}]
|
||||||
(db/exec-one! conn [sql:add-prop prop value false value false])))))
|
(db/exec-one! conn [sql:add-prop prop value false value false])))))
|
||||||
|
|
||||||
(s/def ::key ::us/string)
|
(defmethod ig/assert-key ::props
|
||||||
(s/def ::props (s/map-of ::us/keyword some?))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected valid database pool")
|
||||||
(defmethod ig/pre-init-spec ::props [_]
|
(assert (string? (::key params)) "expected valid key string"))
|
||||||
(s/keys :req [::db/pool]
|
|
||||||
:opt [::key]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::props
|
(defmethod ig/init-key ::props
|
||||||
[_ {:keys [::db/pool ::key] :as cfg}]
|
[_ {:keys [::db/pool ::key] :as cfg}]
|
||||||
|
@ -94,3 +91,7 @@
|
||||||
(assoc :secret-key secret)
|
(assoc :secret-key secret)
|
||||||
(assoc :tokens-key (keys/derive secret :salt "tokens"))
|
(assoc :tokens-key (keys/derive secret :salt "tokens"))
|
||||||
(update :instance-id handle-instance-id conn (db/read-only? pool))))))
|
(update :instance-id handle-instance-id conn (db/read-only? pool))))))
|
||||||
|
|
||||||
|
|
||||||
|
;; FIXME
|
||||||
|
(sm/register! ::props :any)
|
||||||
|
|
|
@ -8,7 +8,6 @@
|
||||||
"Server Repl."
|
"Server Repl."
|
||||||
(:require
|
(:require
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.srepl.cli]
|
[app.srepl.cli]
|
||||||
[app.srepl.main]
|
[app.srepl.main]
|
||||||
|
@ -16,7 +15,6 @@
|
||||||
[app.util.locks :as locks]
|
[app.util.locks :as locks]
|
||||||
[clojure.core.server :as ccs]
|
[clojure.core.server :as ccs]
|
||||||
[clojure.main :as cm]
|
[clojure.main :as cm]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(defn- repl-init
|
(defn- repl-init
|
||||||
|
@ -44,16 +42,14 @@
|
||||||
|
|
||||||
;; --- State initialization
|
;; --- State initialization
|
||||||
|
|
||||||
(s/def ::port ::us/integer)
|
(defmethod ig/assert-key ::server
|
||||||
(s/def ::host ::us/not-empty-string)
|
[_ params]
|
||||||
|
(assert (int? (::port params)) "expected valid port")
|
||||||
|
(assert (string? (::host params)) "expected valid host"))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::server
|
(defmethod ig/expand-key ::server
|
||||||
[_]
|
[[type :as k] v]
|
||||||
(s/keys :req [::host ::port]))
|
{k (assoc v ::flag (keyword (str (name type) "-server")))})
|
||||||
|
|
||||||
(defmethod ig/prep-key ::server
|
|
||||||
[[type _] cfg]
|
|
||||||
(assoc cfg ::flag (keyword (str (name type) "-server"))))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::server
|
(defmethod ig/init-key ::server
|
||||||
[[type _] {:keys [::flag ::port ::host] :as cfg}]
|
[[type _] {:keys [::flag ::port ::host] :as cfg}]
|
||||||
|
|
|
@ -11,7 +11,7 @@
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.data.macros :as dm]
|
[app.common.data.macros :as dm]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
|
@ -19,7 +19,6 @@
|
||||||
[app.storage.impl :as impl]
|
[app.storage.impl :as impl]
|
||||||
[app.storage.s3 :as ss3]
|
[app.storage.s3 :as ss3]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[datoteka.fs :as fs]
|
[datoteka.fs :as fs]
|
||||||
[integrant.core :as ig])
|
[integrant.core :as ig])
|
||||||
|
@ -48,19 +47,29 @@
|
||||||
;; Storage Module State
|
;; Storage Module State
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(s/def ::id #{:assets-fs :assets-s3 :fs :s3})
|
(def ^:private schema:backends
|
||||||
(s/def ::s3 ::ss3/backend)
|
[:map-of :keyword
|
||||||
(s/def ::fs ::sfs/backend)
|
[:maybe
|
||||||
(s/def ::type #{:fs :s3})
|
[:or ::ss3/backend ::sfs/backend]]])
|
||||||
|
|
||||||
(s/def ::backends
|
(def ^:private valid-backends?
|
||||||
(s/map-of ::us/keyword
|
(sm/validator schema:backends))
|
||||||
(s/nilable
|
|
||||||
(s/or :s3 ::ss3/backend
|
|
||||||
:fs ::sfs/backend))))
|
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::storage [_]
|
(def ^:private schema:storage
|
||||||
(s/keys :req [::db/pool ::backends]))
|
[:map {:title "storage"}
|
||||||
|
[::backends schema:backends]
|
||||||
|
[::backend [:enum :s3 :fs]]
|
||||||
|
::db/connectable])
|
||||||
|
|
||||||
|
(def valid-storage?
|
||||||
|
(sm/validator schema:storage))
|
||||||
|
|
||||||
|
(sm/register! ::storage schema:storage)
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::storage
|
||||||
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected valid database pool")
|
||||||
|
(assert (valid-backends? (::backends params)) "expected valid backends map"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::storage
|
(defmethod ig/init-key ::storage
|
||||||
[_ {:keys [::backends ::db/pool] :as cfg}]
|
[_ {:keys [::backends ::db/pool] :as cfg}]
|
||||||
|
@ -78,14 +87,6 @@
|
||||||
(assoc ::backend backend)
|
(assoc ::backend backend)
|
||||||
(assoc ::db/connectable pool))))
|
(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
|
;; Database Objects
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -200,15 +201,16 @@
|
||||||
(dm/export impl/object?)
|
(dm/export impl/object?)
|
||||||
|
|
||||||
(defn get-object
|
(defn get-object
|
||||||
[{:keys [::db/connectable] :as storage} id]
|
[{:keys [::db/connectable] :as storage} id]
|
||||||
(us/assert! ::storage storage)
|
(assert (valid-storage? storage))
|
||||||
(retrieve-database-object connectable id))
|
(retrieve-database-object connectable id))
|
||||||
|
|
||||||
(defn put-object!
|
(defn put-object!
|
||||||
"Creates a new object with the provided content."
|
"Creates a new object with the provided content."
|
||||||
[{:keys [::backend] :as storage} {:keys [::content] :as params}]
|
[{:keys [::backend] :as storage} {:keys [::content] :as params}]
|
||||||
(us/assert! ::storage-with-backend storage)
|
(assert (valid-storage? storage))
|
||||||
(us/assert! ::impl/content content)
|
(assert (impl/content? content) "expected an instance of content")
|
||||||
|
|
||||||
(let [object (create-database-object storage params)]
|
(let [object (create-database-object storage params)]
|
||||||
(if (::created? (meta object))
|
(if (::created? (meta object))
|
||||||
;; Store the data finally on the underlying storage subsystem.
|
;; Store the data finally on the underlying storage subsystem.
|
||||||
|
@ -219,7 +221,7 @@
|
||||||
(defn touch-object!
|
(defn touch-object!
|
||||||
"Mark object as touched."
|
"Mark object as touched."
|
||||||
[{:keys [::db/connectable] :as storage} object-or-id]
|
[{: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)]
|
(let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id)]
|
||||||
(-> (db/update! connectable :storage-object
|
(-> (db/update! connectable :storage-object
|
||||||
{:touched-at (dt/now)}
|
{:touched-at (dt/now)}
|
||||||
|
@ -231,7 +233,7 @@
|
||||||
"Return an input stream instance of the object content."
|
"Return an input stream instance of the object content."
|
||||||
^InputStream
|
^InputStream
|
||||||
[storage object]
|
[storage object]
|
||||||
(us/assert! ::storage storage)
|
(assert (valid-storage? storage))
|
||||||
(when (or (nil? (:expired-at object))
|
(when (or (nil? (:expired-at object))
|
||||||
(dt/is-after? (:expired-at object) (dt/now)))
|
(dt/is-after? (:expired-at object) (dt/now)))
|
||||||
(-> (impl/resolve-backend storage (:backend object))
|
(-> (impl/resolve-backend storage (:backend object))
|
||||||
|
@ -240,7 +242,7 @@
|
||||||
(defn get-object-bytes
|
(defn get-object-bytes
|
||||||
"Returns a byte array of object content."
|
"Returns a byte array of object content."
|
||||||
[storage object]
|
[storage object]
|
||||||
(us/assert! ::storage storage)
|
(assert (valid-storage? storage))
|
||||||
(when (or (nil? (:expired-at object))
|
(when (or (nil? (:expired-at object))
|
||||||
(dt/is-after? (:expired-at object) (dt/now)))
|
(dt/is-after? (:expired-at object) (dt/now)))
|
||||||
(-> (impl/resolve-backend storage (:backend object))
|
(-> (impl/resolve-backend storage (:backend object))
|
||||||
|
@ -250,7 +252,7 @@
|
||||||
([storage object]
|
([storage object]
|
||||||
(get-object-url storage object nil))
|
(get-object-url storage object nil))
|
||||||
([storage object options]
|
([storage object options]
|
||||||
(us/assert! ::storage storage)
|
(assert (valid-storage? storage))
|
||||||
(when (or (nil? (:expired-at object))
|
(when (or (nil? (:expired-at object))
|
||||||
(dt/is-after? (:expired-at object) (dt/now)))
|
(dt/is-after? (:expired-at object) (dt/now)))
|
||||||
(-> (impl/resolve-backend storage (:backend object))
|
(-> (impl/resolve-backend storage (:backend object))
|
||||||
|
@ -260,7 +262,7 @@
|
||||||
"Get the Path to the object. Only works with `:fs` type of
|
"Get the Path to the object. Only works with `:fs` type of
|
||||||
storages."
|
storages."
|
||||||
[storage object]
|
[storage object]
|
||||||
(us/assert! ::storage storage)
|
(assert (valid-storage? storage))
|
||||||
(let [backend (impl/resolve-backend storage (:backend object))]
|
(let [backend (impl/resolve-backend storage (:backend object))]
|
||||||
(when (and (= :fs (::type backend))
|
(when (and (= :fs (::type backend))
|
||||||
(or (nil? (:expired-at object))
|
(or (nil? (:expired-at object))
|
||||||
|
@ -269,7 +271,7 @@
|
||||||
|
|
||||||
(defn del-object!
|
(defn del-object!
|
||||||
[{:keys [::db/connectable] :as storage} object-or-id]
|
[{: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)
|
(let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id)
|
||||||
res (db/update! connectable :storage-object
|
res (db/update! connectable :storage-object
|
||||||
{:deleted-at (dt/now)}
|
{:deleted-at (dt/now)}
|
||||||
|
@ -282,6 +284,7 @@
|
||||||
|
|
||||||
(defn configure
|
(defn configure
|
||||||
[storage connectable]
|
[storage connectable]
|
||||||
|
(assert (valid-storage? storage))
|
||||||
(assoc storage ::db/connectable connectable))
|
(assoc storage ::db/connectable connectable))
|
||||||
|
|
||||||
(defn resolve
|
(defn resolve
|
||||||
|
|
|
@ -7,11 +7,10 @@
|
||||||
(ns app.storage.fs
|
(ns app.storage.fs
|
||||||
(:require
|
(:require
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uri :as u]
|
[app.common.uri :as u]
|
||||||
[app.storage :as-alias sto]
|
[app.storage :as-alias sto]
|
||||||
[app.storage.impl :as impl]
|
[app.storage.impl :as impl]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[datoteka.fs :as fs]
|
[datoteka.fs :as fs]
|
||||||
[datoteka.io :as io]
|
[datoteka.io :as io]
|
||||||
|
@ -26,10 +25,10 @@
|
||||||
|
|
||||||
;; --- BACKEND INIT
|
;; --- BACKEND INIT
|
||||||
|
|
||||||
(s/def ::directory ::us/string)
|
(defmethod ig/assert-key ::backend
|
||||||
|
[_ params]
|
||||||
(defmethod ig/pre-init-spec ::backend [_]
|
;; FIXME: path (?)
|
||||||
(s/keys :opt [::directory]))
|
(assert (string? (::directory params))))
|
||||||
|
|
||||||
(defmethod ig/init-key ::backend
|
(defmethod ig/init-key ::backend
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
@ -42,18 +41,22 @@
|
||||||
::directory (str dir)
|
::directory (str dir)
|
||||||
::uri (u/uri (str "file://" dir))))))
|
::uri (u/uri (str "file://" dir))))))
|
||||||
|
|
||||||
(s/def ::uri u/uri?)
|
(def ^:private schema:backend
|
||||||
(s/def ::backend
|
[:map {:title "fs-backend"}
|
||||||
(s/keys :req [::directory
|
[::directory :string]
|
||||||
::uri]
|
[::uri ::sm/uri]
|
||||||
:opt [::sto/type
|
[::sto/type [:= :fs]]])
|
||||||
::sto/id]))
|
|
||||||
|
(sm/register! ::backend schema:backend)
|
||||||
|
|
||||||
|
(def ^:private valid-backend?
|
||||||
|
(sm/validator schema:backend))
|
||||||
|
|
||||||
;; --- API IMPL
|
;; --- API IMPL
|
||||||
|
|
||||||
(defmethod impl/put-object :fs
|
(defmethod impl/put-object :fs
|
||||||
[backend {:keys [id] :as object} content]
|
[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))
|
(let [base (fs/path (::directory backend))
|
||||||
path (fs/path (impl/id->path id))
|
path (fs/path (impl/id->path id))
|
||||||
full (fs/normalize (fs/join base path))]
|
full (fs/normalize (fs/join base path))]
|
||||||
|
@ -69,7 +72,7 @@
|
||||||
|
|
||||||
(defmethod impl/get-object-data :fs
|
(defmethod impl/get-object-data :fs
|
||||||
[backend {:keys [id] :as object}]
|
[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))
|
(let [^Path base (fs/path (::directory backend))
|
||||||
^Path path (fs/path (impl/id->path id))
|
^Path path (fs/path (impl/id->path id))
|
||||||
^Path full (fs/normalize (fs/join base path))]
|
^Path full (fs/normalize (fs/join base path))]
|
||||||
|
@ -86,7 +89,7 @@
|
||||||
|
|
||||||
(defmethod impl/get-object-url :fs
|
(defmethod impl/get-object-url :fs
|
||||||
[{:keys [::uri] :as backend} {:keys [id] :as object} _]
|
[{:keys [::uri] :as backend} {:keys [id] :as object} _]
|
||||||
(us/assert! ::backend backend)
|
(assert (valid-backend? backend) "expected a valid backend instance")
|
||||||
(update uri :path
|
(update uri :path
|
||||||
(fn [existing]
|
(fn [existing]
|
||||||
(if (str/ends-with? existing "/")
|
(if (str/ends-with? existing "/")
|
||||||
|
@ -95,7 +98,7 @@
|
||||||
|
|
||||||
(defmethod impl/del-object :fs
|
(defmethod impl/del-object :fs
|
||||||
[backend {:keys [id] :as object}]
|
[backend {:keys [id] :as object}]
|
||||||
(us/assert! ::backend backend)
|
(assert (valid-backend? backend) "expected a valid backend instance")
|
||||||
(let [base (fs/path (::directory backend))
|
(let [base (fs/path (::directory backend))
|
||||||
path (fs/path (impl/id->path id))
|
path (fs/path (impl/id->path id))
|
||||||
path (fs/join base path)]
|
path (fs/join base path)]
|
||||||
|
@ -103,7 +106,7 @@
|
||||||
|
|
||||||
(defmethod impl/del-objects-in-bulk :fs
|
(defmethod impl/del-objects-in-bulk :fs
|
||||||
[backend ids]
|
[backend ids]
|
||||||
(us/assert! ::backend backend)
|
(assert (valid-backend? backend) "expected a valid backend instance")
|
||||||
(let [base (fs/path (::directory backend))]
|
(let [base (fs/path (::directory backend))]
|
||||||
(doseq [id ids]
|
(doseq [id ids]
|
||||||
(let [path (fs/path (impl/id->path id))
|
(let [path (fs/path (impl/id->path id))
|
||||||
|
|
|
@ -16,10 +16,9 @@
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.storage :as-alias sto]
|
[app.storage :as sto]
|
||||||
[app.storage.impl :as impl]
|
[app.storage.impl :as impl]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(def ^:private sql:lock-sobjects
|
(def ^:private sql:lock-sobjects
|
||||||
|
@ -100,13 +99,14 @@
|
||||||
0
|
0
|
||||||
(get-buckets conn min-age)))
|
(get-buckets conn min-age)))
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::handler
|
||||||
|
[_ params]
|
||||||
|
(assert (sto/valid-storage? (::sto/storage params)) "expect valid storage")
|
||||||
|
(assert (db/pool? (::db/pool params)) "expect valid storage"))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/expand-key ::handler
|
||||||
(s/keys :req [::sto/storage ::db/pool]))
|
[k v]
|
||||||
|
{k (assoc v ::min-age (dt/duration {:hours 2}))})
|
||||||
(defmethod ig/prep-key ::handler
|
|
||||||
[_ cfg]
|
|
||||||
(assoc cfg ::min-age (dt/duration {:hours 2})))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ {:keys [::min-age] :as cfg}]
|
[_ {:keys [::min-age] :as cfg}]
|
||||||
|
|
|
@ -25,7 +25,6 @@
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.storage :as-alias sto]
|
[app.storage :as-alias sto]
|
||||||
[app.storage.impl :as impl]
|
[app.storage.impl :as impl]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(def ^:private sql:has-team-font-variant-refs
|
(def ^:private sql:has-team-font-variant-refs
|
||||||
|
@ -226,8 +225,9 @@
|
||||||
;; HANDLER
|
;; HANDLER
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expect valid storage"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -14,7 +14,6 @@
|
||||||
[buddy.core.codecs :as bc]
|
[buddy.core.codecs :as bc]
|
||||||
[buddy.core.hash :as bh]
|
[buddy.core.hash :as bh]
|
||||||
[clojure.java.io :as jio]
|
[clojure.java.io :as jio]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[datoteka.io :as io])
|
[datoteka.io :as io])
|
||||||
(:import
|
(:import
|
||||||
java.nio.ByteBuffer
|
java.nio.ByteBuffer
|
||||||
|
@ -234,7 +233,3 @@
|
||||||
[v]
|
[v]
|
||||||
(satisfies? IContentObject v))
|
(satisfies? IContentObject v))
|
||||||
|
|
||||||
(s/def ::object object?)
|
|
||||||
(s/def ::content content?)
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -11,7 +11,7 @@
|
||||||
[app.common.data.macros :as dm]
|
[app.common.data.macros :as dm]
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uri :as u]
|
[app.common.uri :as u]
|
||||||
[app.storage :as-alias sto]
|
[app.storage :as-alias sto]
|
||||||
[app.storage.impl :as impl]
|
[app.storage.impl :as impl]
|
||||||
|
@ -19,7 +19,6 @@
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as-alias wrk]
|
[app.worker :as-alias wrk]
|
||||||
[clojure.java.io :as io]
|
[clojure.java.io :as io]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[datoteka.fs :as fs]
|
[datoteka.fs :as fs]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.core :as p]
|
[promesa.core :as p]
|
||||||
|
@ -86,61 +85,68 @@
|
||||||
|
|
||||||
;; --- BACKEND INIT
|
;; --- BACKEND INIT
|
||||||
|
|
||||||
(s/def ::region ::us/keyword)
|
(def ^:private schema:config
|
||||||
(s/def ::bucket ::us/string)
|
[:map {:title "s3-backend-config"}
|
||||||
(s/def ::prefix ::us/string)
|
::wrk/executor
|
||||||
(s/def ::endpoint ::us/string)
|
[::region {:optional true} :keyword]
|
||||||
(s/def ::io-threads ::us/integer)
|
[::bucket {:optional true} ::sm/text]
|
||||||
|
[::prefix {:optional true} ::sm/text]
|
||||||
|
[::endpoint {:optional true} ::sm/uri]
|
||||||
|
[::io-threads {:optional true} ::sm/int]])
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::backend [_]
|
(defmethod ig/expand-key ::backend
|
||||||
(s/keys :opt [::region ::bucket ::prefix ::endpoint ::io-threads ::wrk/executor]))
|
[k v]
|
||||||
|
{k (merge {::region :eu-central-1} (d/without-nils v))})
|
||||||
|
|
||||||
(defmethod ig/prep-key ::backend
|
(defmethod ig/assert-key ::backend
|
||||||
[_ {:keys [::prefix ::region] :as cfg}]
|
[_ params]
|
||||||
(cond-> (d/without-nils cfg)
|
(assert (sm/check schema:config params)))
|
||||||
(some? prefix) (assoc ::prefix prefix)
|
|
||||||
(nil? region) (assoc ::region :eu-central-1)))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::backend
|
(defmethod ig/init-key ::backend
|
||||||
[_ cfg]
|
[_ params]
|
||||||
;; Return a valid backend data structure only if all optional
|
(when (and (contains? params ::region)
|
||||||
;; parameters are provided.
|
(contains? params ::bucket))
|
||||||
(when (and (contains? cfg ::region)
|
(let [client (build-s3-client params)
|
||||||
(string? (::bucket cfg)))
|
presigner (build-s3-presigner params)]
|
||||||
(let [client (build-s3-client cfg)
|
(assoc params
|
||||||
presigner (build-s3-presigner cfg)]
|
|
||||||
(assoc cfg
|
|
||||||
::sto/type :s3
|
::sto/type :s3
|
||||||
::client @client
|
::client @client
|
||||||
::presigner presigner
|
::presigner presigner
|
||||||
::close-fn #(.close ^java.lang.AutoCloseable client)))))
|
::close-fn #(.close ^java.lang.AutoCloseable client)))))
|
||||||
|
|
||||||
|
(defmethod ig/resolve-key ::backend
|
||||||
|
[_ params]
|
||||||
|
(dissoc params ::close-fn))
|
||||||
|
|
||||||
(defmethod ig/halt-key! ::backend
|
(defmethod ig/halt-key! ::backend
|
||||||
[_ {:keys [::close-fn]}]
|
[_ {:keys [::close-fn]}]
|
||||||
(when (fn? close-fn)
|
(when (fn? close-fn)
|
||||||
(px/run! close-fn)))
|
(px/run! close-fn)))
|
||||||
|
|
||||||
(s/def ::client #(instance? S3AsyncClient %))
|
(def ^:private schema:backend
|
||||||
(s/def ::presigner #(instance? S3Presigner %))
|
[:map {:title "s3-backend"}
|
||||||
(s/def ::backend
|
;; [::region :keyword]
|
||||||
(s/keys :req [::region
|
;; [::bucket ::sm/text]
|
||||||
::bucket
|
[::client [:fn #(instance? S3AsyncClient %)]]
|
||||||
::client
|
[::presigner [:fn #(instance? S3Presigner %)]]
|
||||||
::presigner]
|
[::prefix {:optional true} ::sm/text]
|
||||||
:opt [::prefix
|
#_[::sto/type [:= :s3]]])
|
||||||
::sto/id]))
|
|
||||||
|
(sm/register! ::backend schema:backend)
|
||||||
|
|
||||||
|
(def ^:private valid-backend?
|
||||||
|
(sm/validator schema:backend))
|
||||||
|
|
||||||
;; --- API IMPL
|
;; --- API IMPL
|
||||||
|
|
||||||
(defmethod impl/put-object :s3
|
(defmethod impl/put-object :s3
|
||||||
[backend object content]
|
[backend object content]
|
||||||
(us/assert! ::backend backend)
|
(assert (valid-backend? backend) "expected a valid backend instance")
|
||||||
(p/await! (put-object backend object content)))
|
(p/await! (put-object backend object content)))
|
||||||
|
|
||||||
(defmethod impl/get-object-data :s3
|
(defmethod impl/get-object-data :s3
|
||||||
[backend object]
|
[backend object]
|
||||||
(us/assert! ::backend backend)
|
(assert (valid-backend? backend) "expected a valid backend instance")
|
||||||
|
|
||||||
(loop [result (get-object-data backend object)
|
(loop [result (get-object-data backend object)
|
||||||
retryn 0]
|
retryn 0]
|
||||||
|
|
||||||
|
@ -167,22 +173,21 @@
|
||||||
|
|
||||||
(defmethod impl/get-object-bytes :s3
|
(defmethod impl/get-object-bytes :s3
|
||||||
[backend object]
|
[backend object]
|
||||||
(us/assert! ::backend backend)
|
(assert (valid-backend? backend) "expected a valid backend instance")
|
||||||
(p/await! (get-object-bytes backend object)))
|
(p/await! (get-object-bytes backend object)))
|
||||||
|
|
||||||
(defmethod impl/get-object-url :s3
|
(defmethod impl/get-object-url :s3
|
||||||
[backend object options]
|
[backend object options]
|
||||||
(us/assert! ::backend backend)
|
(assert (valid-backend? backend) "expected a valid backend instance")
|
||||||
(get-object-url backend object options))
|
(get-object-url backend object options))
|
||||||
|
|
||||||
(defmethod impl/del-object :s3
|
(defmethod impl/del-object :s3
|
||||||
[backend object]
|
[backend object]
|
||||||
(us/assert! ::backend backend)
|
|
||||||
(p/await! (del-object backend object)))
|
(p/await! (del-object backend object)))
|
||||||
|
|
||||||
(defmethod impl/del-objects-in-bulk :s3
|
(defmethod impl/del-objects-in-bulk :s3
|
||||||
[backend ids]
|
[backend ids]
|
||||||
(us/assert! ::backend backend)
|
(assert (valid-backend? backend) "expected a valid backend instance")
|
||||||
(p/await! (del-object-in-bulk backend ids)))
|
(p/await! (del-object-in-bulk backend ids)))
|
||||||
|
|
||||||
;; --- HELPERS
|
;; --- HELPERS
|
||||||
|
@ -221,7 +226,7 @@
|
||||||
builder (.region ^S3AsyncClientBuilder builder (lookup-region region))
|
builder (.region ^S3AsyncClientBuilder builder (lookup-region region))
|
||||||
builder (cond-> ^S3AsyncClientBuilder builder
|
builder (cond-> ^S3AsyncClientBuilder builder
|
||||||
(some? endpoint)
|
(some? endpoint)
|
||||||
(.endpointOverride (URI. endpoint)))]
|
(.endpointOverride (URI. (str endpoint))))]
|
||||||
(.build ^S3AsyncClientBuilder builder))]
|
(.build ^S3AsyncClientBuilder builder))]
|
||||||
|
|
||||||
(reify
|
(reify
|
||||||
|
@ -240,7 +245,7 @@
|
||||||
(.build))]
|
(.build))]
|
||||||
|
|
||||||
(-> (S3Presigner/builder)
|
(-> (S3Presigner/builder)
|
||||||
(cond-> (some? endpoint) (.endpointOverride (URI. endpoint)))
|
(cond-> (some? endpoint) (.endpointOverride (URI. (str endpoint))))
|
||||||
(.region (lookup-region region))
|
(.region (lookup-region region))
|
||||||
(.serviceConfiguration ^S3Configuration config)
|
(.serviceConfiguration ^S3Configuration config)
|
||||||
(.build))))
|
(.build))))
|
||||||
|
@ -337,7 +342,8 @@
|
||||||
|
|
||||||
(defn- get-object-url
|
(defn- get-object-url
|
||||||
[{:keys [::presigner ::bucket ::prefix]} {:keys [id]} {:keys [max-age] :or {max-age default-max-age}}]
|
[{: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)
|
(let [gor (.. (GetObjectRequest/builder)
|
||||||
(bucket bucket)
|
(bucket bucket)
|
||||||
(key (dm/str prefix (impl/id->path id)))
|
(key (dm/str prefix (impl/id->path id)))
|
||||||
|
|
|
@ -11,10 +11,10 @@
|
||||||
permanently delete these files (look at systemd-tempfiles)."
|
permanently delete these files (look at systemd-tempfiles)."
|
||||||
(:require
|
(:require
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
|
[app.common.schema :as sm]
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[datoteka.fs :as fs]
|
[datoteka.fs :as fs]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px]
|
[promesa.exec :as px]
|
||||||
|
@ -29,12 +29,13 @@
|
||||||
|
|
||||||
(defonce queue (sp/chan :buf 128))
|
(defonce queue (sp/chan :buf 128))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::cleaner [_]
|
(defmethod ig/assert-key ::cleaner
|
||||||
(s/keys :req [::wrk/executor]))
|
[_ {:keys [::wrk/executor]}]
|
||||||
|
(assert (sm/valid? ::wrk/executor executor)))
|
||||||
|
|
||||||
(defmethod ig/prep-key ::cleaner
|
(defmethod ig/expand-key ::cleaner
|
||||||
[_ cfg]
|
[k v]
|
||||||
(assoc cfg ::min-age (dt/duration "60m")))
|
{k (assoc v ::min-age (dt/duration "60m"))})
|
||||||
|
|
||||||
(defmethod ig/init-key ::cleaner
|
(defmethod ig/init-key ::cleaner
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -12,7 +12,6 @@
|
||||||
[app.rpc.commands.files :as files]
|
[app.rpc.commands.files :as files]
|
||||||
[app.rpc.commands.profile :as profile]
|
[app.rpc.commands.profile :as profile]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(def ^:dynamic *team-deletion* false)
|
(def ^:dynamic *team-deletion* false)
|
||||||
|
@ -113,8 +112,9 @@
|
||||||
[_cfg props]
|
[_cfg props]
|
||||||
(l/wrn :hint "not implementation found" :rel (:object props)))
|
(l/wrn :hint "not implementation found" :rel (:object props)))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -27,7 +27,6 @@
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.set :as set]
|
[clojure.set :as set]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(declare ^:private get-file)
|
(declare ^:private get-file)
|
||||||
|
@ -315,8 +314,10 @@
|
||||||
;; HANDLER
|
;; HANDLER
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool ::sto/storage]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool")
|
||||||
|
(assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -12,7 +12,6 @@
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(def ^:private
|
(def ^:private
|
||||||
|
@ -43,12 +42,13 @@
|
||||||
|
|
||||||
{:processed total}))
|
{:processed total}))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool"))
|
||||||
|
|
||||||
(defmethod ig/prep-key ::handler
|
(defmethod ig/expand-key ::handler
|
||||||
[_ cfg]
|
[k v]
|
||||||
(assoc cfg ::min-age (cf/get-deletion-delay)))
|
{k (assoc v ::min-age (cf/get-deletion-delay))})
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -9,7 +9,6 @@
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
;; Get the latest available snapshots without exceeding the total
|
;; Get the latest available snapshots without exceeding the total
|
||||||
|
@ -51,8 +50,9 @@
|
||||||
:current (count snapshots)
|
:current (count snapshots)
|
||||||
:deleted (db/get-update-count result)))))
|
:deleted (db/get-update-count result)))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -13,7 +13,6 @@
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.storage :as sto]
|
[app.storage :as sto]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(def ^:private sql:get-profiles
|
(def ^:private sql:get-profiles
|
||||||
|
@ -318,14 +317,16 @@
|
||||||
(recur (+ total result))
|
(recur (+ total result))
|
||||||
total))))
|
total))))
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool ::sto/storage]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool")
|
||||||
|
(assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided"))
|
||||||
|
|
||||||
(defmethod ig/prep-key ::handler
|
(defmethod ig/expand-key ::handler
|
||||||
[_ cfg]
|
[k v]
|
||||||
(assoc cfg
|
{k (assoc v
|
||||||
::min-age (cf/get-deletion-delay)
|
::min-age (cf/get-deletion-delay)
|
||||||
::chunk-size 50))
|
::chunk-size 50)})
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -13,7 +13,6 @@
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.db.sql :as-alias sql]
|
[app.db.sql :as-alias sql]
|
||||||
[app.storage :as sto]
|
[app.storage :as sto]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(defn- offload-file-data!
|
(defn- offload-file-data!
|
||||||
|
@ -109,8 +108,10 @@
|
||||||
;; HANDLER
|
;; HANDLER
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool ::sto/storage]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool")
|
||||||
|
(assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
|
|
|
@ -11,19 +11,19 @@
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
(def ^:private
|
(def ^:private
|
||||||
sql:delete-completed-tasks
|
sql:delete-completed-tasks
|
||||||
"DELETE FROM task WHERE scheduled_at < now() - ?::interval")
|
"DELETE FROM task WHERE scheduled_at < now() - ?::interval")
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::db/pool]))
|
[_ params]
|
||||||
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool"))
|
||||||
|
|
||||||
(defmethod ig/prep-key ::handler
|
(defmethod ig/expand-key ::handler
|
||||||
[_ cfg]
|
[k v]
|
||||||
(assoc cfg ::min-age (cf/get-deletion-delay)))
|
{k (assoc v ::min-age (cf/get-deletion-delay))})
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ {:keys [::db/pool ::min-age] :as cfg}]
|
[_ {:keys [::db/pool ::min-age] :as cfg}]
|
||||||
|
|
|
@ -17,7 +17,6 @@
|
||||||
[app.main :as-alias main]
|
[app.main :as-alias main]
|
||||||
[app.setup :as-alias setup]
|
[app.setup :as-alias setup]
|
||||||
[app.util.json :as json]
|
[app.util.json :as json]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px]))
|
[promesa.exec :as px]))
|
||||||
|
|
||||||
|
@ -205,10 +204,11 @@
|
||||||
;; TASK ENTRY POINT
|
;; TASK ENTRY POINT
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::handler [_]
|
(defmethod ig/assert-key ::handler
|
||||||
(s/keys :req [::http/client
|
[_ params]
|
||||||
::db/pool
|
(assert (http/client? (::http/client params)) "expected a valid http client")
|
||||||
::setup/props]))
|
(assert (db/pool? (::db/pool params)) "expected a valid database pool")
|
||||||
|
(assert (some? (::setup/props params)) "expected setup props to be available"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::handler
|
(defmethod ig/init-key ::handler
|
||||||
[_ {:keys [::db/pool ::setup/props] :as cfg}]
|
[_ {:keys [::db/pool ::setup/props] :as cfg}]
|
||||||
|
|
|
@ -8,6 +8,7 @@
|
||||||
"In-memory cache backed by Caffeine"
|
"In-memory cache backed by Caffeine"
|
||||||
(:refer-clojure :exclude [get])
|
(:refer-clojure :exclude [get])
|
||||||
(:require
|
(:require
|
||||||
|
[app.common.schema :as sm]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[promesa.exec :as px])
|
[promesa.exec :as px])
|
||||||
(:import
|
(:import
|
||||||
|
@ -77,3 +78,9 @@
|
||||||
(defn cache?
|
(defn cache?
|
||||||
[o]
|
[o]
|
||||||
(satisfies? ICache o))
|
(satisfies? ICache o))
|
||||||
|
|
||||||
|
(sm/register!
|
||||||
|
{:type ::cache
|
||||||
|
:pred cache?
|
||||||
|
:type-properties
|
||||||
|
{:title "cache instance"}})
|
||||||
|
|
|
@ -25,15 +25,15 @@
|
||||||
clojure.lang.IPersistentMap
|
clojure.lang.IPersistentMap
|
||||||
clojure.lang.IDeref)
|
clojure.lang.IDeref)
|
||||||
|
|
||||||
(sm/register! ::fs/path
|
(sm/register!
|
||||||
{:type ::fs/path
|
{:type ::fs/path
|
||||||
:pred fs/path?
|
:pred fs/path?
|
||||||
:type-properties
|
:type-properties
|
||||||
{:title "path"
|
{:title "path"
|
||||||
:description "filesystem path"
|
:description "filesystem path"
|
||||||
:error/message "expected a valid fs path instance"
|
:error/message "expected a valid fs path instance"
|
||||||
:error/code "errors.invalid-path"
|
:error/code "errors.invalid-path"
|
||||||
:gen/gen (sg/generator :string)
|
:gen/gen (sg/generator :string)
|
||||||
:decode/string fs/path
|
:decode/string fs/path
|
||||||
::oapi/type "string"
|
::oapi/type "string"
|
||||||
::oapi/format "unix-path"}})
|
::oapi/format "unix-path"}})
|
||||||
|
|
|
@ -370,30 +370,30 @@
|
||||||
(let [p1 (System/nanoTime)]
|
(let [p1 (System/nanoTime)]
|
||||||
#(duration {:nanos (- (System/nanoTime) p1)})))
|
#(duration {:nanos (- (System/nanoTime) p1)})))
|
||||||
|
|
||||||
(sm/register! ::instant
|
(sm/register!
|
||||||
{:type ::instant
|
{:type ::instant
|
||||||
:pred instant?
|
:pred instant?
|
||||||
:type-properties
|
:type-properties
|
||||||
{:error/message "should be an instant"
|
{:error/message "should be an instant"
|
||||||
:title "instant"
|
:title "instant"
|
||||||
:decode/string instant
|
:decode/string instant
|
||||||
:encode/string format-instant
|
:encode/string format-instant
|
||||||
:decode/json instant
|
:decode/json instant
|
||||||
:encode/json format-instant
|
:encode/json format-instant
|
||||||
:gen/gen (tgen/fmap (fn [i] (in-past i)) tgen/pos-int)
|
:gen/gen (tgen/fmap (fn [i] (in-past i)) tgen/pos-int)
|
||||||
::oapi/type "string"
|
::oapi/type "string"
|
||||||
::oapi/format "iso"}})
|
::oapi/format "iso"}})
|
||||||
|
|
||||||
(sm/register! ::duration
|
(sm/register!
|
||||||
{:type :durations
|
{:type ::duration
|
||||||
:pred duration?
|
:pred duration?
|
||||||
:type-properties
|
:type-properties
|
||||||
{:error/message "should be a duration"
|
{:error/message "should be a duration"
|
||||||
:gen/gen (tgen/fmap duration tgen/pos-int)
|
:gen/gen (tgen/fmap duration tgen/pos-int)
|
||||||
:title "duration"
|
:title "duration"
|
||||||
:decode/string duration
|
:decode/string duration
|
||||||
:encode/string format-duration
|
:encode/string format-duration
|
||||||
:decode/json duration
|
:decode/json duration
|
||||||
:encode/json format-duration
|
:encode/json format-duration
|
||||||
::oapi/type "string"
|
::oapi/type "string"
|
||||||
::oapi/format "duration"}})
|
::oapi/format "duration"}})
|
||||||
|
|
|
@ -8,16 +8,13 @@
|
||||||
"Async tasks abstraction (impl)."
|
"Async tasks abstraction (impl)."
|
||||||
(:require
|
(:require
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.data.macros :as dm]
|
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.schema :as sm]
|
[app.common.schema :as sm]
|
||||||
[app.common.spec :as us]
|
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[app.config :as cf]
|
[app.config :as cf]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.metrics :as mtx]
|
[app.metrics :as mtx]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]))
|
[integrant.core :as ig]))
|
||||||
|
|
||||||
|
@ -27,6 +24,9 @@
|
||||||
;; TASKS REGISTRY
|
;; TASKS REGISTRY
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(defprotocol IRegistry
|
||||||
|
(get-task [_ name]))
|
||||||
|
|
||||||
(defn- wrap-with-metrics
|
(defn- wrap-with-metrics
|
||||||
[f metrics tname]
|
[f metrics tname]
|
||||||
(let [labels (into-array String [tname])]
|
(let [labels (into-array String [tname])]
|
||||||
|
@ -40,21 +40,37 @@
|
||||||
:val (inst-ms (tp))
|
:val (inst-ms (tp))
|
||||||
:labels labels})))))))
|
:labels labels})))))))
|
||||||
|
|
||||||
(s/def ::registry (s/map-of ::us/string fn?))
|
(def ^:private schema:tasks
|
||||||
(s/def ::tasks (s/map-of keyword? fn?))
|
[:map-of :keyword ::sm/fn])
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::registry [_]
|
(def ^:private valid-tasks?
|
||||||
(s/keys :req [::mtx/metrics ::tasks]))
|
(sm/validator schema:tasks))
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::registry
|
||||||
|
[_ params]
|
||||||
|
(assert (mtx/metrics? (::mtx/metrics params)) "expected valid metrics instance")
|
||||||
|
(assert (valid-tasks? (::tasks params)) "expected a valid map of tasks"))
|
||||||
|
|
||||||
(defmethod ig/init-key ::registry
|
(defmethod ig/init-key ::registry
|
||||||
[_ {:keys [::mtx/metrics ::tasks]}]
|
[_ {:keys [::mtx/metrics ::tasks]}]
|
||||||
(l/inf :hint "registry initialized" :tasks (count tasks))
|
(l/inf :hint "registry initialized" :tasks (count tasks))
|
||||||
(reduce-kv (fn [registry k f]
|
(let [tasks (reduce-kv (fn [registry k f]
|
||||||
(let [tname (name k)]
|
(let [tname (name k)]
|
||||||
(l/trc :hint "register task" :name tname)
|
(l/trc :hint "register task" :name tname)
|
||||||
(assoc registry tname (wrap-with-metrics f metrics tname))))
|
(assoc registry tname (wrap-with-metrics f metrics tname))))
|
||||||
{}
|
{}
|
||||||
tasks))
|
tasks)]
|
||||||
|
(reify
|
||||||
|
clojure.lang.Counted
|
||||||
|
(count [_] (count tasks))
|
||||||
|
|
||||||
|
IRegistry
|
||||||
|
(get-task [_ name]
|
||||||
|
(get tasks (d/name name))))))
|
||||||
|
|
||||||
|
(sm/register!
|
||||||
|
{:type ::registry
|
||||||
|
:pred #(satisfies? IRegistry %)})
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; SUBMIT API
|
;; SUBMIT API
|
||||||
|
@ -124,5 +140,6 @@
|
||||||
[{:keys [::task ::params] :as cfg}]
|
[{:keys [::task ::params] :as cfg}]
|
||||||
(assert (contains? cfg :app.worker/registry)
|
(assert (contains? cfg :app.worker/registry)
|
||||||
"missing worker registry on `cfg`")
|
"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})))
|
(task-fn {:props params})))
|
||||||
|
|
|
@ -9,11 +9,11 @@
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
|
[app.common.schema :as sm]
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as-alias wrk]
|
[app.worker :as wrk]
|
||||||
[app.worker.runner :refer [get-error-context]]
|
[app.worker.runner :refer [get-error-context]]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.core :as p]
|
[promesa.core :as p]
|
||||||
|
@ -82,7 +82,7 @@
|
||||||
|
|
||||||
(defn- ms-until-valid
|
(defn- ms-until-valid
|
||||||
[cron]
|
[cron]
|
||||||
(s/assert dt/cron? cron)
|
(assert (dt/cron? cron) "expected cron instance")
|
||||||
(let [now (dt/now)
|
(let [now (dt/now)
|
||||||
next (dt/next-valid-instant-from cron now)]
|
next (dt/next-valid-instant-from cron now)]
|
||||||
(dt/diff now next)))
|
(dt/diff now next)))
|
||||||
|
@ -98,21 +98,22 @@
|
||||||
|
|
||||||
(swap! running #(into #{ft} (filter p/pending?) %))))
|
(swap! running #(into #{ft} (filter p/pending?) %))))
|
||||||
|
|
||||||
|
(def ^:private schema:params
|
||||||
|
[:map
|
||||||
|
[::wrk/entries
|
||||||
|
[:vector
|
||||||
|
[:maybe
|
||||||
|
[:map
|
||||||
|
[:cron [:fn dt/cron?]]
|
||||||
|
[:task :keyword]
|
||||||
|
[:props {:optional true} :map]
|
||||||
|
[:id {:optional true} :keyword]]]]]
|
||||||
|
::wrk/registry
|
||||||
|
::db/pool])
|
||||||
|
|
||||||
(s/def ::fn (s/or :var var? :fn fn?))
|
(defmethod ig/assert-key ::wrk/cron
|
||||||
(s/def ::id keyword?)
|
[_ params]
|
||||||
(s/def ::cron dt/cron?)
|
(assert (sm/check schema:params params)))
|
||||||
(s/def ::props (s/nilable map?))
|
|
||||||
(s/def ::task keyword?)
|
|
||||||
|
|
||||||
(s/def ::task-item
|
|
||||||
(s/keys :req-un [::cron ::task]
|
|
||||||
:opt-un [::props ::id]))
|
|
||||||
|
|
||||||
(s/def ::wrk/entries (s/coll-of (s/nilable ::task-item)))
|
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::wrk/cron [_]
|
|
||||||
(s/keys :req [::db/pool ::wrk/entries ::wrk/registry]))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::wrk/cron
|
(defmethod ig/init-key ::wrk/cron
|
||||||
[_ {:keys [::wrk/entries ::wrk/registry ::db/pool] :as cfg}]
|
[_ {:keys [::wrk/entries ::wrk/registry ::db/pool] :as cfg}]
|
||||||
|
@ -129,7 +130,7 @@
|
||||||
(map (fn [item]
|
(map (fn [item]
|
||||||
(update item :task d/name)))
|
(update item :task d/name)))
|
||||||
(map (fn [{:keys [task] :as item}]
|
(map (fn [{:keys [task] :as item}]
|
||||||
(let [f (get registry task)]
|
(let [f (wrk/get-task registry task)]
|
||||||
(when-not f
|
(when-not f
|
||||||
(ex/raise :type :internal
|
(ex/raise :type :internal
|
||||||
:code :task-not-found
|
:code :task-not-found
|
||||||
|
|
|
@ -9,28 +9,36 @@
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.data.macros :as dm]
|
[app.common.data.macros :as dm]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
|
[app.common.schema :as sm]
|
||||||
[app.common.transit :as t]
|
[app.common.transit :as t]
|
||||||
[app.config :as cf]
|
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.metrics :as mtx]
|
[app.metrics :as mtx]
|
||||||
[app.redis :as rds]
|
[app.redis :as rds]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as-alias wrk]
|
[app.worker :as-alias wrk]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px]))
|
[promesa.exec :as px]))
|
||||||
|
|
||||||
(set! *warn-on-reflection* true)
|
(set! *warn-on-reflection* true)
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::wrk/dispatcher [_]
|
(def ^:private schema:dispatcher
|
||||||
(s/keys :req [::mtx/metrics ::db/pool ::rds/redis]))
|
[:map
|
||||||
|
[::wrk/tenant ::sm/text]
|
||||||
|
::mtx/metrics
|
||||||
|
::db/pool
|
||||||
|
::rds/redis])
|
||||||
|
|
||||||
(defmethod ig/prep-key ::wrk/dispatcher
|
(defmethod ig/expand-key ::wrk/dispatcher
|
||||||
|
[k v]
|
||||||
|
{k (-> (d/without-nils v)
|
||||||
|
(assoc ::timeout (dt/duration "10s"))
|
||||||
|
(assoc ::batch-size 100)
|
||||||
|
(assoc ::wait-duration (dt/duration "5s")))})
|
||||||
|
|
||||||
|
(defmethod ig/assert-key ::wrk/dispatcher
|
||||||
[_ cfg]
|
[_ cfg]
|
||||||
(merge {::batch-size 100
|
(assert (sm/check schema:dispatcher cfg)))
|
||||||
::wait-duration (dt/duration "5s")}
|
|
||||||
(d/without-nils cfg)))
|
|
||||||
|
|
||||||
(def ^:private sql:select-next-tasks
|
(def ^:private sql:select-next-tasks
|
||||||
"select id, queue from task as t
|
"select id, queue from task as t
|
||||||
|
@ -42,15 +50,15 @@
|
||||||
for update skip locked")
|
for update skip locked")
|
||||||
|
|
||||||
(defmethod ig/init-key ::wrk/dispatcher
|
(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]
|
(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]))))
|
(seq (db/exec! conn [sql:select-next-tasks prefix batch-size]))))
|
||||||
|
|
||||||
(push-tasks! [conn rconn [queue tasks]]
|
(push-tasks! [conn rconn [queue tasks]]
|
||||||
(let [ids (mapv :id tasks)
|
(let [ids (mapv :id tasks)
|
||||||
key (str/ffmt "taskq:%" queue)
|
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'"
|
sql [(str "update task set status = 'scheduled'"
|
||||||
" where id = ANY(?)")
|
" where id = ANY(?)")
|
||||||
(db/create-array conn "uuid" ids)]]
|
(db/create-array conn "uuid" ids)]]
|
||||||
|
@ -75,17 +83,17 @@
|
||||||
(rds/exception? cause)
|
(rds/exception? cause)
|
||||||
(do
|
(do
|
||||||
(l/wrn :hint "redis exception (will retry in an instant)" :cause cause)
|
(l/wrn :hint "redis exception (will retry in an instant)" :cause cause)
|
||||||
(px/sleep (::rds/timeout rconn)))
|
(px/sleep timeout))
|
||||||
|
|
||||||
(db/sql-exception? cause)
|
(db/sql-exception? cause)
|
||||||
(do
|
(do
|
||||||
(l/wrn :hint "database exception (will retry in an instant)" :cause cause)
|
(l/wrn :hint "database exception (will retry in an instant)" :cause cause)
|
||||||
(px/sleep (::rds/timeout rconn)))
|
(px/sleep timeout))
|
||||||
|
|
||||||
:else
|
:else
|
||||||
(do
|
(do
|
||||||
(l/err :hint "unhandled exception (will retry in an instant)" :cause cause)
|
(l/err :hint "unhandled exception (will retry in an instant)" :cause cause)
|
||||||
(px/sleep (::rds/timeout rconn)))))))
|
(px/sleep timeout))))))
|
||||||
|
|
||||||
(dispatcher []
|
(dispatcher []
|
||||||
(l/inf :hint "started")
|
(l/inf :hint "started")
|
||||||
|
|
|
@ -9,11 +9,10 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.metrics :as mtx]
|
[app.metrics :as mtx]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as-alias wrk]
|
[app.worker :as-alias wrk]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px])
|
[promesa.exec :as px])
|
||||||
(:import
|
(:import
|
||||||
|
@ -21,15 +20,17 @@
|
||||||
|
|
||||||
(set! *warn-on-reflection* true)
|
(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
|
;; EXECUTOR
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(defmethod ig/pre-init-spec ::wrk/executor [_]
|
|
||||||
(s/keys :req []))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::wrk/executor
|
(defmethod ig/init-key ::wrk/executor
|
||||||
[_ _]
|
[_ _]
|
||||||
(let [factory (px/thread-factory :prefix "penpot/default/")
|
(let [factory (px/thread-factory :prefix "penpot/default/")
|
||||||
|
@ -51,15 +52,10 @@
|
||||||
:running (.getActiveCount ^ThreadPoolExecutor executor)
|
:running (.getActiveCount ^ThreadPoolExecutor executor)
|
||||||
:completed (.getCompletedTaskCount ^ThreadPoolExecutor executor)})
|
:completed (.getCompletedTaskCount ^ThreadPoolExecutor executor)})
|
||||||
|
|
||||||
(s/def ::name ::us/keyword)
|
(defmethod ig/expand-key ::wrk/monitor
|
||||||
|
[k v]
|
||||||
(defmethod ig/pre-init-spec ::wrk/monitor [_]
|
{k (-> (d/without-nils v)
|
||||||
(s/keys :req [::wrk/name ::wrk/executor ::mtx/metrics]))
|
(assoc ::interval (dt/duration "2s")))})
|
||||||
|
|
||||||
(defmethod ig/prep-key ::wrk/monitor
|
|
||||||
[_ cfg]
|
|
||||||
(merge {::interval (dt/duration "2s")}
|
|
||||||
(d/without-nils cfg)))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::wrk/monitor
|
(defmethod ig/init-key ::wrk/monitor
|
||||||
[_ {:keys [::wrk/executor ::mtx/metrics ::interval ::wrk/name]}]
|
[_ {:keys [::wrk/executor ::mtx/metrics ::interval ::wrk/name]}]
|
||||||
|
|
|
@ -11,14 +11,13 @@
|
||||||
[app.common.data.macros :as dm]
|
[app.common.data.macros :as dm]
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.logging :as l]
|
[app.common.logging :as l]
|
||||||
|
[app.common.schema :as sm]
|
||||||
[app.common.transit :as t]
|
[app.common.transit :as t]
|
||||||
[app.config :as cf]
|
|
||||||
[app.db :as db]
|
[app.db :as db]
|
||||||
[app.metrics :as mtx]
|
[app.metrics :as mtx]
|
||||||
[app.redis :as rds]
|
[app.redis :as rds]
|
||||||
[app.util.time :as dt]
|
[app.util.time :as dt]
|
||||||
[app.worker :as-alias wrk]
|
[app.worker :as wrk]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[integrant.core :as ig]
|
[integrant.core :as ig]
|
||||||
[promesa.exec :as px]))
|
[promesa.exec :as px]))
|
||||||
|
@ -51,7 +50,7 @@
|
||||||
:runner-id id
|
:runner-id id
|
||||||
:retry (:retry-num task))
|
:retry (:retry-num task))
|
||||||
(let [tpoint (dt/tpoint)
|
(let [tpoint (dt/tpoint)
|
||||||
task-fn (get registry (:name task))
|
task-fn (wrk/get-task registry (:name task))
|
||||||
result (if task-fn
|
result (if task-fn
|
||||||
(task-fn task)
|
(task-fn task)
|
||||||
{:status :completed :task task})
|
{:status :completed :task task})
|
||||||
|
@ -92,7 +91,7 @@
|
||||||
{:status :retry :task task :error cause})))))))
|
{:status :retry :task task :error cause})))))))
|
||||||
|
|
||||||
(defn- run-task!
|
(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)]
|
(loop [task (get-task cfg task-id)]
|
||||||
(cond
|
(cond
|
||||||
(ex/exception? task)
|
(ex/exception? task)
|
||||||
|
@ -102,13 +101,13 @@
|
||||||
(l/wrn :hint "connection error on retrieving task from database (retrying in some instants)"
|
(l/wrn :hint "connection error on retrieving task from database (retrying in some instants)"
|
||||||
:id id
|
:id id
|
||||||
:cause task)
|
:cause task)
|
||||||
(px/sleep (::rds/timeout rconn))
|
(px/sleep timeout)
|
||||||
(recur (get-task cfg task-id)))
|
(recur (get-task cfg task-id)))
|
||||||
(do
|
(do
|
||||||
(l/err :hint "unhandled exception on retrieving task from database (retrying in some instants)"
|
(l/err :hint "unhandled exception on retrieving task from database (retrying in some instants)"
|
||||||
:id id
|
:id id
|
||||||
:cause task)
|
:cause task)
|
||||||
(px/sleep (::rds/timeout rconn))
|
(px/sleep timeout)
|
||||||
(recur (get-task cfg task-id))))
|
(recur (get-task cfg task-id))))
|
||||||
|
|
||||||
(nil? task)
|
(nil? task)
|
||||||
|
@ -182,17 +181,17 @@
|
||||||
(do
|
(do
|
||||||
(l/wrn :hint "database exeption on processing task result (retrying in some instants)"
|
(l/wrn :hint "database exeption on processing task result (retrying in some instants)"
|
||||||
:cause cause)
|
:cause cause)
|
||||||
(px/sleep (::rds/timeout rconn))
|
(px/sleep timeout)
|
||||||
(recur result))
|
(recur result))
|
||||||
(do
|
(do
|
||||||
(l/err :hint "unhandled exception on processing task result (retrying in some instants)"
|
(l/err :hint "unhandled exception on processing task result (retrying in some instants)"
|
||||||
:cause cause)
|
:cause cause)
|
||||||
(px/sleep (::rds/timeout rconn))
|
(px/sleep timeout)
|
||||||
(recur result))))))]
|
(recur result))))))]
|
||||||
|
|
||||||
(try
|
(try
|
||||||
(let [queue (str/ffmt "taskq:%" queue)
|
(let [key (str/ffmt "taskq:%" queue)
|
||||||
[_ payload] (rds/blpop! rconn timeout queue)]
|
[_ payload] (rds/blpop rconn timeout [key])]
|
||||||
(some-> payload
|
(some-> payload
|
||||||
decode-payload
|
decode-payload
|
||||||
run-task-loop))
|
run-task-loop))
|
||||||
|
@ -211,16 +210,15 @@
|
||||||
(l/err :hint "unhandled exception" :cause cause))))))
|
(l/err :hint "unhandled exception" :cause cause))))))
|
||||||
|
|
||||||
(defn- start-thread!
|
(defn- start-thread!
|
||||||
[{:keys [::rds/redis ::id ::queue] :as cfg}]
|
[{:keys [::rds/redis ::id ::queue ::wrk/tenant] :as cfg}]
|
||||||
(px/thread
|
(px/thread
|
||||||
{:name (format "penpot/worker/runner:%s" id)}
|
{:name (format "penpot/worker/runner:%s" id)}
|
||||||
(l/inf :hint "started" :id id :queue queue)
|
(l/inf :hint "started" :id id :queue queue)
|
||||||
(try
|
(try
|
||||||
(dm/with-open [rconn (rds/connect redis)]
|
(dm/with-open [rconn (rds/connect redis)]
|
||||||
(let [tenant (cf/get :tenant "main")
|
(let [cfg (-> cfg
|
||||||
cfg (-> cfg
|
|
||||||
(assoc ::queue (str/ffmt "%:%" tenant queue))
|
|
||||||
(assoc ::rds/rconn rconn)
|
(assoc ::rds/rconn rconn)
|
||||||
|
(assoc ::queue (str/ffmt "%:%" tenant queue))
|
||||||
(assoc ::timeout (dt/duration "5s")))]
|
(assoc ::timeout (dt/duration "5s")))]
|
||||||
(loop []
|
(loop []
|
||||||
(when (px/interrupted?)
|
(when (px/interrupted?)
|
||||||
|
@ -243,20 +241,23 @@
|
||||||
:id id
|
:id id
|
||||||
:queue queue)))))
|
: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 [_]
|
(defmethod ig/assert-key ::wrk/runner
|
||||||
(s/keys :req [::wrk/parallelism
|
[_ params]
|
||||||
::mtx/metrics
|
(assert (sm/check schema:params params)))
|
||||||
::db/pool
|
|
||||||
::rds/redis
|
|
||||||
::wrk/queue
|
|
||||||
::wrk/registry]))
|
|
||||||
|
|
||||||
(defmethod ig/prep-key ::wrk/runner
|
(defmethod ig/expand-key ::wrk/runner
|
||||||
[_ cfg]
|
[k v]
|
||||||
(merge {::wrk/parallelism 1}
|
{k (merge {::wrk/parallelism 1} (d/without-nils v))})
|
||||||
(d/without-nils cfg)))
|
|
||||||
|
|
||||||
(defmethod ig/init-key ::wrk/runner
|
(defmethod ig/init-key ::wrk/runner
|
||||||
[_ {:keys [::db/pool ::wrk/queue ::wrk/parallelism] :as cfg}]
|
[_ {:keys [::db/pool ::wrk/queue ::wrk/parallelism] :as cfg}]
|
||||||
|
|
|
@ -123,7 +123,7 @@
|
||||||
[:app.main/default :app.worker/runner]
|
[:app.main/default :app.worker/runner]
|
||||||
[:app.main/webhook :app.worker/runner]))
|
[:app.main/webhook :app.worker/runner]))
|
||||||
_ (ig/load-namespaces system)
|
_ (ig/load-namespaces system)
|
||||||
system (-> (ig/prep system)
|
system (-> (ig/expand system)
|
||||||
(ig/init))]
|
(ig/init))]
|
||||||
(try
|
(try
|
||||||
(binding [*system* system
|
(binding [*system* system
|
||||||
|
@ -400,7 +400,11 @@
|
||||||
(db/tx-run! *system* (fn [{:keys [::db/conn] :as cfg}]
|
(db/tx-run! *system* (fn [{:keys [::db/conn] :as cfg}]
|
||||||
(let [tasks (->> (db/exec! conn [sql:pending-tasks])
|
(let [tasks (->> (db/exec! conn [sql:pending-tasks])
|
||||||
(map #'app.worker.runner/decode-task-row))]
|
(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
|
;; --- UTILS
|
||||||
|
|
||||||
|
|
|
@ -27,12 +27,8 @@
|
||||||
(defn configure-storage-backend
|
(defn configure-storage-backend
|
||||||
"Given storage map, returns a storage configured with the appropriate
|
"Given storage map, returns a storage configured with the appropriate
|
||||||
backend for assets."
|
backend for assets."
|
||||||
([storage]
|
[storage]
|
||||||
(assoc storage ::sto/backend :assets-fs))
|
(assoc storage ::sto/backend :fs))
|
||||||
([storage conn]
|
|
||||||
(-> storage
|
|
||||||
(assoc ::db/pool-or-conn conn)
|
|
||||||
(assoc ::sto/backend :assets-fs))))
|
|
||||||
|
|
||||||
(t/deftest put-and-retrieve-object
|
(t/deftest put-and-retrieve-object
|
||||||
(let [storage (-> (:app.storage/storage th/*system*)
|
(let [storage (-> (:app.storage/storage th/*system*)
|
||||||
|
@ -46,7 +42,7 @@
|
||||||
(t/is (fs/path? (sto/get-object-path storage object)))
|
(t/is (fs/path? (sto/get-object-path storage object)))
|
||||||
|
|
||||||
(t/is (nil? (:expired-at 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 (= "data" (:other (meta object))))
|
||||||
(t/is (= "text/plain" (:content-type (meta object))))
|
(t/is (= "text/plain" (:content-type (meta object))))
|
||||||
(t/is (= "content" (slurp (sto/get-object-data storage object))))
|
(t/is (= "content" (slurp (sto/get-object-data storage object))))
|
||||||
|
@ -91,12 +87,13 @@
|
||||||
;; marked as deleted/expired.
|
;; marked as deleted/expired.
|
||||||
(t/is (nil? (sto/get-object storage (:id object))))))
|
(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*)
|
(let [storage (-> (:app.storage/storage th/*system*)
|
||||||
(configure-storage-backend))
|
(configure-storage-backend))
|
||||||
content1 (sto/content "content1")
|
content1 (sto/content "content1")
|
||||||
content2 (sto/content "content2")
|
content2 (sto/content "content2")
|
||||||
content3 (sto/content "content3")
|
content3 (sto/content "content3")
|
||||||
|
|
||||||
object1 (sto/put-object! storage {::sto/content content1
|
object1 (sto/put-object! storage {::sto/content content1
|
||||||
::sto/expired-at (dt/now)
|
::sto/expired-at (dt/now)
|
||||||
:content-type "text/plain"})
|
:content-type "text/plain"})
|
||||||
|
@ -116,7 +113,7 @@
|
||||||
(let [res (th/db-exec-one! ["select count(*) from storage_object;"])]
|
(let [res (th/db-exec-one! ["select count(*) from storage_object;"])]
|
||||||
(t/is (= 2 (:count res))))))
|
(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*)
|
(let [storage (-> (:app.storage/storage th/*system*)
|
||||||
(configure-storage-backend))
|
(configure-storage-backend))
|
||||||
prof (th/create-profile* 1)
|
prof (th/create-profile* 1)
|
||||||
|
@ -186,7 +183,7 @@
|
||||||
(t/is (= 0 (:count res)))))))
|
(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*)
|
(let [storage (-> (:app.storage/storage th/*system*)
|
||||||
(configure-storage-backend))
|
(configure-storage-backend))
|
||||||
prof (th/create-profile* 1 {:is-active true})
|
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"])]
|
(let [res (th/db-exec-one! ["select count(*) from storage_object where deleted_at is not null"])]
|
||||||
(t/is (= 3 (:count res))))))))
|
(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*)
|
(let [storage (-> (:app.storage/storage th/*system*)
|
||||||
(configure-storage-backend))
|
(configure-storage-backend))
|
||||||
prof (th/create-profile* 1)
|
prof (th/create-profile* 1)
|
||||||
|
|
|
@ -25,7 +25,7 @@
|
||||||
com.cognitect/transit-clj {:mvn/version "1.0.333"}
|
com.cognitect/transit-clj {:mvn/version "1.0.333"}
|
||||||
com.cognitect/transit-cljs {:mvn/version "0.8.280"}
|
com.cognitect/transit-cljs {:mvn/version "0.8.280"}
|
||||||
java-http-clj/java-http-clj {:mvn/version "0.4.3"}
|
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/tubax {:mvn/version "2021.05.20-0"}
|
||||||
funcool/cuerdas {:mvn/version "2023.11.09-407"}
|
funcool/cuerdas {:mvn/version "2023.11.09-407"}
|
||||||
|
|
|
@ -89,12 +89,13 @@
|
||||||
"text-editor/v2"}
|
"text-editor/v2"}
|
||||||
(into frontend-only-features)))
|
(into frontend-only-features)))
|
||||||
|
|
||||||
(sm/register! ::features
|
(sm/register!
|
||||||
[:schema
|
^{::sm/type ::features}
|
||||||
{:title "FileFeatures"
|
[:schema
|
||||||
::smdj/inline true
|
{:title "FileFeatures"
|
||||||
:gen/gen (smg/subseq supported-features)}
|
::smdj/inline true
|
||||||
[::sm/set :string]])
|
:gen/gen (smg/subseq supported-features)}
|
||||||
|
[::sm/set :string]])
|
||||||
|
|
||||||
(defn- flag->feature
|
(defn- flag->feature
|
||||||
"Translate a flag to a feature name"
|
"Translate a flag to a feature name"
|
||||||
|
|
|
@ -25,14 +25,15 @@
|
||||||
|
|
||||||
;; Auxiliary functions to help create a set of changes (undo + redo)
|
;; Auxiliary functions to help create a set of changes (undo + redo)
|
||||||
|
|
||||||
(sm/register! ::changes
|
(sm/register!
|
||||||
[:map {:title "changes"}
|
^{::sm/type ::changes}
|
||||||
[:redo-changes vector?]
|
[:map {:title "changes"}
|
||||||
[:undo-changes seq?]
|
[:redo-changes vector?]
|
||||||
[:origin {:optional true} any?]
|
[:undo-changes seq?]
|
||||||
[:save-undo? {:optional true} boolean?]
|
[:origin {:optional true} any?]
|
||||||
[:stack-undo? {:optional true} boolean?]
|
[:save-undo? {:optional true} boolean?]
|
||||||
[:undo-group {:optional true} any?]])
|
[:stack-undo? {:optional true} boolean?]
|
||||||
|
[:undo-group {:optional true} any?]])
|
||||||
|
|
||||||
(def check-changes!
|
(def check-changes!
|
||||||
(sm/check-fn ::changes))
|
(sm/check-fn ::changes))
|
||||||
|
|
|
@ -87,7 +87,7 @@
|
||||||
|
|
||||||
;; FIXME: make like matrix
|
;; FIXME: make like matrix
|
||||||
(def schema:point
|
(def schema:point
|
||||||
{:type :map
|
{:type ::point
|
||||||
:pred valid-point?
|
:pred valid-point?
|
||||||
:type-properties
|
:type-properties
|
||||||
{:title "point"
|
{:title "point"
|
||||||
|
@ -102,7 +102,7 @@
|
||||||
:encode/json point->json
|
:encode/json point->json
|
||||||
:encode/string point->str}})
|
:encode/string point->str}})
|
||||||
|
|
||||||
(sm/register! ::point schema:point)
|
(sm/register! schema:point)
|
||||||
|
|
||||||
(defn point-like?
|
(defn point-like?
|
||||||
[{:keys [x y] :as v}]
|
[{:keys [x y] :as v}]
|
||||||
|
|
|
@ -48,9 +48,8 @@
|
||||||
[app.common.data :as d]
|
[app.common.data :as d]
|
||||||
[app.common.exceptions :as ex]
|
[app.common.exceptions :as ex]
|
||||||
[app.common.pprint :as pp]
|
[app.common.pprint :as pp]
|
||||||
[app.common.spec :as us]
|
[app.common.schema :as sm]
|
||||||
[app.common.uuid :as uuid]
|
[app.common.uuid :as uuid]
|
||||||
[clojure.spec.alpha :as s]
|
|
||||||
[cuerdas.core :as str]
|
[cuerdas.core :as str]
|
||||||
[promesa.exec :as px]
|
[promesa.exec :as px]
|
||||||
[promesa.util :as pu])
|
[promesa.util :as pu])
|
||||||
|
@ -203,17 +202,19 @@
|
||||||
(map vec)
|
(map vec)
|
||||||
(remove (fn [[k _]] (contains? reserved-props k)))))
|
(remove (fn [[k _]] (contains? reserved-props k)))))
|
||||||
|
|
||||||
(s/def ::id ::us/uuid)
|
(def ^:private schema:record
|
||||||
(s/def ::props any? #_d/ordered-map?)
|
[:map
|
||||||
(s/def ::context (s/nilable (s/map-of keyword? any?)))
|
[::id ::sm/uuid]
|
||||||
(s/def ::level #{:trace :debug :info :warn :error :fatal})
|
[::props :any]
|
||||||
(s/def ::logger string?)
|
[::logger :string]
|
||||||
(s/def ::timestamp ::us/integer)
|
[::timestamp ::sm/int]
|
||||||
(s/def ::cause (s/nilable ex/exception?))
|
[::level [:enum :trace :debug :info :warn :error :fatal]]
|
||||||
(s/def ::message delay?)
|
[::message [:fn delay?]]
|
||||||
(s/def ::record
|
[::cause {:optional true} [:maybe [:fn ex/exception?]]]
|
||||||
(s/keys :req [::id ::props ::logger ::level]
|
[::context {:optional true} [:maybe [:map-of :keyword :any]]]])
|
||||||
:opt [::cause ::context]))
|
|
||||||
|
(def valid-record?
|
||||||
|
(sm/validator schema:record))
|
||||||
|
|
||||||
(defn current-timestamp
|
(defn current-timestamp
|
||||||
[]
|
[]
|
||||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -27,17 +27,18 @@
|
||||||
(def valid-container-types
|
(def valid-container-types
|
||||||
#{:page :component})
|
#{:page :component})
|
||||||
|
|
||||||
(sm/register! ::container
|
(sm/register!
|
||||||
[:map
|
^{::sm/type ::container}
|
||||||
[:id ::sm/uuid]
|
[:map
|
||||||
[:type {:optional true}
|
[:id ::sm/uuid]
|
||||||
[::sm/one-of valid-container-types]]
|
[:type {:optional true}
|
||||||
[:name :string]
|
[::sm/one-of valid-container-types]]
|
||||||
[:path {:optional true} [:maybe :string]]
|
[:name :string]
|
||||||
[:modified-at {:optional true} ::sm/inst]
|
[:path {:optional true} [:maybe :string]]
|
||||||
[:objects {:optional true}
|
[:modified-at {:optional true} ::sm/inst]
|
||||||
[:map-of {:gen/max 10} ::sm/uuid :map]]
|
[:objects {:optional true}
|
||||||
[:plugin-data {:optional true} ::ctpg/plugin-data]])
|
[:map-of {:gen/max 10} ::sm/uuid :map]]
|
||||||
|
[:plugin-data {:optional true} ::ctpg/plugin-data]])
|
||||||
|
|
||||||
(def check-container!
|
(def check-container!
|
||||||
(sm/check-fn ::container))
|
(sm/check-fn ::container))
|
||||||
|
|
|
@ -26,9 +26,10 @@
|
||||||
;; SCHEMA
|
;; SCHEMA
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(sm/register! ::blur
|
(sm/register!
|
||||||
[:map {:title "Blur"}
|
^{::sm/type ::blur}
|
||||||
[:id ::sm/uuid]
|
[:map {:title "Blur"}
|
||||||
[:type [:= :layer-blur]]
|
[:id ::sm/uuid]
|
||||||
[:value ::sm/safe-number]
|
[:type [:= :layer-blur]]
|
||||||
[:hidden :boolean]])
|
[:value ::sm/safe-number]
|
||||||
|
[:hidden :boolean]])
|
||||||
|
|
|
@ -86,35 +86,36 @@
|
||||||
:layout-item-absolute
|
:layout-item-absolute
|
||||||
:layout-item-z-index])
|
:layout-item-z-index])
|
||||||
|
|
||||||
(sm/register! ::layout-attrs
|
(sm/register!
|
||||||
[:map {:title "LayoutAttrs"}
|
^{::sm/type ::layout-attrs}
|
||||||
[:layout {:optional true} [::sm/one-of layout-types]]
|
[:map {:title "LayoutAttrs"}
|
||||||
[:layout-flex-dir {:optional true} [::sm/one-of flex-direction-types]]
|
[:layout {:optional true} [::sm/one-of layout-types]]
|
||||||
[:layout-gap {:optional true}
|
[:layout-flex-dir {:optional true} [::sm/one-of flex-direction-types]]
|
||||||
[:map
|
[:layout-gap {:optional true}
|
||||||
[:row-gap {:optional true} ::sm/safe-number]
|
[:map
|
||||||
[:column-gap {:optional true} ::sm/safe-number]]]
|
[:row-gap {:optional true} ::sm/safe-number]
|
||||||
[:layout-gap-type {:optional true} [::sm/one-of gap-types]]
|
[:column-gap {:optional true} ::sm/safe-number]]]
|
||||||
[:layout-wrap-type {:optional true} [::sm/one-of wrap-types]]
|
[:layout-gap-type {:optional true} [::sm/one-of gap-types]]
|
||||||
[:layout-padding-type {:optional true} [::sm/one-of padding-type]]
|
[:layout-wrap-type {:optional true} [::sm/one-of wrap-types]]
|
||||||
[:layout-padding {:optional true}
|
[:layout-padding-type {:optional true} [::sm/one-of padding-type]]
|
||||||
[:map
|
[:layout-padding {:optional true}
|
||||||
[:p1 ::sm/safe-number]
|
[:map
|
||||||
[:p2 ::sm/safe-number]
|
[:p1 ::sm/safe-number]
|
||||||
[:p3 ::sm/safe-number]
|
[:p2 ::sm/safe-number]
|
||||||
[:p4 ::sm/safe-number]]]
|
[:p3 ::sm/safe-number]
|
||||||
[:layout-justify-content {:optional true} [::sm/one-of justify-content-types]]
|
[:p4 ::sm/safe-number]]]
|
||||||
[:layout-justify-items {:optional true} [::sm/one-of justify-items-types]]
|
[:layout-justify-content {:optional true} [::sm/one-of justify-content-types]]
|
||||||
[:layout-align-content {:optional true} [::sm/one-of align-content-types]]
|
[:layout-justify-items {:optional true} [::sm/one-of justify-items-types]]
|
||||||
[:layout-align-items {:optional true} [::sm/one-of align-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-dir {:optional true} [::sm/one-of grid-direction-types]]
|
||||||
[:layout-grid-rows {:optional true}
|
[:layout-grid-rows {:optional true}
|
||||||
[:vector {:gen/max 2} ::grid-track]]
|
[:vector {:gen/max 2} ::grid-track]]
|
||||||
[:layout-grid-columns {:optional true}
|
[:layout-grid-columns {:optional true}
|
||||||
[:vector {:gen/max 2} ::grid-track]]
|
[:vector {:gen/max 2} ::grid-track]]
|
||||||
[:layout-grid-cells {:optional true}
|
[:layout-grid-cells {:optional true}
|
||||||
[:map-of {:gen/max 5} ::sm/uuid ::grid-cell]]])
|
[:map-of {:gen/max 5} ::sm/uuid ::grid-cell]]])
|
||||||
|
|
||||||
;; Grid types
|
;; Grid types
|
||||||
(def grid-track-types
|
(def grid-track-types
|
||||||
|
@ -129,24 +130,26 @@
|
||||||
(def grid-cell-justify-self-types
|
(def grid-cell-justify-self-types
|
||||||
#{:auto :start :center :end :stretch})
|
#{:auto :start :center :end :stretch})
|
||||||
|
|
||||||
(sm/register! ::grid-cell
|
(sm/register!
|
||||||
[:map {:title "GridCell"}
|
^{::sm/type ::grid-cell}
|
||||||
[:id ::sm/uuid]
|
[:map {:title "GridCell"}
|
||||||
[:area-name {:optional true} :string]
|
[:id ::sm/uuid]
|
||||||
[:row ::sm/safe-int]
|
[:area-name {:optional true} :string]
|
||||||
[:row-span ::sm/safe-int]
|
[:row ::sm/safe-int]
|
||||||
[:column ::sm/safe-int]
|
[:row-span ::sm/safe-int]
|
||||||
[:column-span ::sm/safe-int]
|
[:column ::sm/safe-int]
|
||||||
[:position {:optional true} [::sm/one-of grid-position-types]]
|
[:column-span ::sm/safe-int]
|
||||||
[:align-self {:optional true} [::sm/one-of grid-cell-align-self-types]]
|
[:position {:optional true} [::sm/one-of grid-position-types]]
|
||||||
[:justify-self {:optional true} [::sm/one-of grid-cell-justify-self-types]]
|
[:align-self {:optional true} [::sm/one-of grid-cell-align-self-types]]
|
||||||
[:shapes
|
[:justify-self {:optional true} [::sm/one-of grid-cell-justify-self-types]]
|
||||||
[:vector {:gen/max 1} ::sm/uuid]]])
|
[:shapes
|
||||||
|
[:vector {:gen/max 1} ::sm/uuid]]])
|
||||||
|
|
||||||
(sm/register! ::grid-track
|
(sm/register!
|
||||||
[:map {:title "GridTrack"}
|
^{::sm/type ::grid-track}
|
||||||
[:type [::sm/one-of grid-track-types]]
|
[:map {:title "GridTrack"}
|
||||||
[:value {:optional true} [:maybe ::sm/safe-number]]])
|
[:type [::sm/one-of grid-track-types]]
|
||||||
|
[:value {:optional true} [:maybe ::sm/safe-number]]])
|
||||||
|
|
||||||
(def check-grid-track!
|
(def check-grid-track!
|
||||||
(sm/check-fn ::grid-track))
|
(sm/check-fn ::grid-track))
|
||||||
|
@ -165,24 +168,25 @@
|
||||||
(def item-align-self-types
|
(def item-align-self-types
|
||||||
#{:start :end :center :stretch})
|
#{:start :end :center :stretch})
|
||||||
|
|
||||||
(sm/register! ::layout-child-attrs
|
(sm/register!
|
||||||
[:map {:title "LayoutChildAttrs"}
|
^{::sm/type ::layout-child-attrs}
|
||||||
[:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
|
[:map {:title "LayoutChildAttrs"}
|
||||||
[:layout-item-margin {:optional true}
|
[:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
|
||||||
[:map
|
[:layout-item-margin {:optional true}
|
||||||
[:m1 {:optional true} ::sm/safe-number]
|
[:map
|
||||||
[:m2 {:optional true} ::sm/safe-number]
|
[:m1 {:optional true} ::sm/safe-number]
|
||||||
[:m3 {:optional true} ::sm/safe-number]
|
[:m2 {:optional true} ::sm/safe-number]
|
||||||
[:m4 {:optional true} ::sm/safe-number]]]
|
[:m3 {:optional true} ::sm/safe-number]
|
||||||
[:layout-item-max-h {:optional true} ::sm/safe-number]
|
[:m4 {:optional true} ::sm/safe-number]]]
|
||||||
[:layout-item-min-h {:optional true} ::sm/safe-number]
|
[:layout-item-max-h {:optional true} ::sm/safe-number]
|
||||||
[:layout-item-max-w {:optional true} ::sm/safe-number]
|
[:layout-item-min-h {:optional true} ::sm/safe-number]
|
||||||
[:layout-item-min-w {:optional true} ::sm/safe-number]
|
[:layout-item-max-w {:optional true} ::sm/safe-number]
|
||||||
[:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
|
[:layout-item-min-w {:optional true} ::sm/safe-number]
|
||||||
[:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
|
[:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
|
||||||
[:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
|
[:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
|
||||||
[:layout-item-absolute {:optional true} :boolean]
|
[:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
|
||||||
[:layout-item-z-index {:optional true} ::sm/safe-number]])
|
[:layout-item-absolute {:optional true} :boolean]
|
||||||
|
[:layout-item-z-index {:optional true} ::sm/safe-number]])
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; SCHEMAS
|
;; SCHEMAS
|
||||||
|
@ -191,8 +195,7 @@
|
||||||
(def valid-layouts
|
(def valid-layouts
|
||||||
#{:flex :grid})
|
#{:flex :grid})
|
||||||
|
|
||||||
(sm/register! ::layout
|
(sm/register! ::layout [::sm/one-of valid-layouts])
|
||||||
[::sm/one-of valid-layouts])
|
|
||||||
|
|
||||||
(defn flex-layout?
|
(defn flex-layout?
|
||||||
([objects id]
|
([objects id]
|
||||||
|
|
|
@ -16,68 +16,70 @@
|
||||||
|
|
||||||
(def node-types #{"root" "paragraph-set" "paragraph"})
|
(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
|
[:map
|
||||||
[:type [:= "root"]]
|
[:x ::sm/safe-number]
|
||||||
[:key {:optional true} :string]
|
[:y ::sm/safe-number]
|
||||||
[:children
|
[:width ::sm/safe-number]
|
||||||
{:optional true}
|
[:height ::sm/safe-number]
|
||||||
[:maybe
|
[:fills [:vector {:gen/max 2} ::shape/fill]]
|
||||||
[:vector {:min 1 :gen/max 2 :gen/min 1}
|
[:font-family {:optional true} :string]
|
||||||
[:map
|
[:font-size {:optional true} :string]
|
||||||
[:type [:= "paragraph-set"]]
|
[:font-style {:optional true} :string]
|
||||||
[:key {:optional true} :string]
|
[:font-weight {:optional true} :string]
|
||||||
[:children
|
[:rtl {:optional true} :boolean]
|
||||||
[:vector {:min 1 :gen/max 2 :gen/min 1}
|
[:text {:optional true} :string]
|
||||||
[:map
|
[:text-decoration {:optional true} :string]
|
||||||
[:type [:= "paragraph"]]
|
[:text-transform {:optional true} :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]]
|
|
||||||
[: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]]])
|
|
||||||
|
|
||||||
|
|
|
@ -64,89 +64,102 @@
|
||||||
(string? n))
|
(string? n))
|
||||||
|
|
||||||
;; TODO Move this to tokens-lib
|
;; TODO Move this to tokens-lib
|
||||||
(sm/register! ::token
|
(sm/register!
|
||||||
[:map {:title "Token"}
|
^{::sm/type ::token}
|
||||||
[:name token-name-ref]
|
[:map {:title "Token"}
|
||||||
[:type [::sm/one-of token-types]]
|
[:name token-name-ref]
|
||||||
[:value :any]
|
[:type [::sm/one-of token-types]]
|
||||||
[:description {:optional true} [:maybe :string]]
|
[:value :any]
|
||||||
[:modified-at {:optional true} ::sm/inst]])
|
[:description {:optional true} [:maybe :string]]
|
||||||
|
[:modified-at {:optional true} ::sm/inst]])
|
||||||
|
|
||||||
(sm/register! ::color
|
(sm/register!
|
||||||
[:map
|
^{::sm/type ::color}
|
||||||
[:fill {:optional true} token-name-ref]
|
[:map
|
||||||
[:stroke-color {:optional true} token-name-ref]])
|
[:fill {:optional true} token-name-ref]
|
||||||
|
[:stroke-color {:optional true} token-name-ref]])
|
||||||
|
|
||||||
(def color-keys (schema-keys ::color))
|
(def color-keys (schema-keys ::color))
|
||||||
|
|
||||||
(sm/register! ::border-radius
|
(sm/register!
|
||||||
[:map
|
^{::sm/type ::border-radius}
|
||||||
[:rx {:optional true} token-name-ref]
|
[:map
|
||||||
[:ry {:optional true} token-name-ref]
|
[:rx {:optional true} token-name-ref]
|
||||||
[:r1 {:optional true} token-name-ref]
|
[:ry {:optional true} token-name-ref]
|
||||||
[:r2 {:optional true} token-name-ref]
|
[:r1 {:optional true} token-name-ref]
|
||||||
[:r3 {:optional true} token-name-ref]
|
[:r2 {:optional true} token-name-ref]
|
||||||
[:r4 {: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))
|
(def border-radius-keys (schema-keys ::border-radius))
|
||||||
|
|
||||||
(sm/register! ::stroke-width
|
(sm/register!
|
||||||
[:map
|
^{::sm/type ::stroke-width}
|
||||||
[:stroke-width {:optional true} token-name-ref]])
|
[:map
|
||||||
|
[:stroke-width {:optional true} token-name-ref]])
|
||||||
|
|
||||||
(def stroke-width-keys (schema-keys ::stroke-width))
|
(def stroke-width-keys (schema-keys ::stroke-width))
|
||||||
|
|
||||||
(sm/register! ::sizing
|
(sm/register!
|
||||||
[:map
|
^{::sm/type ::sizing}
|
||||||
[:width {:optional true} token-name-ref]
|
[:map
|
||||||
[:height {:optional true} token-name-ref]
|
[:width {:optional true} token-name-ref]
|
||||||
[:layout-item-min-w {:optional true} token-name-ref]
|
[:height {:optional true} token-name-ref]
|
||||||
[:layout-item-max-w {:optional true} token-name-ref]
|
[:layout-item-min-w {:optional true} token-name-ref]
|
||||||
[:layout-item-min-h {:optional true} token-name-ref]
|
[:layout-item-max-w {:optional true} token-name-ref]
|
||||||
[:layout-item-max-h {: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))
|
(def sizing-keys (schema-keys ::sizing))
|
||||||
|
|
||||||
(sm/register! ::opacity
|
(sm/register!
|
||||||
[:map
|
^{::sm/type ::opacity}
|
||||||
[:opacity {:optional true} token-name-ref]])
|
[:map
|
||||||
|
[:opacity {:optional true} token-name-ref]])
|
||||||
|
|
||||||
(def opacity-keys (schema-keys ::opacity))
|
(def opacity-keys (schema-keys ::opacity))
|
||||||
|
|
||||||
(sm/register! ::spacing
|
(sm/register!
|
||||||
[:map
|
^{::sm/type ::spacing}
|
||||||
[:row-gap {:optional true} token-name-ref]
|
[:map
|
||||||
[:column-gap {:optional true} token-name-ref]
|
[:row-gap {:optional true} token-name-ref]
|
||||||
[:p1 {:optional true} token-name-ref]
|
[:column-gap {:optional true} token-name-ref]
|
||||||
[:p2 {:optional true} token-name-ref]
|
[:p1 {:optional true} token-name-ref]
|
||||||
[:p3 {:optional true} token-name-ref]
|
[:p2 {:optional true} token-name-ref]
|
||||||
[:p4 {:optional true} token-name-ref]
|
[:p3 {:optional true} token-name-ref]
|
||||||
[:x {:optional true} token-name-ref]
|
[:p4 {:optional true} token-name-ref]
|
||||||
[:y {:optional true} token-name-ref]])
|
[:x {:optional true} token-name-ref]
|
||||||
|
[:y {:optional true} token-name-ref]])
|
||||||
|
|
||||||
(def spacing-keys (schema-keys ::spacing))
|
(def spacing-keys (schema-keys ::spacing))
|
||||||
|
|
||||||
(sm/register! ::dimensions
|
(sm/register!
|
||||||
(merge-schemas ::sizing
|
^{::sm/type ::dimensions}
|
||||||
::spacing
|
[:merge
|
||||||
::stroke-width
|
::sizing
|
||||||
::border-radius))
|
::spacing
|
||||||
|
::stroke-width
|
||||||
|
::border-radius])
|
||||||
|
|
||||||
(def dimensions-keys (schema-keys ::dimensions))
|
(def dimensions-keys (schema-keys ::dimensions))
|
||||||
|
|
||||||
(sm/register! ::rotation
|
(sm/register!
|
||||||
[:map
|
^{::sm/type ::rotation}
|
||||||
[:rotation {:optional true} token-name-ref]])
|
[:map
|
||||||
|
[:rotation {:optional true} token-name-ref]])
|
||||||
|
|
||||||
(def rotation-keys (schema-keys ::rotation))
|
(def rotation-keys (schema-keys ::rotation))
|
||||||
|
|
||||||
(sm/register! ::tokens
|
(sm/register!
|
||||||
[:map {:title "Applied Tokens"}])
|
^{::sm/type ::tokens}
|
||||||
|
[:map {:title "Applied Tokens"}])
|
||||||
|
|
||||||
(sm/register! ::applied-tokens
|
(sm/register!
|
||||||
(merge-schemas ::tokens
|
^{::sm/type ::applied-tokens}
|
||||||
::border-radius
|
[:merge
|
||||||
::sizing
|
::tokens
|
||||||
::spacing
|
::border-radius
|
||||||
::rotation
|
::sizing
|
||||||
::dimensions))
|
::spacing
|
||||||
|
::rotation
|
||||||
|
::dimensions])
|
||||||
|
|
|
@ -8,18 +8,20 @@
|
||||||
(:require
|
(:require
|
||||||
[app.common.schema :as sm]))
|
[app.common.schema :as sm]))
|
||||||
|
|
||||||
(sm/register! ::token-theme
|
(sm/register!
|
||||||
[:map {:title "TokenTheme"}
|
^{::sm/type ::token-theme}
|
||||||
[:name :string]
|
[:map {:title "TokenTheme"}
|
||||||
[:group :string]
|
[:name :string]
|
||||||
[:description [:maybe :string]]
|
[:group :string]
|
||||||
[:is-source :boolean]
|
[:description [:maybe :string]]
|
||||||
[:modified-at {:optional true} ::sm/inst]
|
[:is-source :boolean]
|
||||||
[:sets :any]])
|
[:modified-at {:optional true} ::sm/inst]
|
||||||
|
[:sets :any]])
|
||||||
|
|
||||||
(sm/register! ::token-set
|
(sm/register!
|
||||||
[:map {:title "TokenSet"}
|
^{::sm/type ::token-set}
|
||||||
[:name :string]
|
[:map {:title "TokenSet"}
|
||||||
[:description {:optional true} [:maybe :string]]
|
[:name :string]
|
||||||
[:modified-at {:optional true} ::sm/inst]
|
[:description {:optional true} [:maybe :string]]
|
||||||
[:tokens :any]])
|
[:modified-at {:optional true} ::sm/inst]
|
||||||
|
[:tokens :any]])
|
||||||
|
|
|
@ -1,7 +1,5 @@
|
||||||
#!/usr/bin/env bash
|
#!/usr/bin/env bash
|
||||||
|
|
||||||
export PENPOT_TENANT=dev
|
|
||||||
|
|
||||||
bb -i '(babashka.wait/wait-for-port "localhost" 9630)';
|
bb -i '(babashka.wait/wait-for-port "localhost" 9630)';
|
||||||
bb -i '(babashka.wait/wait-for-path "target/app.js")';
|
bb -i '(babashka.wait/wait-for-path "target/app.js")';
|
||||||
sleep 2;
|
sleep 2;
|
||||||
|
|
|
@ -95,7 +95,7 @@
|
||||||
([params]
|
([params]
|
||||||
(create-thread-on-workspace params identity true))
|
(create-thread-on-workspace params identity true))
|
||||||
([params on-thread-created open?]
|
([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/reify ::create-thread-on-workspace
|
||||||
ptk/WatchEvent
|
ptk/WatchEvent
|
||||||
|
@ -149,7 +149,7 @@
|
||||||
(defn create-thread-on-viewer
|
(defn create-thread-on-viewer
|
||||||
[params]
|
[params]
|
||||||
(dm/assert!
|
(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/reify ::create-thread-on-viewer
|
||||||
ptk/WatchEvent
|
ptk/WatchEvent
|
||||||
|
@ -481,7 +481,7 @@
|
||||||
(defn create-draft
|
(defn create-draft
|
||||||
[params]
|
[params]
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
(sm/check! schema:create-draft params))
|
(sm/check schema:create-draft params))
|
||||||
(ptk/reify ::create-draft
|
(ptk/reify ::create-draft
|
||||||
ptk/UpdateEvent
|
ptk/UpdateEvent
|
||||||
(update [_ state]
|
(update [_ state]
|
||||||
|
|
|
@ -274,7 +274,7 @@
|
||||||
|
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
"expected valid params"
|
"expected valid params"
|
||||||
(sm/check! schema:login-with-ldap params))
|
(sm/check schema:login-with-ldap params))
|
||||||
|
|
||||||
(ptk/reify ::login-with-ldap
|
(ptk/reify ::login-with-ldap
|
||||||
ptk/WatchEvent
|
ptk/WatchEvent
|
||||||
|
@ -468,7 +468,7 @@
|
||||||
[data]
|
[data]
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
"expected valid parameters"
|
"expected valid parameters"
|
||||||
(sm/check! schema:update-password data))
|
(sm/check schema:update-password data))
|
||||||
|
|
||||||
(ptk/reify ::update-password
|
(ptk/reify ::update-password
|
||||||
ev/Event
|
ev/Event
|
||||||
|
@ -615,7 +615,7 @@
|
||||||
|
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
"expected valid parameters"
|
"expected valid parameters"
|
||||||
(sm/check! schema:request-profile-recovery data))
|
(sm/check schema:request-profile-recovery data))
|
||||||
|
|
||||||
(ptk/reify ::request-profile-recovery
|
(ptk/reify ::request-profile-recovery
|
||||||
ptk/WatchEvent
|
ptk/WatchEvent
|
||||||
|
@ -640,7 +640,7 @@
|
||||||
[data]
|
[data]
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
"expected valid arguments"
|
"expected valid arguments"
|
||||||
(sm/check! schema:recover-profile data))
|
(sm/check schema:recover-profile data))
|
||||||
|
|
||||||
(ptk/reify ::recover-profile
|
(ptk/reify ::recover-profile
|
||||||
ptk/WatchEvent
|
ptk/WatchEvent
|
||||||
|
|
|
@ -58,7 +58,7 @@
|
||||||
[{:keys [file-id share-id interactions-show?] :as params}]
|
[{:keys [file-id share-id interactions-show?] :as params}]
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
"expected valid params"
|
"expected valid params"
|
||||||
(sm/check! schema:initialize params))
|
(sm/check schema:initialize params))
|
||||||
|
|
||||||
(ptk/reify ::initialize
|
(ptk/reify ::initialize
|
||||||
ptk/UpdateEvent
|
ptk/UpdateEvent
|
||||||
|
@ -111,7 +111,7 @@
|
||||||
|
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
"expected valid params"
|
"expected valid params"
|
||||||
(sm/check! schema:fetch-bundle params))
|
(sm/check schema:fetch-bundle params))
|
||||||
|
|
||||||
(ptk/reify ::fetch-bundle
|
(ptk/reify ::fetch-bundle
|
||||||
ptk/WatchEvent
|
ptk/WatchEvent
|
||||||
|
|
|
@ -211,7 +211,7 @@
|
||||||
(defn- process-media-objects
|
(defn- process-media-objects
|
||||||
[{:keys [uris on-error] :as params}]
|
[{:keys [uris on-error] :as params}]
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
(and (sm/check! schema:process-media-objects params)
|
(and (sm/check schema:process-media-objects params)
|
||||||
(or (contains? params :blobs)
|
(or (contains? params :blobs)
|
||||||
(contains? params :uris))))
|
(contains? params :uris))))
|
||||||
|
|
||||||
|
@ -433,7 +433,7 @@
|
||||||
(defn clone-media-object
|
(defn clone-media-object
|
||||||
[{:keys [file-id object-id] :as params}]
|
[{:keys [file-id object-id] :as params}]
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
(sm/check! schema:clone-media-object params))
|
(sm/check schema:clone-media-object params))
|
||||||
|
|
||||||
(ptk/reify ::clone-media-objects
|
(ptk/reify ::clone-media-objects
|
||||||
ptk/WatchEvent
|
ptk/WatchEvent
|
||||||
|
|
|
@ -93,7 +93,7 @@
|
||||||
[{:keys [sender-id] :as message}]
|
[{:keys [sender-id] :as message}]
|
||||||
(dm/assert!
|
(dm/assert!
|
||||||
"expected valid message"
|
"expected valid message"
|
||||||
(sm/check! schema:message message))
|
(sm/check schema:message message))
|
||||||
(.postMessage js/self (wm/encode {:reply-to sender-id
|
(.postMessage js/self (wm/encode {:reply-to sender-id
|
||||||
:dropped true})))
|
:dropped true})))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue