Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-01-08 07:50:43 -05:00
Code Issues Activity

Merge pull request #5267 from penpot/niwinz-backend-update-integrant

Browse source 
♻️ Update integrant to latest version
This commit is contained in:
Alejandro 2024-11-14 07:50:49 +01:00 committed by GitHub
commit 3c6403224d
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
79 changed files with 2249 additions and 2117 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
.circleci/config.yml
View file

@ -161,7 +161,7 @@ jobs:
name: "tests"
working_directory: "./backend"
command: |
clojure -M:dev:test
clojure -M:dev:test --reporter kaocha.report/documentation
environment:
PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"

1
.cljfmt.edn
View file

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

1
backend/dev/user.clj
View file

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

1
backend/scripts/repl
View file

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

2
backend/scripts/start-dev
View file

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

75
backend/src/app/auth/ldap.clj
View file

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

102
backend/src/app/auth/oidc.clj
View file

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

18
backend/src/app/config.clj
View file

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

100
backend/src/app/db.clj
View file

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

237
backend/src/app/email.clj
View file

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

75
backend/src/app/http.clj
View file

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

11
backend/src/app/http/assets.clj
View file

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

11
backend/src/app/http/awsns.clj
View file

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

16
backend/src/app/http/client.clj
View file

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

7
backend/src/app/http/debug.clj
View file

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

58
backend/src/app/http/session.clj
View file

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

17
backend/src/app/http/websocket.clj
View file

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

62
backend/src/app/loggers/audit.clj
View file

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

13
backend/src/app/loggers/audit/archive_task.clj
View file

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

6
backend/src/app/loggers/audit/gc_task.clj
View file

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

8
backend/src/app/loggers/database.clj
View file

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

9
backend/src/app/loggers/mattermost.clj
View file

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

19
backend/src/app/loggers/webhooks.clj
View file

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

36
backend/src/app/main.clj
View file

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

17
backend/src/app/media.clj
View file

@ -46,14 +46,15 @@
(s/keys :req-un [::path]
:opt-un [::mtype]))
(sm/register! ::upload
[:map {:title "Upload"}
[:filename :string]
[:size ::sm/int]
[:path ::fs/path]
[:mtype {:optional true} :string]
[:headers {:optional true}
[:map-of :string :string]]])
(sm/register!
^{::sm/type ::upload}
[:map {:title "Upload"}
[:filename :string]
[:size ::sm/int]
[:path ::fs/path]
[:mtype {:optional true} :string]
[:headers {:optional true}
[:map-of :string :string]]])
(defn validate-media-type!
([upload] (validate-media-type! upload cm/valid-image-types))

96
backend/src/app/metrics.clj
View file

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

7
backend/src/app/migrations.clj
View file

@ -11,7 +11,6 @@
[app.db :as db]
[app.migrations.clj.migration-0023 :as mg0023]
[app.util.migrations :as mg]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
(def migrations
@ -435,9 +434,9 @@
(mg/setup! conn)
(mg/migrate! conn {:name name :steps migrations})))
(defmethod ig/pre-init-spec ::migrations
[_]
(s/keys :req [::db/pool]))
(defmethod ig/assert-key ::migrations
[_ {:keys [::db/pool]}]
(assert (db/pool? pool) "expected valid pool"))
(defmethod ig/init-key ::migrations
[module {:keys [::db/pool]}]

143
backend/src/app/msgbus.clj
View file

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

444
backend/src/app/redis.clj
View file

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

47
backend/src/app/rpc.clj
View file

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

275
backend/src/app/rpc/climit.clj
View file

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

7
backend/src/app/rpc/doc.clj
View file

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

35
backend/src/app/rpc/permissions.clj
View file

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

111
backend/src/app/rpc/rlimit.clj
View file

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

17
backend/src/app/setup.clj
View file

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

18
backend/src/app/srepl.clj
View file

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

65
backend/src/app/storage.clj
View file

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

37
backend/src/app/storage/fs.clj
View file

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

16
backend/src/app/storage/gc_deleted.clj
View file

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

6
backend/src/app/storage/gc_touched.clj
View file

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

5
backend/src/app/storage/impl.clj
View file

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

88
backend/src/app/storage/s3.clj
View file

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

13
backend/src/app/storage/tmp.clj
View file

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

6
backend/src/app/tasks/delete_object.clj
View file

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

7
backend/src/app/tasks/file_gc.clj
View file

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

12
backend/src/app/tasks/file_gc_scheduler.clj
View file

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

6
backend/src/app/tasks/file_xlog_gc.clj
View file

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

17
backend/src/app/tasks/objects_gc.clj
View file

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

7
backend/src/app/tasks/offload_file_data.clj
View file

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

12
backend/src/app/tasks/tasks_gc.clj
View file

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

10
backend/src/app/tasks/telemetry.clj
View file

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

7
backend/src/app/util/cache.clj
View file

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

24
backend/src/app/util/overrides.clj
View file

@ -25,15 +25,15 @@
clojure.lang.IPersistentMap
clojure.lang.IDeref)
(sm/register! ::fs/path
{:type ::fs/path
:pred fs/path?
:type-properties
{:title "path"
:description "filesystem path"
:error/message "expected a valid fs path instance"
:error/code "errors.invalid-path"
:gen/gen (sg/generator :string)
:decode/string fs/path
::oapi/type "string"
::oapi/format "unix-path"}})
(sm/register!
{:type ::fs/path
:pred fs/path?
:type-properties
{:title "path"
:description "filesystem path"
:error/message "expected a valid fs path instance"
:error/code "errors.invalid-path"
:gen/gen (sg/generator :string)
:decode/string fs/path
::oapi/type "string"
::oapi/format "unix-path"}})

52
backend/src/app/util/time.clj
View file

@ -370,30 +370,30 @@
(let [p1 (System/nanoTime)]
#(duration {:nanos (- (System/nanoTime) p1)})))
(sm/register! ::instant
{:type ::instant
:pred instant?
:type-properties
{:error/message "should be an instant"
:title "instant"
:decode/string instant
:encode/string format-instant
:decode/json instant
:encode/json format-instant
:gen/gen (tgen/fmap (fn [i] (in-past i)) tgen/pos-int)
::oapi/type "string"
::oapi/format "iso"}})
(sm/register!
{:type ::instant
:pred instant?
:type-properties
{:error/message "should be an instant"
:title "instant"
:decode/string instant
:encode/string format-instant
:decode/json instant
:encode/json format-instant
:gen/gen (tgen/fmap (fn [i] (in-past i)) tgen/pos-int)
::oapi/type "string"
::oapi/format "iso"}})
(sm/register! ::duration
{:type :durations
:pred duration?
:type-properties
{:error/message "should be a duration"
:gen/gen (tgen/fmap duration tgen/pos-int)
:title "duration"
:decode/string duration
:encode/string format-duration
:decode/json duration
:encode/json format-duration
::oapi/type "string"
::oapi/format "duration"}})
(sm/register!
{:type ::duration
:pred duration?
:type-properties
{:error/message "should be a duration"
:gen/gen (tgen/fmap duration tgen/pos-int)
:title "duration"
:decode/string duration
:encode/string format-duration
:decode/json duration
:encode/json format-duration
::oapi/type "string"
::oapi/format "duration"}})

45
backend/src/app/worker.clj
View file

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

37
backend/src/app/worker/cron.clj
View file

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

36
backend/src/app/worker/dispatcher.clj
View file

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

26
backend/src/app/worker/executor.clj
View file

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

55
backend/src/app/worker/runner.clj
View file

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

8
backend/test/backend_tests/helpers.clj
View file

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

19
backend/test/backend_tests/storage_test.clj
View file

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

2
common/deps.edn
View file

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

13
common/src/app/common/features.cljc
View file

@ -89,12 +89,13 @@
"text-editor/v2"}
(into frontend-only-features)))
(sm/register! ::features
[:schema
{:title "FileFeatures"
::smdj/inline true
:gen/gen (smg/subseq supported-features)}
[::sm/set :string]])
(sm/register!
^{::sm/type ::features}
[:schema
{:title "FileFeatures"
::smdj/inline true
:gen/gen (smg/subseq supported-features)}
[::sm/set :string]])
(defn- flag->feature
"Translate a flag to a feature name"

17
common/src/app/common/files/changes_builder.cljc
View file

@ -25,14 +25,15 @@
;; Auxiliary functions to help create a set of changes (undo + redo)
(sm/register! ::changes
[:map {:title "changes"}
[:redo-changes vector?]
[:undo-changes seq?]
[:origin {:optional true} any?]
[:save-undo? {:optional true} boolean?]
[:stack-undo? {:optional true} boolean?]
[:undo-group {:optional true} any?]])
(sm/register!
^{::sm/type ::changes}
[:map {:title "changes"}
[:redo-changes vector?]
[:undo-changes seq?]
[:origin {:optional true} any?]
[:save-undo? {:optional true} boolean?]
[:stack-undo? {:optional true} boolean?]
[:undo-group {:optional true} any?]])
(def check-changes!
(sm/check-fn ::changes))

4
common/src/app/common/geom/point.cljc
View file

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

27
common/src/app/common/logging.cljc
View file

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

1097
common/src/app/common/schema.cljc
View file

File diff suppressed because it is too large Load diff

23
common/src/app/common/types/container.cljc
View file

@ -27,17 +27,18 @@
(def valid-container-types
#{:page :component})
(sm/register! ::container
[:map
[:id ::sm/uuid]
[:type {:optional true}
[::sm/one-of valid-container-types]]
[:name :string]
[:path {:optional true} [:maybe :string]]
[:modified-at {:optional true} ::sm/inst]
[:objects {:optional true}
[:map-of {:gen/max 10} ::sm/uuid :map]]
[:plugin-data {:optional true} ::ctpg/plugin-data]])
(sm/register!
^{::sm/type ::container}
[:map
[:id ::sm/uuid]
[:type {:optional true}
[::sm/one-of valid-container-types]]
[:name :string]
[:path {:optional true} [:maybe :string]]
[:modified-at {:optional true} ::sm/inst]
[:objects {:optional true}
[:map-of {:gen/max 10} ::sm/uuid :map]]
[:plugin-data {:optional true} ::ctpg/plugin-data]])
(def check-container!
(sm/check-fn ::container))

13
common/src/app/common/types/shape/blur.cljc
View file

@ -26,9 +26,10 @@
;; SCHEMA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sm/register! ::blur
[:map {:title "Blur"}
[:id ::sm/uuid]
[:type [:= :layer-blur]]
[:value ::sm/safe-number]
[:hidden :boolean]])
(sm/register!
^{::sm/type ::blur}
[:map {:title "Blur"}
[:id ::sm/uuid]
[:type [:= :layer-blur]]
[:value ::sm/safe-number]
[:hidden :boolean]])

133
common/src/app/common/types/shape/layout.cljc
View file

@ -86,35 +86,36 @@
:layout-item-absolute
:layout-item-z-index])
(sm/register! ::layout-attrs
[:map {:title "LayoutAttrs"}
[:layout {:optional true} [::sm/one-of layout-types]]
[:layout-flex-dir {:optional true} [::sm/one-of flex-direction-types]]
[:layout-gap {:optional true}
[:map
[:row-gap {:optional true} ::sm/safe-number]
[:column-gap {:optional true} ::sm/safe-number]]]
[:layout-gap-type {:optional true} [::sm/one-of gap-types]]
[:layout-wrap-type {:optional true} [::sm/one-of wrap-types]]
[:layout-padding-type {:optional true} [::sm/one-of padding-type]]
[:layout-padding {:optional true}
[:map
[:p1 ::sm/safe-number]
[:p2 ::sm/safe-number]
[:p3 ::sm/safe-number]
[:p4 ::sm/safe-number]]]
[:layout-justify-content {:optional true} [::sm/one-of justify-content-types]]
[:layout-justify-items {:optional true} [::sm/one-of justify-items-types]]
[:layout-align-content {:optional true} [::sm/one-of align-content-types]]
[:layout-align-items {:optional true} [::sm/one-of align-items-types]]
(sm/register!
^{::sm/type ::layout-attrs}
[:map {:title "LayoutAttrs"}
[:layout {:optional true} [::sm/one-of layout-types]]
[:layout-flex-dir {:optional true} [::sm/one-of flex-direction-types]]
[:layout-gap {:optional true}
[:map
[:row-gap {:optional true} ::sm/safe-number]
[:column-gap {:optional true} ::sm/safe-number]]]
[:layout-gap-type {:optional true} [::sm/one-of gap-types]]
[:layout-wrap-type {:optional true} [::sm/one-of wrap-types]]
[:layout-padding-type {:optional true} [::sm/one-of padding-type]]
[:layout-padding {:optional true}
[:map
[:p1 ::sm/safe-number]
[:p2 ::sm/safe-number]
[:p3 ::sm/safe-number]
[:p4 ::sm/safe-number]]]
[:layout-justify-content {:optional true} [::sm/one-of justify-content-types]]
[:layout-justify-items {:optional true} [::sm/one-of justify-items-types]]
[:layout-align-content {:optional true} [::sm/one-of align-content-types]]
[:layout-align-items {:optional true} [::sm/one-of align-items-types]]
[:layout-grid-dir {:optional true} [::sm/one-of grid-direction-types]]
[:layout-grid-rows {:optional true}
[:vector {:gen/max 2} ::grid-track]]
[:layout-grid-columns {:optional true}
[:vector {:gen/max 2} ::grid-track]]
[:layout-grid-cells {:optional true}
[:map-of {:gen/max 5} ::sm/uuid ::grid-cell]]])
[:layout-grid-dir {:optional true} [::sm/one-of grid-direction-types]]
[:layout-grid-rows {:optional true}
[:vector {:gen/max 2} ::grid-track]]
[:layout-grid-columns {:optional true}
[:vector {:gen/max 2} ::grid-track]]
[:layout-grid-cells {:optional true}
[:map-of {:gen/max 5} ::sm/uuid ::grid-cell]]])
;; Grid types
(def grid-track-types
@ -129,24 +130,26 @@
(def grid-cell-justify-self-types
#{:auto :start :center :end :stretch})
(sm/register! ::grid-cell
[:map {:title "GridCell"}
[:id ::sm/uuid]
[:area-name {:optional true} :string]
[:row ::sm/safe-int]
[:row-span ::sm/safe-int]
[:column ::sm/safe-int]
[:column-span ::sm/safe-int]
[:position {:optional true} [::sm/one-of grid-position-types]]
[:align-self {:optional true} [::sm/one-of grid-cell-align-self-types]]
[:justify-self {:optional true} [::sm/one-of grid-cell-justify-self-types]]
[:shapes
[:vector {:gen/max 1} ::sm/uuid]]])
(sm/register!
^{::sm/type ::grid-cell}
[:map {:title "GridCell"}
[:id ::sm/uuid]
[:area-name {:optional true} :string]
[:row ::sm/safe-int]
[:row-span ::sm/safe-int]
[:column ::sm/safe-int]
[:column-span ::sm/safe-int]
[:position {:optional true} [::sm/one-of grid-position-types]]
[:align-self {:optional true} [::sm/one-of grid-cell-align-self-types]]
[:justify-self {:optional true} [::sm/one-of grid-cell-justify-self-types]]
[:shapes
[:vector {:gen/max 1} ::sm/uuid]]])
(sm/register! ::grid-track
[:map {:title "GridTrack"}
[:type [::sm/one-of grid-track-types]]
[:value {:optional true} [:maybe ::sm/safe-number]]])
(sm/register!
^{::sm/type ::grid-track}
[:map {:title "GridTrack"}
[:type [::sm/one-of grid-track-types]]
[:value {:optional true} [:maybe ::sm/safe-number]]])
(def check-grid-track!
(sm/check-fn ::grid-track))
@ -165,24 +168,25 @@
(def item-align-self-types
#{:start :end :center :stretch})
(sm/register! ::layout-child-attrs
[:map {:title "LayoutChildAttrs"}
[:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
[:layout-item-margin {:optional true}
[:map
[:m1 {:optional true} ::sm/safe-number]
[:m2 {:optional true} ::sm/safe-number]
[:m3 {:optional true} ::sm/safe-number]
[:m4 {:optional true} ::sm/safe-number]]]
[:layout-item-max-h {:optional true} ::sm/safe-number]
[:layout-item-min-h {:optional true} ::sm/safe-number]
[:layout-item-max-w {:optional true} ::sm/safe-number]
[:layout-item-min-w {:optional true} ::sm/safe-number]
[:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
[:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
[:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
[:layout-item-absolute {:optional true} :boolean]
[:layout-item-z-index {:optional true} ::sm/safe-number]])
(sm/register!
^{::sm/type ::layout-child-attrs}
[:map {:title "LayoutChildAttrs"}
[:layout-item-margin-type {:optional true} [::sm/one-of item-margin-types]]
[:layout-item-margin {:optional true}
[:map
[:m1 {:optional true} ::sm/safe-number]
[:m2 {:optional true} ::sm/safe-number]
[:m3 {:optional true} ::sm/safe-number]
[:m4 {:optional true} ::sm/safe-number]]]
[:layout-item-max-h {:optional true} ::sm/safe-number]
[:layout-item-min-h {:optional true} ::sm/safe-number]
[:layout-item-max-w {:optional true} ::sm/safe-number]
[:layout-item-min-w {:optional true} ::sm/safe-number]
[:layout-item-h-sizing {:optional true} [::sm/one-of item-h-sizing-types]]
[:layout-item-v-sizing {:optional true} [::sm/one-of item-v-sizing-types]]
[:layout-item-align-self {:optional true} [::sm/one-of item-align-self-types]]
[:layout-item-absolute {:optional true} :boolean]
[:layout-item-z-index {:optional true} ::sm/safe-number]])
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMAS
@ -191,8 +195,7 @@
(def valid-layouts
#{:flex :grid})
(sm/register! ::layout
[::sm/one-of valid-layouts])
(sm/register! ::layout [::sm/one-of valid-layouts])
(defn flex-layout?
([objects id]

128
common/src/app/common/types/shape/text.cljc
View file

@ -16,68 +16,70 @@
(def node-types #{"root" "paragraph-set" "paragraph"})
(sm/register! ::content
(sm/register!
^{::sm/type ::content}
[:map
[:type [:= "root"]]
[:key {:optional true} :string]
[:children
{:optional true}
[:maybe
[:vector {:min 1 :gen/max 2 :gen/min 1}
[:map
[:type [:= "paragraph-set"]]
[:key {:optional true} :string]
[:children
[:vector {:min 1 :gen/max 2 :gen/min 1}
[:map
[:type [:= "paragraph"]]
[:key {:optional true} :string]
[:fills {:optional true}
[:maybe
[:vector {:gen/max 2} ::shape/fill]]]
[:font-family {:optional true} :string]
[:font-size {:optional true} :string]
[:font-style {:optional true} :string]
[:font-weight {:optional true} :string]
[:direction {:optional true} :string]
[:text-decoration {:optional true} :string]
[:text-transform {:optional true} :string]
[:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
[:typography-ref-file {:optional true} [:maybe ::sm/uuid]]
[:children
[:vector {:min 1 :gen/max 2 :gen/min 1}
[:map
[:text :string]
[:key {:optional true} :string]
[:fills {:optional true}
[:maybe
[:vector {:gen/max 2} ::shape/fill]]]
[:font-family {:optional true} :string]
[:font-size {:optional true} :string]
[:font-style {:optional true} :string]
[:font-weight {:optional true} :string]
[:direction {:optional true} :string]
[:text-decoration {:optional true} :string]
[:text-transform {:optional true} :string]
[:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
[:typography-ref-file {:optional true} [:maybe ::sm/uuid]]]]]]]]]]]]])
(sm/register!
^{::sm/type ::position-data}
[:vector {:min 1 :gen/max 2}
[:map
[:type [:= "root"]]
[:key {:optional true} :string]
[:children
{:optional true}
[:maybe
[:vector {:min 1 :gen/max 2 :gen/min 1}
[:map
[:type [:= "paragraph-set"]]
[:key {:optional true} :string]
[:children
[:vector {:min 1 :gen/max 2 :gen/min 1}
[:map
[:type [:= "paragraph"]]
[:key {:optional true} :string]
[:fills {:optional true}
[:maybe
[:vector {:gen/max 2} ::shape/fill]]]
[:font-family {:optional true} :string]
[:font-size {:optional true} :string]
[:font-style {:optional true} :string]
[:font-weight {:optional true} :string]
[:direction {:optional true} :string]
[:text-decoration {:optional true} :string]
[:text-transform {:optional true} :string]
[:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
[:typography-ref-file {:optional true} [:maybe ::sm/uuid]]
[:children
[:vector {:min 1 :gen/max 2 :gen/min 1}
[:map
[:text :string]
[:key {:optional true} :string]
[:fills {:optional true}
[:maybe
[:vector {:gen/max 2} ::shape/fill]]]
[:font-family {:optional true} :string]
[:font-size {:optional true} :string]
[:font-style {:optional true} :string]
[:font-weight {:optional true} :string]
[:direction {:optional true} :string]
[:text-decoration {:optional true} :string]
[:text-transform {:optional true} :string]
[:typography-ref-id {:optional true} [:maybe ::sm/uuid]]
[:typography-ref-file {:optional true} [:maybe ::sm/uuid]]]]]]]]]]]]])
(sm/register! ::position-data
[:vector {:min 1 :gen/max 2}
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]
[:width ::sm/safe-number]
[:height ::sm/safe-number]
[:fills [:vector {:gen/max 2} ::shape/fill]]
[:font-family {:optional true} :string]
[:font-size {:optional true} :string]
[:font-style {:optional true} :string]
[:font-weight {:optional true} :string]
[:rtl {:optional true} :boolean]
[:text {:optional true} :string]
[:text-decoration {:optional true} :string]
[:text-transform {:optional true} :string]]])
[:x ::sm/safe-number]
[:y ::sm/safe-number]
[:width ::sm/safe-number]
[:height ::sm/safe-number]
[:fills [:vector {:gen/max 2} ::shape/fill]]
[:font-family {:optional true} :string]
[:font-size {:optional true} :string]
[:font-style {:optional true} :string]
[:font-weight {:optional true} :string]
[:rtl {:optional true} :boolean]
[:text {:optional true} :string]
[:text-decoration {:optional true} :string]
[:text-transform {:optional true} :string]]])

133
common/src/app/common/types/token.cljc
View file

@ -64,89 +64,102 @@
(string? n))
;; TODO Move this to tokens-lib
(sm/register! ::token
[:map {:title "Token"}
[:name token-name-ref]
[:type [::sm/one-of token-types]]
[:value :any]
[:description {:optional true} [:maybe :string]]
[:modified-at {:optional true} ::sm/inst]])
(sm/register!
^{::sm/type ::token}
[:map {:title "Token"}
[:name token-name-ref]
[:type [::sm/one-of token-types]]
[:value :any]
[:description {:optional true} [:maybe :string]]
[:modified-at {:optional true} ::sm/inst]])
(sm/register! ::color
[:map
[:fill {:optional true} token-name-ref]
[:stroke-color {:optional true} token-name-ref]])
(sm/register!
^{::sm/type ::color}
[:map
[:fill {:optional true} token-name-ref]
[:stroke-color {:optional true} token-name-ref]])
(def color-keys (schema-keys ::color))
(sm/register! ::border-radius
[:map
[:rx {:optional true} token-name-ref]
[:ry {:optional true} token-name-ref]
[:r1 {:optional true} token-name-ref]
[:r2 {:optional true} token-name-ref]
[:r3 {:optional true} token-name-ref]
[:r4 {:optional true} token-name-ref]])
(sm/register!
^{::sm/type ::border-radius}
[:map
[:rx {:optional true} token-name-ref]
[:ry {:optional true} token-name-ref]
[:r1 {:optional true} token-name-ref]
[:r2 {:optional true} token-name-ref]
[:r3 {:optional true} token-name-ref]
[:r4 {:optional true} token-name-ref]])
(def border-radius-keys (schema-keys ::border-radius))
(sm/register! ::stroke-width
[:map
[:stroke-width {:optional true} token-name-ref]])
(sm/register!
^{::sm/type ::stroke-width}
[:map
[:stroke-width {:optional true} token-name-ref]])
(def stroke-width-keys (schema-keys ::stroke-width))
(sm/register! ::sizing
[:map
[:width {:optional true} token-name-ref]
[:height {:optional true} token-name-ref]
[:layout-item-min-w {:optional true} token-name-ref]
[:layout-item-max-w {:optional true} token-name-ref]
[:layout-item-min-h {:optional true} token-name-ref]
[:layout-item-max-h {:optional true} token-name-ref]])
(sm/register!
^{::sm/type ::sizing}
[:map
[:width {:optional true} token-name-ref]
[:height {:optional true} token-name-ref]
[:layout-item-min-w {:optional true} token-name-ref]
[:layout-item-max-w {:optional true} token-name-ref]
[:layout-item-min-h {:optional true} token-name-ref]
[:layout-item-max-h {:optional true} token-name-ref]])
(def sizing-keys (schema-keys ::sizing))
(sm/register! ::opacity
[:map
[:opacity {:optional true} token-name-ref]])
(sm/register!
^{::sm/type ::opacity}
[:map
[:opacity {:optional true} token-name-ref]])
(def opacity-keys (schema-keys ::opacity))
(sm/register! ::spacing
[:map
[:row-gap {:optional true} token-name-ref]
[:column-gap {:optional true} token-name-ref]
[:p1 {:optional true} token-name-ref]
[:p2 {:optional true} token-name-ref]
[:p3 {:optional true} token-name-ref]
[:p4 {:optional true} token-name-ref]
[:x {:optional true} token-name-ref]
[:y {:optional true} token-name-ref]])
(sm/register!
^{::sm/type ::spacing}
[:map
[:row-gap {:optional true} token-name-ref]
[:column-gap {:optional true} token-name-ref]
[:p1 {:optional true} token-name-ref]
[:p2 {:optional true} token-name-ref]
[:p3 {:optional true} token-name-ref]
[:p4 {:optional true} token-name-ref]
[:x {:optional true} token-name-ref]
[:y {:optional true} token-name-ref]])
(def spacing-keys (schema-keys ::spacing))
(sm/register! ::dimensions
(merge-schemas ::sizing
::spacing
::stroke-width
::border-radius))
(sm/register!
^{::sm/type ::dimensions}
[:merge
::sizing
::spacing
::stroke-width
::border-radius])
(def dimensions-keys (schema-keys ::dimensions))
(sm/register! ::rotation
[:map
[:rotation {:optional true} token-name-ref]])
(sm/register!
^{::sm/type ::rotation}
[:map
[:rotation {:optional true} token-name-ref]])
(def rotation-keys (schema-keys ::rotation))
(sm/register! ::tokens
[:map {:title "Applied Tokens"}])
(sm/register!
^{::sm/type ::tokens}
[:map {:title "Applied Tokens"}])
(sm/register! ::applied-tokens
(merge-schemas ::tokens
::border-radius
::sizing
::spacing
::rotation
::dimensions))
(sm/register!
^{::sm/type ::applied-tokens}
[:merge
::tokens
::border-radius
::sizing
::spacing
::rotation
::dimensions])

30
common/src/app/common/types/token_theme.cljc
View file

@ -8,18 +8,20 @@
(:require
[app.common.schema :as sm]))
(sm/register! ::token-theme
[:map {:title "TokenTheme"}
[:name :string]
[:group :string]
[:description [:maybe :string]]
[:is-source :boolean]
[:modified-at {:optional true} ::sm/inst]
[:sets :any]])
(sm/register!
^{::sm/type ::token-theme}
[:map {:title "TokenTheme"}
[:name :string]
[:group :string]
[:description [:maybe :string]]
[:is-source :boolean]
[:modified-at {:optional true} ::sm/inst]
[:sets :any]])
(sm/register! ::token-set
[:map {:title "TokenSet"}
[:name :string]
[:description {:optional true} [:maybe :string]]
[:modified-at {:optional true} ::sm/inst]
[:tokens :any]])
(sm/register!
^{::sm/type ::token-set}
[:map {:title "TokenSet"}
[:name :string]
[:description {:optional true} [:maybe :string]]
[:modified-at {:optional true} ::sm/inst]
[:tokens :any]])

2
exporter/scripts/wait-and-start.sh
View file

@ -1,7 +1,5 @@
#!/usr/bin/env bash
export PENPOT_TENANT=dev
bb -i '(babashka.wait/wait-for-port "localhost" 9630)';
bb -i '(babashka.wait/wait-for-path "target/app.js")';
sleep 2;

6
frontend/src/app/main/data/comments.cljs
View file

@ -95,7 +95,7 @@
([params]
(create-thread-on-workspace params identity true))
([params on-thread-created open?]
(dm/assert! (sm/check! schema:create-thread-on-workspace params))
(dm/assert! (sm/check schema:create-thread-on-workspace params))
(ptk/reify ::create-thread-on-workspace
ptk/WatchEvent
@ -149,7 +149,7 @@
(defn create-thread-on-viewer
[params]
(dm/assert!
(sm/check! schema:create-thread-on-viewer params))
(sm/check schema:create-thread-on-viewer params))
(ptk/reify ::create-thread-on-viewer
ptk/WatchEvent
@ -481,7 +481,7 @@
(defn create-draft
[params]
(dm/assert!
(sm/check! schema:create-draft params))
(sm/check schema:create-draft params))
(ptk/reify ::create-draft
ptk/UpdateEvent
(update [_ state]

8
frontend/src/app/main/data/users.cljs
View file

@ -274,7 +274,7 @@
(dm/assert!
"expected valid params"
(sm/check! schema:login-with-ldap params))
(sm/check schema:login-with-ldap params))
(ptk/reify ::login-with-ldap
ptk/WatchEvent
@ -468,7 +468,7 @@
[data]
(dm/assert!
"expected valid parameters"
(sm/check! schema:update-password data))
(sm/check schema:update-password data))
(ptk/reify ::update-password
ev/Event
@ -615,7 +615,7 @@
(dm/assert!
"expected valid parameters"
(sm/check! schema:request-profile-recovery data))
(sm/check schema:request-profile-recovery data))
(ptk/reify ::request-profile-recovery
ptk/WatchEvent
@ -640,7 +640,7 @@
[data]
(dm/assert!
"expected valid arguments"
(sm/check! schema:recover-profile data))
(sm/check schema:recover-profile data))
(ptk/reify ::recover-profile
ptk/WatchEvent

4
frontend/src/app/main/data/viewer.cljs
View file

@ -58,7 +58,7 @@
[{:keys [file-id share-id interactions-show?] :as params}]
(dm/assert!
"expected valid params"
(sm/check! schema:initialize params))
(sm/check schema:initialize params))
(ptk/reify ::initialize
ptk/UpdateEvent
@ -111,7 +111,7 @@
(dm/assert!
"expected valid params"
(sm/check! schema:fetch-bundle params))
(sm/check schema:fetch-bundle params))
(ptk/reify ::fetch-bundle
ptk/WatchEvent

4
frontend/src/app/main/data/workspace/media.cljs
View file

@ -211,7 +211,7 @@
(defn- process-media-objects
[{:keys [uris on-error] :as params}]
(dm/assert!
(and (sm/check! schema:process-media-objects params)
(and (sm/check schema:process-media-objects params)
(or (contains? params :blobs)
(contains? params :uris))))
@ -433,7 +433,7 @@
(defn clone-media-object
[{:keys [file-id object-id] :as params}]
(dm/assert!
(sm/check! schema:clone-media-object params))
(sm/check schema:clone-media-object params))
(ptk/reify ::clone-media-objects
ptk/WatchEvent

2
frontend/src/app/worker.cljs
View file

@ -93,7 +93,7 @@
[{:keys [sender-id] :as message}]
(dm/assert!
"expected valid message"
(sm/check! schema:message message))
(sm/check schema:message message))
(.postMessage js/self (wm/encode {:reply-to sender-id
:dropped true})))