3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-31 17:26:18 +02:00
Code Issues Projects Releases Packages Wiki Activity

Merge pull request #4068 from penpot/niwinz-staging-bugfix-8

Browse source 
🐛 Fix incorrect behavior of climit subsystem and adapt related code
This commit is contained in:
Alejandro 2024-02-02 07:18:56 +01:00 • committed by GitHub
commit a980c102be
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
19 changed files with 629 additions and 533 deletions
Download patch file Download diff file Expand all files Collapse all files

19
backend/resources/climit.edn
View file

@ -3,15 +3,26 @@
;; Optional: queue, ommited means Integer/MAX_VALUE ;; Optional: queue, ommited means Integer/MAX_VALUE
;; Optional: timeout, ommited means no timeout ;; Optional: timeout, ommited means no timeout
;; Note: queue and timeout are excluding ;; Note: queue and timeout are excluding
{:update-file/by-profile {:update-file/global {:permits 20}
:update-file/by-profile
{:permits 1 :queue 5} {:permits 1 :queue 5}
:update-file/global {:permits 20} :process-font/global {:permits 4}
:process-font/by-profile {:permits 1}
:derive-password/global {:permits 8}
:process-font/global {:permits 4}
:process-image/global {:permits 8} :process-image/global {:permits 8}
:process-image/by-profile {:permits 1}
:auth/global {:permits 8}
:root/global
{:permits 40}
:root/by-profile
{:permits 10}
:file-thumbnail-ops/global
{:permits 20}
:file-thumbnail-ops/by-profile :file-thumbnail-ops/by-profile
{:permits 2} {:permits 2}

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

@ -237,8 +237,7 @@
(jdbc/get-connection system-or-pool) (jdbc/get-connection system-or-pool)
(if (map? system-or-pool) (if (map? system-or-pool)
(open (::pool system-or-pool)) (open (::pool system-or-pool))
(ex/raise :type :internal (throw (IllegalArgumentException. "unable to resolve connection pool")))))
:code :unable-resolve-pool))))
(defn get-update-count (defn get-update-count
[result] [result]
@ -250,9 +249,7 @@
cfg-or-conn cfg-or-conn
(if (map? cfg-or-conn) (if (map? cfg-or-conn)
(get-connection (::conn cfg-or-conn)) (get-connection (::conn cfg-or-conn))
(ex/raise :type :internal (throw (IllegalArgumentException. "unable to resolve connection")))))
:code :unable-resolve-connection
:hint "expected conn or system map"))))
(defn connection-map? (defn connection-map?
"Check if the provided value is a map like data structure that "Check if the provided value is a map like data structure that
@ -260,15 +257,15 @@
[o] [o]
(and (map? o) (connection? (::conn o)))) (and (map? o) (connection? (::conn o))))
(defn- get-connectable (defn get-connectable
"Resolve to a connection or connection pool instance; if it is not
possible, raises an exception"
[o] [o]
(cond (cond
(connection? o) o (connection? o) o
(pool? o) o (pool? o) o
(map? o) (get-connectable (or (::conn o) (::pool o))) (map? o) (get-connectable (or (::conn o) (::pool o)))
:else (ex/raise :type :internal :else (throw (IllegalArgumentException. "unable to resolve connectable"))))
:code :unable-resolve-connectable
:hint "expected conn, pool or system")))
(def ^:private params-mapping (def ^:private params-mapping
{::return-keys? :return-keys {::return-keys? :return-keys

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

@ -200,22 +200,15 @@
;; NOTE: this operation may cause primary key conflicts on inserts ;; NOTE: this operation may cause primary key conflicts on inserts
;; because of the timestamp precission (two concurrent requests), in ;; because of the timestamp precission (two concurrent requests), in
;; this case we just retry the operation. ;; this case we just retry the operation.
(let [cfg (-> cfg (let [tnow (dt/now)
(assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 6)
(assoc ::rtry/label "persist-audit-log"))
params (-> params params (-> params
(assoc :created-at tnow)
(assoc :tracked-at tnow)
(update :props db/tjson) (update :props db/tjson)
(update :context db/tjson) (update :context db/tjson)
(update :ip-addr db/inet) (update :ip-addr db/inet)
(assoc :source "backend"))] (assoc :source "backend"))]
(db/insert! cfg :audit-log params)))
(rtry/invoke cfg (fn [cfg]
(let [tnow (dt/now)
params (-> params
(assoc :created-at tnow)
(assoc :tracked-at tnow))]
(db/insert! cfg :audit-log params))))))
(when (and (contains? cf/flags :webhooks) (when (and (contains? cf/flags :webhooks)
(::webhooks/event? event)) (::webhooks/event? event))
@ -246,9 +239,13 @@
"Submit audit event to the collector." "Submit audit event to the collector."
[cfg params] [cfg params]
(try (try
(let [event (d/without-nils params)] (let [event (d/without-nils params)
cfg (-> cfg
(assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 6)
(assoc ::rtry/label "persist-audit-log"))]
(us/verify! ::event event) (us/verify! ::event event)
(db/tx-run! cfg handle-event! event)) (rtry/invoke! cfg db/tx-run! handle-event! event))
(catch Throwable cause (catch Throwable cause
(l/error :hint "unexpected error processing event" :cause cause)))) (l/error :hint "unexpected error processing event" :cause cause))))

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

@ -322,9 +322,7 @@
::rpc/climit (ig/ref ::rpc/climit) ::rpc/climit (ig/ref ::rpc/climit)
::rpc/rlimit (ig/ref ::rpc/rlimit) ::rpc/rlimit (ig/ref ::rpc/rlimit)
::setup/templates (ig/ref ::setup/templates) ::setup/templates (ig/ref ::setup/templates)
::props (ig/ref ::setup/props) ::props (ig/ref ::setup/props)}
:pool (ig/ref ::db/pool)}
:app.rpc.doc/routes :app.rpc.doc/routes
{:methods (ig/ref :app.rpc/methods)} {:methods (ig/ref :app.rpc/methods)}

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

@ -139,15 +139,10 @@
(f cfg (us/conform spec params))) (f cfg (us/conform spec params)))
f))) f)))
;; TODO: integrate with sm/define
(defn- wrap-params-validation (defn- wrap-params-validation
[_ f mdata] [_ f mdata]
(if-let [schema (::sm/params mdata)] (if-let [schema (::sm/params mdata)]
(let [schema (if (sm/lazy-schema? schema) (let [validate (sm/validator schema)
schema
(sm/define schema))
validate (sm/validator schema)
explain (sm/explainer schema) explain (sm/explainer schema)
decode (sm/decoder schema)] decode (sm/decoder schema)]
(fn [cfg params] (fn [cfg params]
@ -245,8 +240,7 @@
::mtx/metrics ::mtx/metrics
::main/props] ::main/props]
:opt [::climit :opt [::climit
::rlimit] ::rlimit]))
:req-un [::db/pool]))
(defmethod ig/init-key ::methods (defmethod ig/init-key ::methods
[_ cfg] [_ cfg]

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

@ -21,26 +21,31 @@
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
[clojure.edn :as edn] [clojure.edn :as edn]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str]
[datoteka.fs :as fs] [datoteka.fs :as fs]
[integrant.core :as ig] [integrant.core :as ig]
[promesa.core :as p]
[promesa.exec :as px] [promesa.exec :as px]
[promesa.exec.bulkhead :as pbh]) [promesa.exec.bulkhead :as pbh])
(:import (:import
clojure.lang.ExceptionInfo)) clojure.lang.ExceptionInfo
java.util.concurrent.atomic.AtomicLong))
(set! *warn-on-reflection* true) (set! *warn-on-reflection* true)
(defn- id->str (defn- id->str
[id] ([id]
(-> (str id) (-> (str id)
(subs 1))) (subs 1)))
([id key]
(if key
(str (-> (str id) (subs 1)) "/" key)
(id->str id))))
(defn- create-cache (defn- create-cache
[{:keys [::wrk/executor]}] [{:keys [::wrk/executor]}]
(letfn [(on-remove [key _ cause] (letfn [(on-remove [key _ cause]
(let [[id skey] key] (let [[id skey] key]
(l/dbg :hint "destroy limiter" :id (id->str id) :key skey :reason (str cause))))] (l/dbg :hint "disposed" :id (id->str id skey) :reason (str cause))))]
(cache/create :executor executor (cache/create :executor executor
:on-remove on-remove :on-remove on-remove
:keepalive "5m"))) :keepalive "5m")))
@ -81,132 +86,179 @@
(defn- create-limiter (defn- create-limiter
[config [id skey]] [config [id skey]]
(l/dbg :hint "create limiter" :id (id->str id) :key skey) (l/dbg :hint "created" :id (id->str id skey))
(pbh/create :permits (or (:permits config) (:concurrency config)) (pbh/create :permits (or (:permits config) (:concurrency config))
:queue (or (:queue config) (:queue-size config)) :queue (or (:queue config) (:queue-size config))
:timeout (:timeout config) :timeout (:timeout config)
:type :semaphore)) :type :semaphore))
(defn- invoke! (defmacro ^:private measure-and-log!
[config cache metrics id key f] [metrics mlabels stats id action limit-id limit-label profile-id elapsed]
(if-let [limiter (cache/get cache [id key] (partial create-limiter config))] `(let [mpermits# (:max-permits ~stats)
(let [tpoint (dt/tpoint) mqueue# (:max-queue ~stats)
labels (into-array String [(id->str id)]) permits# (:permits ~stats)
wrapped (fn [] queue# (:queue ~stats)
(let [elapsed (tpoint) queue# (- queue# mpermits#)
stats (pbh/get-stats limiter)] queue# (if (neg? queue#) 0 queue#)
(l/trc :hint "acquired" level# (if (pos? queue#) :warn :trace)]
:id (id->str id)
:key key
:permits (:permits stats)
:queue (:queue stats)
:max-permits (:max-permits stats)
:max-queue (:max-queue stats)
:elapsed (dt/format-duration elapsed))
(mtx/run! metrics (mtx/run! ~metrics
:id :rpc-climit-timing :id :rpc-climit-queue
:val (inst-ms elapsed) :val queue#
:labels labels) :labels ~mlabels)
(try
(f)
(finally
(let [elapsed (tpoint)]
(l/trc :hint "finished"
:id (id->str id)
:key key
:permits (:permits stats)
:queue (:queue stats)
:max-permits (:max-permits stats)
:max-queue (:max-queue stats)
:elapsed (dt/format-duration elapsed)))))))
measure!
(fn [stats]
(mtx/run! metrics
:id :rpc-climit-queue
:val (:queue stats)
:labels labels)
(mtx/run! metrics
:id :rpc-climit-permits
:val (:permits stats)
:labels labels))]
(try (mtx/run! ~metrics
(let [stats (pbh/get-stats limiter)] :id :rpc-climit-permits
(measure! stats) :val permits#
(l/trc :hint "enqueued" :labels ~mlabels)
:id (id->str id)
:key key (l/log level#
:permits (:permits stats) :hint ~action
:queue (:queue stats) :req ~id
:max-permits (:max-permits stats) :id ~limit-id
:max-queue (:max-queue stats)) :label ~limit-label
(px/invoke! limiter wrapped)) :profile-id (str ~profile-id)
(catch ExceptionInfo cause :permits permits#
(let [{:keys [type code]} (ex-data cause)] :queue queue#
(if (= :bulkhead-error type) :max-permits mpermits#
:max-queue mqueue#
~@(if (some? elapsed)
[:elapsed `(dt/format-duration ~elapsed)]
[]))))
(def ^:private idseq (AtomicLong. 0))
(defn- invoke
[limiter metrics limit-id limit-key limit-label profile-id f params]
(let [tpoint (dt/tpoint)
limit-id (id->str limit-id limit-key)
mlabels (into-array String [limit-id])
stats (pbh/get-stats limiter)
id (.incrementAndGet ^AtomicLong idseq)]
(try
(measure-and-log! metrics mlabels stats id "enqueued" limit-id limit-label profile-id nil)
(px/invoke! limiter (fn []
(let [elapsed (tpoint)
stats (pbh/get-stats limiter)]
(measure-and-log! metrics mlabels stats id "acquired" limit-id limit-label profile-id elapsed)
(mtx/run! metrics
:id :rpc-climit-timing
:val (inst-ms elapsed)
:labels mlabels)
(apply f params))))
(catch ExceptionInfo cause
(let [{:keys [type code]} (ex-data cause)]
(if (= :bulkhead-error type)
(let [elapsed (tpoint)]
(measure-and-log! metrics mlabels stats id "reject" limit-id limit-label profile-id elapsed)
(ex/raise :type :concurrency-limit (ex/raise :type :concurrency-limit
:code code :code code
:hint "concurrency limit reached") :hint "concurrency limit reached"
(throw cause)))) :cause cause))
(throw cause))))
(finally (finally
(measure! (pbh/get-stats limiter))))) (let [elapsed (tpoint)
stats (pbh/get-stats limiter)]
(do (measure-and-log! metrics mlabels stats id "finished" limit-id limit-label profile-id elapsed))))))
(l/wrn :hint "no limiter found" :id (id->str id))
(f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MIDDLEWARE ;; MIDDLEWARE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def noop-fn (constantly nil)) (def ^:private noop-fn (constantly nil))
(def ^:private global-limits
[[:root/global noop-fn]
[:root/by-profile ::rpc/profile-id]])
(defn- get-limits
[cfg]
(when-let [ref (get cfg ::id)]
(cond
(keyword? ref)
[[ref]]
(and (vector? ref)
(keyword (first ref)))
[ref]
(and (vector? ref)
(vector? (first ref)))
(rseq ref)
:else
(throw (IllegalArgumentException. "unable to normalize limit")))))
(defn wrap (defn wrap
[{:keys [::rpc/climit ::mtx/metrics]} f {:keys [::id ::key-fn] :or {key-fn noop-fn} :as mdata}] [{:keys [::rpc/climit ::mtx/metrics]} handler mdata]
(if (and (some? climit) (some? id)) (let [cache (::cache climit)
(let [cache (::cache climit) config (::config climit)
config (::config climit)] label (::sv/name mdata)]
(if-let [config (get config id)]
(do
(l/dbg :hint "instrumenting method"
:limit (id->str id)
:service-name (::sv/name mdata)
:timeout (:timeout config)
:permits (:permits config)
:queue (:queue config)
:keyed? (not= key-fn noop-fn))
(fn [cfg params] (reduce (fn [handler [limit-id key-fn]]
(invoke! config cache metrics id (key-fn params) (partial f cfg params)))) (if-let [config (get config limit-id)]
(let [key-fn (or key-fn noop-fn)]
(l/dbg :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))
(do
(l/wrn :hint "no config found for specified queue" :id (id->str id))
f)))
f)) (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
(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))
profile-id (if (= key-fn ::rpc/profile-id)
limit-key
(get params ::rpc/profile-id))]
(invoke limiter metrics limit-id limit-key label profile-id handler [cfg params])))))
(do
(l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
handler)))
handler
(concat global-limits (get-limits mdata)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API ;; PUBLIC API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn configure (defn- build-exec-chain
[{:keys [::rpc/climit]} id] [{:keys [::label ::profile-id ::rpc/climit ::mtx/metrics] :as cfg} f]
(us/assert! ::rpc/climit climit) (let [config (get climit ::config)
(assoc climit ::id id)) cache (get climit ::cache)]
(defn run! (reduce (fn [handler [limit-id limit-key :as ckey]]
(let [config (get config limit-id)]
(when-not config
(throw (IllegalArgumentException.
(str/ffmt "config not found for: %" limit-id))))
(fn [& params]
(let [limiter (cache/get cache ckey (partial create-limiter config))]
(invoke limiter metrics limit-id limit-key label profile-id handler params)))))
f
(get-limits cfg))))
(defn invoke!
"Run a function in context of climit. "Run a function in context of climit.
Intended to be used in virtual threads." Intended to be used in virtual threads."
([{:keys [::id ::cache ::config ::mtx/metrics]} f] [{:keys [::executor] :as cfg} f & params]
(if-let [config (get config id)] (let [f (if (some? executor)
(invoke! config cache metrics id nil f) (fn [& params] (px/await! (px/submit! executor (fn [] (apply f params)))))
(f))) f)
f (build-exec-chain cfg f)]
([{:keys [::id ::cache ::config ::mtx/metrics]} f executor] (apply f params)))
(let [f #(p/await! (px/submit! executor f))]
(if-let [config (get config id)]
(invoke! config cache metrics id nil f)
(f)))))

58
backend/src/app/rpc/commands/auth.clj
View file

@ -21,6 +21,7 @@
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.main :as-alias main] [app.main :as-alias main]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.climit :as-alias climit]
[app.rpc.commands.profile :as profile] [app.rpc.commands.profile :as profile]
[app.rpc.commands.teams :as teams] [app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
@ -39,7 +40,7 @@
;; ---- COMMAND: login with password ;; ---- COMMAND: login with password
(defn login-with-password (defn login-with-password
[{:keys [::db/pool] :as cfg} {:keys [email password] :as params}] [cfg {:keys [email password] :as params}]
(when-not (or (contains? cf/flags :login) (when-not (or (contains? cf/flags :login)
(contains? cf/flags :login-with-password)) (contains? cf/flags :login-with-password))
@ -47,7 +48,7 @@
:code :login-disabled :code :login-disabled
:hint "login is disabled in this instance")) :hint "login is disabled in this instance"))
(letfn [(check-password [conn profile password] (letfn [(check-password [cfg profile password]
(if (= (:password profile) "!") (if (= (:password profile) "!")
(ex/raise :type :validation (ex/raise :type :validation
:code :account-without-password :code :account-without-password
@ -57,10 +58,10 @@
(l/trc :hint "updating profile password" (l/trc :hint "updating profile password"
:id (str (:id profile)) :id (str (:id profile))
:email (:email profile)) :email (:email profile))
(profile/update-profile-password! conn (assoc profile :password password))) (profile/update-profile-password! cfg (assoc profile :password password)))
(:valid result)))) (:valid result))))
(validate-profile [conn profile] (validate-profile [cfg profile]
(when-not profile (when-not profile
(ex/raise :type :validation (ex/raise :type :validation
:code :wrong-credentials)) :code :wrong-credentials))
@ -70,7 +71,7 @@
(when (:is-blocked profile) (when (:is-blocked profile)
(ex/raise :type :restriction (ex/raise :type :restriction
:code :profile-blocked)) :code :profile-blocked))
(when-not (check-password conn profile password) (when-not (check-password cfg profile password)
(ex/raise :type :validation (ex/raise :type :validation
:code :wrong-credentials)) :code :wrong-credentials))
(when-let [deleted-at (:deleted-at profile)] (when-let [deleted-at (:deleted-at profile)]
@ -78,27 +79,29 @@
(ex/raise :type :validation (ex/raise :type :validation
:code :wrong-credentials))) :code :wrong-credentials)))
profile)] profile)
(db/with-atomic [conn pool] (login [{:keys [::db/conn] :as cfg}]
(let [profile (->> (profile/get-profile-by-email conn email) (let [profile (->> (profile/get-profile-by-email conn email)
(validate-profile conn) (validate-profile cfg)
(profile/strip-private-attrs)) (profile/strip-private-attrs))
invitation (when-let [token (:invitation-token params)] invitation (when-let [token (:invitation-token params)]
(tokens/verify (::main/props cfg) {:token token :iss :team-invitation})) (tokens/verify (::main/props cfg) {:token token :iss :team-invitation}))
;; If invitation member-id does not matches the profile-id, we just proceed to ignore the ;; If invitation member-id does not matches the profile-id, we just proceed to ignore the
;; invitation because invitations matches exactly; and user can't login with other email and ;; invitation because invitations matches exactly; and user can't login with other email and
;; accept invitation with other email ;; accept invitation with other email
response (if (and (some? invitation) (= (:id profile) (:member-id invitation))) response (if (and (some? invitation) (= (:id profile) (:member-id invitation)))
{:invitation-token (:invitation-token params)} {:invitation-token (:invitation-token params)}
(assoc profile :is-admin (let [admins (cf/get :admins)] (assoc profile :is-admin (let [admins (cf/get :admins)]
(contains? admins (:email profile)))))] (contains? admins (:email profile)))))]
(-> response (-> response
(rph/with-transform (session/create-fn cfg (:id profile))) (rph/with-transform (session/create-fn cfg (:id profile)))
(rph/with-meta {::audit/props (audit/profile->props profile) (rph/with-meta {::audit/props (audit/profile->props profile)
::audit/profile-id (:id profile)})))))) ::audit/profile-id (:id profile)}))))]
(db/tx-run! cfg login)))
(def schema:login-with-password (def schema:login-with-password
[:map {:title "login-with-password"} [:map {:title "login-with-password"}
@ -110,6 +113,7 @@
"Performs authentication using penpot password." "Performs authentication using penpot password."
{::rpc/auth false {::rpc/auth false
::doc/added "1.15" ::doc/added "1.15"
::climit/id :auth/global
::sm/params schema:login-with-password} ::sm/params schema:login-with-password}
[cfg params] [cfg params]
(login-with-password cfg params)) (login-with-password cfg params))
@ -149,7 +153,8 @@
(sv/defmethod ::recover-profile (sv/defmethod ::recover-profile
{::rpc/auth false {::rpc/auth false
::doc/added "1.15" ::doc/added "1.15"
::sm/params schema:recover-profile} ::sm/params schema:recover-profile
::climit/id :auth/global}
[cfg params] [cfg params]
(recover-profile cfg params)) (recover-profile cfg params))
@ -360,7 +365,6 @@
{::audit/type "fact" {::audit/type "fact"
::audit/name "register-profile-retry" ::audit/name "register-profile-retry"
::audit/profile-id id})) ::audit/profile-id id}))
(cond (cond
;; If invitation token comes in params, this is because the ;; If invitation token comes in params, this is because the
;; user comes from team-invitation process; in this case, ;; user comes from team-invitation process; in this case,
@ -402,7 +406,6 @@
{::audit/replace-props (audit/profile->props profile) {::audit/replace-props (audit/profile->props profile)
::audit/profile-id (:id profile)}))))) ::audit/profile-id (:id profile)})))))
(def schema:register-profile (def schema:register-profile
[:map {:title "register-profile"} [:map {:title "register-profile"}
[:token schema:token] [:token schema:token]
@ -411,7 +414,8 @@
(sv/defmethod ::register-profile (sv/defmethod ::register-profile
{::rpc/auth false {::rpc/auth false
::doc/added "1.15" ::doc/added "1.15"
::sm/params schema:register-profile} ::sm/params schema:register-profile
::climit/id :auth/global}
[{:keys [::db/pool] :as cfg} params] [{:keys [::db/pool] :as cfg} params]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(-> (assoc cfg ::db/conn conn) (-> (assoc cfg ::db/conn conn)

457
backend/src/app/rpc/commands/comments.clj
View file

@ -9,7 +9,7 @@
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.geom.point :as gpt] [app.common.geom.point :as gpt]
[app.common.spec :as us] [app.common.schema :as sm]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.db.sql :as sql] [app.db.sql :as sql]
@ -24,18 +24,21 @@
[app.rpc.retry :as rtry] [app.rpc.retry :as rtry]
[app.util.pointer-map :as pmap] [app.util.pointer-map :as pmap]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]))
[clojure.spec.alpha :as s]))
;; --- GENERAL PURPOSE INTERNAL HELPERS ;; --- GENERAL PURPOSE INTERNAL HELPERS
(defn decode-row (defn- decode-row
[{:keys [participants position] :as row}] [{:keys [participants position] :as row}]
(cond-> row (cond-> row
(db/pgpoint? position) (assoc :position (db/decode-pgpoint position)) (db/pgpoint? position) (assoc :position (db/decode-pgpoint position))
(db/pgobject? participants) (assoc :participants (db/decode-transit-pgobject participants)))) (db/pgobject? participants) (assoc :participants (db/decode-transit-pgobject participants))))
(def sql:get-file (def xf-decode-row
(map decode-row))
(def ^:privateqpage-name
sql:get-file
"select f.id, f.modified_at, f.revn, f.features, "select f.id, f.modified_at, f.revn, f.features,
f.project_id, p.team_id, f.data f.project_id, p.team_id, f.data
from file as f from file as f
@ -45,17 +48,19 @@
(defn- get-file (defn- get-file
"A specialized version of get-file for comments module." "A specialized version of get-file for comments module."
[{:keys [::db/conn] :as cfg} file-id page-id] [cfg file-id page-id]
(if-let [{:keys [data] :as file} (some-> (db/exec-one! conn [sql:get-file file-id]) (let [file (db/exec-one! cfg [sql:get-file file-id])]
(files/decode-row))] (when-not file
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)] (ex/raise :type :not-found
(-> file :code :object-not-found
(assoc :page-name (dm/get-in data [:pages-index page-id :name])) :hint "file not found"))
(assoc :page-id page-id)))
(ex/raise :type :not-found (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
:code :object-not-found (let [{:keys [data] :as file} (files/decode-row file)]
:hint "file not found"))) (-> file
(assoc :page-name (dm/get-in data [:pages-index page-id :name]))
(assoc :page-id page-id)
(dissoc :data))))))
(defn- get-comment-thread (defn- get-comment-thread
[conn thread-id & {:as opts}] [conn thread-id & {:as opts}]
@ -93,23 +98,25 @@
(declare ^:private get-comment-threads) (declare ^:private get-comment-threads)
(s/def ::team-id ::us/uuid) (def ^:private
(s/def ::file-id ::us/uuid) schema:get-comment-threads
(s/def ::share-id (s/nilable ::us/uuid)) [:and
[:map {:title "get-comment-threads"}
(s/def ::get-comment-threads [:file-id {:optional true} ::sm/uuid]
(s/and (s/keys :req [::rpc/profile-id] [:team-id {:optional true} ::sm/uuid]
:opt-un [::file-id ::share-id ::team-id]) [:share-id {:optional true} [:maybe ::sm/uuid]]]
#(or (:file-id %) (:team-id %)))) [::sm/contains-any #{:file-id :team-id}]])
(sv/defmethod ::get-comment-threads (sv/defmethod ::get-comment-threads
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id share-id] :as params}] ::sm/params schema:get-comment-threads}
(dm/with-open [conn (db/open pool)] [cfg {:keys [::rpc/profile-id file-id share-id] :as params}]
(files/check-comment-permissions! conn profile-id file-id share-id)
(get-comment-threads conn profile-id file-id)))
(def sql:comment-threads (db/run! cfg (fn [{:keys [::db/conn]}]
(files/check-comment-permissions! conn profile-id file-id share-id)
(get-comment-threads conn profile-id file-id))))
(def ^:private sql:comment-threads
"select distinct on (ct.id) "select distinct on (ct.id)
ct.*, ct.*,
f.name as file_name, f.name as file_name,
@ -134,23 +141,24 @@
(defn- get-comment-threads (defn- get-comment-threads
[conn profile-id file-id] [conn profile-id file-id]
(->> (db/exec! conn [sql:comment-threads profile-id file-id]) (->> (db/exec! conn [sql:comment-threads profile-id file-id])
(into [] (map decode-row)))) (into [] xf-decode-row)))
;; --- COMMAND: Get Unread Comment Threads ;; --- COMMAND: Get Unread Comment Threads
(declare ^:private get-unread-comment-threads) (declare ^:private get-unread-comment-threads)
(s/def ::team-id ::us/uuid) (def ^:private
(s/def ::get-unread-comment-threads schema:get-unread-comment-threads
(s/keys :req [::rpc/profile-id] [:map {:title "get-unread-comment-threads"}
:req-un [::team-id])) [:team-id ::sm/uuid]])
(sv/defmethod ::get-unread-comment-threads (sv/defmethod ::get-unread-comment-threads
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}] ::sm/params schema:get-unread-comment-threads}
(dm/with-open [conn (db/open pool)] [cfg {:keys [::rpc/profile-id team-id] :as params}]
(teams/check-read-permissions! conn profile-id team-id) (db/run! cfg (fn [{:keys [::db/conn]}]
(get-unread-comment-threads conn profile-id team-id))) (teams/check-read-permissions! conn profile-id team-id)
(get-unread-comment-threads conn profile-id team-id))))
(def sql:comment-threads-by-team (def sql:comment-threads-by-team
"select distinct on (ct.id) "select distinct on (ct.id)
@ -182,62 +190,60 @@
(defn- get-unread-comment-threads (defn- get-unread-comment-threads
[conn profile-id team-id] [conn profile-id team-id]
(->> (db/exec! conn [sql:unread-comment-threads-by-team profile-id team-id]) (->> (db/exec! conn [sql:unread-comment-threads-by-team profile-id team-id])
(into [] (map decode-row)))) (into [] xf-decode-row)))
;; --- COMMAND: Get Single Comment Thread ;; --- COMMAND: Get Single Comment Thread
(s/def ::get-comment-thread (def ^:private
(s/keys :req [::rpc/profile-id] schema:get-comment-thread
:req-un [::file-id ::us/id] [:map {:title "get-comment-thread"}
:opt-un [::share-id])) [:file-id ::sm/uuid]
[:id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::get-comment-thread (sv/defmethod ::get-comment-thread
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id id share-id] :as params}] ::sm/params schema:get-comment-thread}
(dm/with-open [conn (db/open pool)] [cfg {:keys [::rpc/profile-id file-id id share-id] :as params}]
(files/check-comment-permissions! conn profile-id file-id share-id) (db/run! cfg (fn [{:keys [::db/conn]}]
(let [sql (str "with threads as (" sql:comment-threads ")" (files/check-comment-permissions! conn profile-id file-id share-id)
"select * from threads where id = ?")] (let [sql (str "with threads as (" sql:comment-threads ")"
(-> (db/exec-one! conn [sql profile-id file-id id]) "select * from threads where id = ?")]
(decode-row))))) (-> (db/exec-one! conn [sql profile-id file-id id])
(decode-row))))))
;; --- COMMAND: Retrieve Comments ;; --- COMMAND: Retrieve Comments
(declare ^:private get-comments) (declare ^:private get-comments)
(s/def ::thread-id ::us/uuid) (def ^:private
(s/def ::get-comments schema:get-comments
(s/keys :req [::rpc/profile-id] [:map {:title "get-comments"}
:req-un [::thread-id] [:thread-id ::sm/uuid]
:opt-un [::share-id])) [:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::get-comments (sv/defmethod ::get-comments
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id thread-id share-id] :as params}] ::sm/params schema:get-comments}
(dm/with-open [conn (db/open pool)] [cfg {:keys [::rpc/profile-id thread-id share-id]}]
(let [{:keys [file-id] :as thread} (get-comment-thread conn thread-id)] (db/run! cfg (fn [{:keys [::db/conn]}]
(files/check-comment-permissions! conn profile-id file-id share-id) (let [{:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
(get-comments conn thread-id)))) (files/check-comment-permissions! conn profile-id file-id share-id)
(get-comments conn thread-id)))))
(def sql:comments
"select c.* from comment as c
where c.thread_id = ?
order by c.created_at asc")
(defn- get-comments (defn- get-comments
[conn thread-id] [conn thread-id]
(->> (db/query conn :comment (->> (db/query conn :comment
{:thread-id thread-id} {:thread-id thread-id}
{:order-by [[:created-at :asc]]}) {:order-by [[:created-at :asc]]})
(into [] (map decode-row)))) (into [] xf-decode-row)))
;; --- COMMAND: Get file comments users ;; --- COMMAND: Get file comments users
;; All the profiles that had comment the file, plus the current ;; All the profiles that had comment the file, plus the current
;; profile. ;; profile.
(def sql:file-comment-users (def ^:private sql:file-comment-users
"WITH available_profiles AS ( "WITH available_profiles AS (
SELECT DISTINCT owner_id AS id SELECT DISTINCT owner_id AS id
FROM comment FROM comment
@ -256,20 +262,22 @@
[conn file-id profile-id] [conn file-id profile-id]
(db/exec! conn [sql:file-comment-users file-id profile-id])) (db/exec! conn [sql:file-comment-users file-id profile-id]))
(s/def ::get-profiles-for-file-comments (def ^:private
(s/keys :req [::rpc/profile-id] schema:get-profiles-for-file-comments
:req-un [::file-id] [:map {:title "get-profiles-for-file-comments"}
:opt-un [::share-id])) [:file-id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::get-profiles-for-file-comments (sv/defmethod ::get-profiles-for-file-comments
"Retrieves a list of profiles with limited set of properties of all "Retrieves a list of profiles with limited set of properties of all
participants on comment threads of the file." participants on comment threads of the file."
{::doc/added "1.15" {::doc/added "1.15"
::doc/changes ["1.15" "Imported from queries and renamed."]} ::doc/changes ["1.15" "Imported from queries and renamed."]
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id share-id]}] ::sm/params schema:get-profiles-for-file-comments}
(dm/with-open [conn (db/open pool)] [cfg {:keys [::rpc/profile-id file-id share-id]}]
(files/check-comment-permissions! conn profile-id file-id share-id) (db/run! cfg (fn [{:keys [::db/conn]}]
(get-file-comments-users conn file-id profile-id))) (files/check-comment-permissions! conn profile-id file-id share-id)
(get-file-comments-users conn file-id profile-id))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MUTATION COMMANDS ;; MUTATION COMMANDS
@ -279,52 +287,52 @@
;; --- COMMAND: Create Comment Thread ;; --- COMMAND: Create Comment Thread
(s/def ::page-id ::us/uuid) (def ^:private
(s/def ::position ::gpt/point) schema:create-comment-thread
(s/def ::content ::us/string) [:map {:title "create-comment-thread"}
(s/def ::frame-id ::us/uuid) [:file-id ::sm/uuid]
[:position ::gpt/point]
(s/def ::create-comment-thread [:content :string]
(s/keys :req [::rpc/profile-id] [:page-id ::sm/uuid]
:req-un [::file-id ::position ::content ::page-id ::frame-id] [:frame-id ::sm/uuid]
:opt-un [::share-id])) [:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::create-comment-thread (sv/defmethod ::create-comment-thread
{::doc/added "1.15" {::doc/added "1.15"
::webhooks/event? true} ::webhooks/event? true
::rtry/enabled true
::rtry/when rtry/conflict-exception?
::sm/params schema:create-comment-thread}
[cfg {:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}] [cfg {:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(files/check-comment-permissions! conn profile-id file-id share-id)
(let [{:keys [team-id project-id page-name] :as file} (get-file cfg file-id page-id)]
(run! (partial quotes/check-quote! conn) (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(list {::quotes/id ::quotes/comment-threads-per-file (files/check-comment-permissions! cfg profile-id file-id share-id)
::quotes/profile-id profile-id (let [{:keys [team-id project-id page-name]} (get-file conn file-id page-id)]
::quotes/team-id team-id
::quotes/project-id project-id
::quotes/file-id file-id}
{::quotes/id ::quotes/comments-per-file
::quotes/profile-id profile-id
::quotes/team-id team-id
::quotes/project-id project-id
::quotes/file-id file-id}))
(run! (partial quotes/check-quote! cfg)
(list {::quotes/id ::quotes/comment-threads-per-file
::quotes/profile-id profile-id
::quotes/team-id team-id
::quotes/project-id project-id
::quotes/file-id file-id}
{::quotes/id ::quotes/comments-per-file
::quotes/profile-id profile-id
::quotes/team-id team-id
::quotes/project-id project-id
::quotes/file-id file-id}))
(-> cfg (create-comment-thread conn {:created-at request-at
(assoc ::rtry/when rtry/conflict-exception?) :profile-id profile-id
(assoc ::rtry/label "create-comment-thread") :file-id file-id
(rtry/invoke create-comment-thread {:created-at request-at :page-id page-id
:profile-id profile-id :page-name page-name
:file-id file-id :position position
:page-id page-id :content content
:page-name page-name :frame-id frame-id})))))
:position position
:content content
:frame-id frame-id}))))))
(defn- create-comment-thread (defn- create-comment-thread
[{:keys [::db/conn]} {:keys [profile-id file-id page-id page-name created-at position content frame-id]}] [conn {:keys [profile-id file-id page-id page-name created-at position content frame-id]}]
(let [;; NOTE: we take the next seq number from a separate query because the whole (let [;; NOTE: we take the next seq number from a separate query because the whole
;; operation can be retried on conflict, and in this case the new seq shold be ;; operation can be retried on conflict, and in this case the new seq shold be
;; retrieved from the database. ;; retrieved from the database.
@ -364,68 +372,72 @@
;; --- COMMAND: Update Comment Thread Status ;; --- COMMAND: Update Comment Thread Status
(s/def ::id ::us/uuid) (def ^:private
(s/def ::share-id (s/nilable ::us/uuid)) schema:update-comment-thread-status
[:map {:title "update-comment-thread-status"}
(s/def ::update-comment-thread-status [:id ::sm/uuid]
(s/keys :req [::rpc/profile-id] [:share-id {:optional true} [:maybe ::sm/uuid]]])
:req-un [::id]
:opt-un [::share-id]))
(sv/defmethod ::update-comment-thread-status (sv/defmethod ::update-comment-thread-status
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}] ::sm/params schema:update-comment-thread-status}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id id share-id]}]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)] (db/tx-run! cfg (fn [{:keys [::db/conn]}]
(files/check-comment-permissions! conn profile-id file-id share-id) (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)]
(upsert-comment-thread-status! conn profile-id id)))) (files/check-comment-permissions! conn profile-id file-id share-id)
(upsert-comment-thread-status! conn profile-id id)))))
;; --- COMMAND: Update Comment Thread ;; --- COMMAND: Update Comment Thread
(s/def ::is-resolved ::us/boolean) (def ^:private
(s/def ::update-comment-thread schema:update-comment-thread
(s/keys :req [::rpc/profile-id] [:map {:title "update-comment-thread"}
:req-un [::id ::is-resolved] [:id ::sm/uuid]
:opt-un [::share-id])) [:is-resolved :boolean]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::update-comment-thread (sv/defmethod ::update-comment-thread
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id is-resolved share-id] :as params}] ::sm/params schema:update-comment-thread}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id id is-resolved share-id]}]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)] (db/tx-run! cfg (fn [{:keys [::db/conn]}]
(files/check-comment-permissions! conn profile-id file-id share-id) (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)]
(db/update! conn :comment-thread (files/check-comment-permissions! conn profile-id file-id share-id)
{:is-resolved is-resolved} (db/update! conn :comment-thread
{:id id}) {:is-resolved is-resolved}
nil))) {:id id})
nil))))
;; --- COMMAND: Add Comment ;; --- COMMAND: Add Comment
(declare ^:private get-comment-thread) (declare ^:private get-comment-thread)
(s/def ::create-comment (def ^:private
(s/keys :req [::rpc/profile-id] schema:create-comment
:req-un [::thread-id ::content] [:map {:title "create-comment"}
:opt-un [::share-id])) [:thread-id ::sm/uuid]
[:content :string]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::create-comment (sv/defmethod ::create-comment
{::doc/added "1.15" {::doc/added "1.15"
::webhooks/event? true} ::webhooks/event? true
::sm/params schema:create-comment}
[cfg {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content]}] [cfg {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content]}]
(db/tx-run! cfg (db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}] (fn [{:keys [::db/conn] :as cfg}]
(let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id ::sql/for-update true) (let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id ::sql/for-update true)
{:keys [team-id project-id page-name] :as file} (get-file cfg file-id page-id)] {:keys [team-id project-id page-name] :as file} (get-file cfg file-id page-id)]
(files/check-comment-permissions! conn profile-id (:id file) share-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(quotes/check-quote! conn (quotes/check-quote! conn
{::quotes/id ::quotes/comments-per-file {::quotes/id ::quotes/comments-per-file
::quotes/profile-id profile-id ::quotes/profile-id profile-id
::quotes/team-id team-id ::quotes/team-id team-id
::quotes/project-id project-id ::quotes/project-id project-id
::quotes/file-id (:id file)}) ::quotes/file-id file-id})
;; Update the page-name cached attribute on comment thread table. ;; Update the page-name cached attribute on comment thread table.
(when (not= page-name (:page-name thread)) (when (not= page-name (:page-name thread))
@ -461,15 +473,17 @@
;; --- COMMAND: Update Comment ;; --- COMMAND: Update Comment
(s/def ::update-comment (def ^:private
(s/keys :req [::rpc/profile-id] schema:update-comment
:req-un [::id ::content] [:map {:title "update-comment"}
:opt-un [::share-id])) [:id ::sm/uuid]
[:content :string]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::update-comment (sv/defmethod ::update-comment
{::doc/added "1.15"} {::doc/added "1.15"
::sm/params schema:update-comment}
[cfg {:keys [::rpc/profile-id ::rpc/request-at id share-id content]}] [cfg {:keys [::rpc/profile-id ::rpc/request-at id share-id content]}]
(db/tx-run! cfg (db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}] (fn [{:keys [::db/conn] :as cfg}]
(let [{:keys [thread-id owner-id] :as comment} (get-comment conn id ::sql/for-update true) (let [{:keys [thread-id owner-id] :as comment} (get-comment conn id ::sql/for-update true)
@ -482,7 +496,7 @@
(ex/raise :type :validation (ex/raise :type :validation
:code :not-allowed)) :code :not-allowed))
(let [{:keys [page-name] :as file} (get-file cfg file-id page-id)] (let [{:keys [page-name]} (get-file cfg file-id page-id)]
(db/update! conn :comment (db/update! conn :comment
{:content content {:content content
:modified-at request-at} :modified-at request-at}
@ -496,79 +510,90 @@
;; --- COMMAND: Delete Comment Thread ;; --- COMMAND: Delete Comment Thread
(s/def ::delete-comment-thread (def ^:private
(s/keys :req [::rpc/profile-id] schema:delete-comment-thread
:req-un [::id] [:map {:title "delete-comment-thread"}
:opt-un [::share-id])) [:id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::delete-comment-thread (sv/defmethod ::delete-comment-thread
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id]}] ::sm/params schema:delete-comment-thread}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id id share-id]}]
(let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)] (db/tx-run! cfg (fn [{:keys [::db/conn]}]
(files/check-comment-permissions! conn profile-id file-id share-id) (let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)]
(when-not (= owner-id profile-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(ex/raise :type :validation (when-not (= owner-id profile-id)
:code :not-allowed)) (ex/raise :type :validation
:code :not-allowed))
(db/delete! conn :comment-thread {:id id}) (db/delete! conn :comment-thread {:id id})
nil))) nil))))
;; --- COMMAND: Delete comment ;; --- COMMAND: Delete comment
(s/def ::delete-comment (def ^:private
(s/keys :req [::rpc/profile-id] schema:delete-comment
:req-un [::id] [:map {:title "delete-comment"}
:opt-un [::share-id])) [:id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::delete-comment (sv/defmethod ::delete-comment
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}] ::sm/params schema:delete-comment}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id id share-id]}]
(let [{:keys [owner-id thread-id] :as comment} (get-comment conn id ::sql/for-update true) (db/tx-run! cfg (fn [{:keys [::db/conn]}]
{:keys [file-id] :as thread} (get-comment-thread conn thread-id)] (let [{:keys [owner-id thread-id] :as comment} (get-comment conn id ::sql/for-update true)
(files/check-comment-permissions! conn profile-id file-id share-id) {:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
(when-not (= owner-id profile-id) (files/check-comment-permissions! conn profile-id file-id share-id)
(ex/raise :type :validation (when-not (= owner-id profile-id)
:code :not-allowed)) (ex/raise :type :validation
(db/delete! conn :comment {:id id}) :code :not-allowed))
nil))) (db/delete! conn :comment {:id id})
nil))))
;; --- COMMAND: Update comment thread position ;; --- COMMAND: Update comment thread position
(s/def ::update-comment-thread-position (def ^:private
(s/keys :req [::rpc/profile-id] schema:update-comment-thread-position
:req-un [::id ::position ::frame-id] [:map {:title "update-comment-thread-position"}
:opt-un [::share-id])) [:id ::sm/uuid]
[:position ::gpt/point]
[:frame-id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::update-comment-thread-position (sv/defmethod ::update-comment-thread-position
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id position frame-id share-id]}] ::sm/params schema:update-comment-thread-position}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id ::rpc/request-at id position frame-id share-id]}]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)] (db/tx-run! cfg (fn [{:keys [::db/conn]}]
(files/check-comment-permissions! conn profile-id file-id share-id) (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)]
(db/update! conn :comment-thread (files/check-comment-permissions! conn profile-id file-id share-id)
{:modified-at request-at (db/update! conn :comment-thread
:position (db/pgpoint position) {:modified-at request-at
:frame-id frame-id} :position (db/pgpoint position)
{:id (:id thread)}) :frame-id frame-id}
nil))) {:id (:id thread)})
nil))))
;; --- COMMAND: Update comment frame ;; --- COMMAND: Update comment frame
(s/def ::update-comment-thread-frame (def ^:private
(s/keys :req [::rpc/profile-id] schema:update-comment-thread-frame
:req-un [::id ::frame-id] [:map {:title "update-comment-thread-frame"}
:opt-un [::share-id])) [:id ::sm/uuid]
[:frame-id ::sm/uuid]
[:share-id {:optional true} [:maybe ::sm/uuid]]])
(sv/defmethod ::update-comment-thread-frame (sv/defmethod ::update-comment-thread-frame
{::doc/added "1.15"} {::doc/added "1.15"
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id frame-id share-id]}] ::sm/params schema:update-comment-thread-frame}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id ::rpc/request-at id frame-id share-id]}]
(let [{:keys [file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)] (db/tx-run! cfg (fn [{:keys [::db/conn]}]
(files/check-comment-permissions! conn profile-id file-id share-id) (let [{:keys [file-id] :as thread} (get-comment-thread conn id ::sql/for-update true)]
(db/update! conn :comment-thread (files/check-comment-permissions! conn profile-id file-id share-id)
{:modified-at request-at (db/update! conn :comment-thread
:frame-id frame-id} {:modified-at request-at
{:id id}) :frame-id frame-id}
nil))) {:id id})
nil))))

45
backend/src/app/rpc/commands/files_thumbnails.clj
View file

@ -285,26 +285,27 @@
(sv/defmethod ::create-file-object-thumbnail (sv/defmethod ::create-file-object-thumbnail
{::doc/added "1.19" {::doc/added "1.19"
::doc/module :files ::doc/module :files
::climit/id :file-thumbnail-ops ::climit/id [[:file-thumbnail-ops/by-profile ::rpc/profile-id]
::climit/key-fn ::rpc/profile-id [:file-thumbnail-ops/global]]
::rtry/enabled true
::rtry/when rtry/conflict-exception?
::audit/skip true ::audit/skip true
::sm/params schema:create-file-object-thumbnail} ::sm/params schema:create-file-object-thumbnail}
[cfg {:keys [::rpc/profile-id file-id object-id media tag]}] [cfg {:keys [::rpc/profile-id file-id object-id media tag]}]
(media/validate-media-type! media)
(media/validate-media-size! media)
(db/tx-run! cfg (db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}] (fn [{:keys [::db/conn] :as cfg}]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(media/validate-media-type! media)
(media/validate-media-size! media)
(when-not (db/read-only? conn) (when-not (db/read-only? conn)
(let [cfg (-> cfg (let [cfg (-> cfg
(update ::sto/storage media/configure-assets-storage) (update ::sto/storage media/configure-assets-storage)
(assoc ::rtry/when rtry/conflict-exception?) (assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 5) (assoc ::rtry/max-retries 5)
(assoc ::rtry/label "create-file-object-thumbnail"))] (assoc ::rtry/label "create-file-object-thumbnail"))]
(rtry/invoke cfg create-file-object-thumbnail! (create-file-object-thumbnail! cfg file-id object-id media (or tag "frame")))))))
file-id object-id media (or tag "frame")))))))
;; --- MUTATION COMMAND: delete-file-object-thumbnail ;; --- MUTATION COMMAND: delete-file-object-thumbnail
@ -329,8 +330,8 @@
{::doc/added "1.19" {::doc/added "1.19"
::doc/module :files ::doc/module :files
::doc/deprecated "1.20" ::doc/deprecated "1.20"
::climit/id :file-thumbnail-ops ::climit/id [[:file-thumbnail-ops/by-profile ::rpc/profile-id]
::climit/key-fn ::rpc/profile-id [:file-thumbnail-ops/global]]
::audit/skip true} ::audit/skip true}
[cfg {:keys [::rpc/profile-id file-id object-id]}] [cfg {:keys [::rpc/profile-id file-id object-id]}]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}] (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
@ -392,27 +393,29 @@
media)) media))
(def ^:private
schema:create-file-thumbnail
[:map {:title "create-file-thumbnail"}
[:file-id ::sm/uuid]
[:revn :int]
[:media ::media/upload]])
(sv/defmethod ::create-file-thumbnail (sv/defmethod ::create-file-thumbnail
"Creates or updates the file thumbnail. Mainly used for paint the "Creates or updates the file thumbnail. Mainly used for paint the
grid thumbnails." grid thumbnails."
{::doc/added "1.19" {::doc/added "1.19"
::doc/module :files ::doc/module :files
::audit/skip true ::audit/skip true
::climit/id :file-thumbnail-ops ::climit/id [[:file-thumbnail-ops/by-profile ::rpc/profile-id]
::climit/key-fn ::rpc/profile-id [:file-thumbnail-ops/global]]
::sm/params [:map {:title "create-file-thumbnail"} ::rtry/enabled true
[:file-id ::sm/uuid] ::rtry/when rtry/conflict-exception?
[:revn :int] ::sm/params schema:create-file-thumbnail}
[:media ::media/upload]]}
[cfg {:keys [::rpc/profile-id file-id] :as params}] [cfg {:keys [::rpc/profile-id file-id] :as params}]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}] (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(when-not (db/read-only? conn) (when-not (db/read-only? conn)
(let [cfg (-> cfg (let [cfg (update cfg ::sto/storage media/configure-assets-storage)
(update ::sto/storage media/configure-assets-storage) media (create-file-thumbnail! cfg params)]
(assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/max-retries 5)
(assoc ::rtry/label "create-thumbnail"))
media (rtry/invoke cfg create-file-thumbnail! params)]
{:uri (files/resolve-public-uri (:id media))}))))) {:uri (files/resolve-public-uri (:id media))})))))

18
backend/src/app/rpc/commands/files_update.clj
View file

@ -35,7 +35,8 @@
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
[clojure.set :as set])) [clojure.set :as set]
[promesa.exec :as px]))
;; --- SCHEMA ;; --- SCHEMA
@ -132,8 +133,8 @@
;; database. ;; database.
(sv/defmethod ::update-file (sv/defmethod ::update-file
{::climit/id :update-file/by-profile {::climit/id [[:update-file/by-profile ::rpc/profile-id]
::climit/key-fn ::rpc/profile-id [:update-file/global]]
::webhooks/event? true ::webhooks/event? true
::webhooks/batch-timeout (dt/duration "2m") ::webhooks/batch-timeout (dt/duration "2m")
::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id) ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
@ -232,13 +233,9 @@
(defn- update-file* (defn- update-file*
[{:keys [::db/conn ::wrk/executor] :as cfg} [{:keys [::db/conn ::wrk/executor] :as cfg}
{:keys [profile-id file changes session-id ::created-at skip-validate] :as params}] {:keys [profile-id file changes session-id ::created-at skip-validate] :as params}]
(let [;; Process the file data in the CLIMIT context; scheduling it (let [;; Process the file data on separated thread for avoid to do
;; to be executed on a separated executor for avoid to do the ;; the CPU intensive operation on vthread.
;; CPU intensive operation on vthread. file (px/invoke! executor (partial update-file-data cfg file changes skip-validate))]
update-fdata-fn (partial update-file-data cfg file changes skip-validate)
file (-> (climit/configure cfg :update-file/global)
(climit/run! update-fdata-fn executor))]
(db/insert! conn :file-change (db/insert! conn :file-change
{:id (uuid/next) {:id (uuid/next)
@ -306,7 +303,6 @@
(fmg/migrate-file)) (fmg/migrate-file))
file) file)
;; WARNING: this ruins performance; maybe we need to find ;; WARNING: this ruins performance; maybe we need to find
;; some other way to do general validation ;; some other way to do general validation
libs (when (and (or (contains? cf/flags :file-validation) libs (when (and (or (contains? cf/flags :file-validation)

13
backend/src/app/rpc/commands/fonts.clj
View file

@ -16,7 +16,7 @@
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.media :as media] [app.media :as media]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
[app.rpc.climit :as climit] [app.rpc.climit :as-alias climit]
[app.rpc.commands.files :as files] [app.rpc.commands.files :as files]
[app.rpc.commands.projects :as projects] [app.rpc.commands.projects :as projects]
[app.rpc.commands.teams :as teams] [app.rpc.commands.teams :as teams]
@ -26,7 +26,8 @@
[app.storage :as sto] [app.storage :as sto]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk])) [app.worker :as-alias wrk]
[promesa.exec :as px]))
(def valid-weight #{100 200 300 400 500 600 700 800 900 950}) (def valid-weight #{100 200 300 400 500 600 700 800 900 950})
(def valid-style #{"normal" "italic"}) (def valid-style #{"normal" "italic"})
@ -87,6 +88,8 @@
(sv/defmethod ::create-font-variant (sv/defmethod ::create-font-variant
{::doc/added "1.18" {::doc/added "1.18"
::climit/id [[:process-font/by-profile ::rpc/profile-id]
[:process-font/global]]
::webhooks/event? true ::webhooks/event? true
::sm/params schema:create-font-variant} ::sm/params schema:create-font-variant}
[cfg {:keys [::rpc/profile-id team-id] :as params}] [cfg {:keys [::rpc/profile-id team-id] :as params}]
@ -100,7 +103,7 @@
(create-font-variant cfg (assoc params :profile-id profile-id)))))) (create-font-variant cfg (assoc params :profile-id profile-id))))))
(defn create-font-variant (defn create-font-variant
[{:keys [::sto/storage ::db/conn] :as cfg} {:keys [data] :as params}] [{:keys [::sto/storage ::db/conn ::wrk/executor]} {:keys [data] :as params}]
(letfn [(generate-missing! [data] (letfn [(generate-missing! [data]
(let [data (media/run {:cmd :generate-fonts :input data})] (let [data (media/run {:cmd :generate-fonts :input data})]
(when (and (not (contains? data "font/otf")) (when (and (not (contains? data "font/otf"))
@ -152,9 +155,7 @@
:otf-file-id (:id otf) :otf-file-id (:id otf)
:ttf-file-id (:id ttf)}))] :ttf-file-id (:id ttf)}))]
(let [data (-> (climit/configure cfg :process-font/global) (let [data (px/invoke! executor (partial generate-missing! data))
(climit/run! (partial generate-missing! data)
(::wrk/executor cfg)))
assets (persist-fonts-files! data) assets (persist-fonts-files! data)
result (insert-font-variant! assets)] result (insert-font-variant! assets)]
(vary-meta result assoc ::audit/replace-props (update params :data (comp vec keys)))))) (vary-meta result assoc ::audit/replace-props (update params :data (comp vec keys))))))

45
backend/src/app/rpc/commands/media.clj
View file

@ -27,7 +27,8 @@
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.io :as io])) [datoteka.io :as io]
[promesa.exec :as px]))
(def default-max-file-size (def default-max-file-size
(* 1024 1024 10)) ; 10 MiB (* 1024 1024 10)) ; 10 MiB
@ -56,20 +57,25 @@
:opt-un [::id])) :opt-un [::id]))
(sv/defmethod ::upload-file-media-object (sv/defmethod ::upload-file-media-object
{::doc/added "1.17"} {::doc/added "1.17"
::climit/id [[:process-image/by-profile ::rpc/profile-id]
[:process-image/global]]}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id) (files/check-edition-permissions! pool profile-id file-id)
(media/validate-media-type! content) (media/validate-media-type! content)
(media/validate-media-size! content) (media/validate-media-size! content)
(let [object (db/run! cfg #(create-file-media-object % params))
props {:name (:name params) (db/run! cfg (fn [cfg]
:file-id file-id (let [object (create-file-media-object cfg params)
:is-local (:is-local params) props {:name (:name params)
:size (:size content) :file-id file-id
:mtype (:mtype content)}] :is-local (:is-local params)
(with-meta object :size (:size content)
{::audit/replace-props props})))) :mtype (:mtype content)}]
(with-meta object
{::audit/replace-props props}))))))
(defn- big-enough-for-thumbnail? (defn- big-enough-for-thumbnail?
"Checks if the provided image info is big enough for "Checks if the provided image info is big enough for
@ -144,12 +150,10 @@
(assoc ::image (process-main-image info))))) (assoc ::image (process-main-image info)))))
(defn create-file-media-object (defn create-file-media-object
[{:keys [::sto/storage ::db/conn ::wrk/executor] :as cfg} [{:keys [::sto/storage ::db/conn ::wrk/executor]}
{:keys [id file-id is-local name content]}] {:keys [id file-id is-local name content]}]
(let [result (-> (climit/configure cfg :process-image/global) (let [result (px/invoke! executor (partial process-image content))
(climit/run! (partial process-image content) executor))
image (sto/put-object! storage (::image result)) image (sto/put-object! storage (::image result))
thumb (when-let [params (::thumb result)] thumb (when-let [params (::thumb result)]
(sto/put-object! storage params))] (sto/put-object! storage params))]
@ -183,7 +187,7 @@
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)] (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
(files/check-edition-permissions! pool profile-id file-id) (files/check-edition-permissions! pool profile-id file-id)
(db/run! cfg #(create-file-media-object-from-url % params)))) (create-file-media-object-from-url cfg (assoc params :profile-id profile-id))))
(defn download-image (defn download-image
[{:keys [::http/client]} uri] [{:keys [::http/client]} uri]
@ -235,7 +239,16 @@
params (-> params params (-> params
(assoc :content content) (assoc :content content)
(assoc :name (or name (:filename content))))] (assoc :name (or name (:filename content))))]
(create-file-media-object cfg params)))
;; NOTE: we use the climit here in a dynamic invocation because we
;; don't want saturate the process-image limit with IO (download
;; of external image)
(-> cfg
(assoc ::climit/id [[:process-image/by-profile (:profile-id params)]
[:process-image/global]])
(assoc ::climit/profile-id (:profile-id params))
(assoc ::climit/label "create-file-media-object-from-url")
(climit/invoke! db/run! cfg create-file-media-object params))))
;; --- Clone File Media object (Upload and create from url) ;; --- Clone File Media object (Upload and create from url)

56
backend/src/app/rpc/commands/profile.clj
View file

@ -28,7 +28,8 @@
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
[cuerdas.core :as str])) [cuerdas.core :as str]
[promesa.exec :as px]))
(declare check-profile-existence!) (declare check-profile-existence!)
(declare decode-row) (declare decode-row)
@ -137,25 +138,24 @@
[:old-password {:optional true} [:maybe [::sm/word-string {:max 500}]]]])) [:old-password {:optional true} [:maybe [::sm/word-string {:max 500}]]]]))
(sv/defmethod ::update-profile-password (sv/defmethod ::update-profile-password
{:doc/added "1.0" {::doc/added "1.0"
::sm/params schema:update-profile-password ::sm/params schema:update-profile-password
::sm/result :nil} ::climit/id :auth/global}
[cfg {:keys [::rpc/profile-id password] :as params}]
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id password] :as params}] (db/tx-run! cfg (fn [cfg]
(db/with-atomic [conn pool] (let [profile (validate-password! cfg (assoc params :profile-id profile-id))
(let [cfg (assoc cfg ::db/conn conn) session-id (::session/id params)]
profile (validate-password! cfg (assoc params :profile-id profile-id))
session-id (::session/id params)]
(when (= (str/lower (:email profile)) (when (= (str/lower (:email profile))
(str/lower (:password params))) (str/lower (:password params)))
(ex/raise :type :validation (ex/raise :type :validation
:code :email-as-password :code :email-as-password
:hint "you can't use your email as password")) :hint "you can't use your email as password"))
(update-profile-password! conn (assoc profile :password password)) (update-profile-password! cfg (assoc profile :password password))
(invalidate-profile-session! cfg profile-id session-id) (invalidate-profile-session! cfg profile-id session-id)
nil))) nil))))
(defn- invalidate-profile-session! (defn- invalidate-profile-session!
"Removes all sessions except the current one." "Removes all sessions except the current one."
@ -173,10 +173,10 @@
profile)) profile))
(defn update-profile-password! (defn update-profile-password!
[conn {:keys [id password] :as profile}] [{:keys [::db/conn] :as cfg} {:keys [id password] :as profile}]
(when-not (db/read-only? conn) (when-not (db/read-only? conn)
(db/update! conn :profile (db/update! conn :profile
{:password (auth/derive-password password)} {:password (derive-password cfg password)}
{:id id}) {:id id})
nil)) nil))
@ -203,6 +203,7 @@
(defn update-profile-photo (defn update-profile-photo
[{:keys [::db/pool ::sto/storage] :as cfg} {:keys [profile-id file] :as params}] [{:keys [::db/pool ::sto/storage] :as cfg} {:keys [profile-id file] :as params}]
(let [photo (upload-photo cfg params) (let [photo (upload-photo cfg params)
profile (db/get-by-id pool :profile profile-id ::sql/for-update true)] profile (db/get-by-id pool :profile profile-id ::sql/for-update true)]
@ -241,8 +242,11 @@
(defn upload-photo (defn upload-photo
[{:keys [::sto/storage ::wrk/executor] :as cfg} {:keys [file]}] [{:keys [::sto/storage ::wrk/executor] :as cfg} {:keys [file]}]
(let [params (-> (climit/configure cfg :process-image/global) (let [params (-> cfg
(climit/run! (partial generate-thumbnail! file) executor))] (assoc ::climit/id :process-image/global)
(assoc ::climit/label "upload-photo")
(assoc ::climit/executor executor)
(climit/invoke! generate-thumbnail! file))]
(sto/put-object! storage params))) (sto/put-object! storage params)))
@ -438,17 +442,13 @@
(into {} (filter (fn [[k _]] (simple-ident? k))) props)) (into {} (filter (fn [[k _]] (simple-ident? k))) props))
(defn derive-password (defn derive-password
[cfg password] [{:keys [::wrk/executor]} password]
(when password (when password
(-> (climit/configure cfg :derive-password/global) (px/invoke! executor (partial auth/derive-password password))))
(climit/run! (partial auth/derive-password password)
(::wrk/executor cfg)))))
(defn verify-password (defn verify-password
[cfg password password-data] [{:keys [::wrk/executor]} password password-data]
(-> (climit/configure cfg :derive-password/global) (px/invoke! executor (partial auth/verify-password password password-data)))
(climit/run! (partial auth/verify-password password password-data)
(::wrk/executor cfg))))
(defn decode-row (defn decode-row
[{:keys [props] :as row}] [{:keys [props] :as row}]

46
backend/src/app/rpc/quotes.clj
View file

@ -7,8 +7,10 @@
(ns app.rpc.quotes (ns app.rpc.quotes
"Penpot resource usage quotes." "Penpot resource usage quotes."
(:require (:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.schema :as sm]
[app.common.spec :as us] [app.common.spec :as us]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
@ -23,21 +25,15 @@
;; PUBLIC API ;; PUBLIC API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::conn ::db/pool-or-conn) (def ^:private schema:quote
(s/def ::file-id ::us/uuid) (sm/define
(s/def ::team-id ::us/uuid) [:map {:title "Quote"}
(s/def ::project-id ::us/uuid) [::team-id {:optional true} ::sm/uuid]
(s/def ::profile-id ::us/uuid) [::project-id {:optional true} ::sm/uuid]
(s/def ::incr (s/and int? pos?)) [::file-id {:optional true} ::sm/uuid]
(s/def ::target ::us/string) [::incr {:optional true} [:int {:min 0}]]
[::id :keyword]
(s/def ::quote [::profile-id ::sm/uuid]]))
(s/keys :req [::id ::profile-id]
:opt [::conn
::team-id
::project-id
::file-id
::incr]))
(def ^:private enabled (volatile! true)) (def ^:private enabled (volatile! true))
@ -52,15 +48,22 @@
(vswap! enabled (constantly false))) (vswap! enabled (constantly false)))
(defn check-quote! (defn check-quote!
[conn quote] [ds quote]
(us/assert! ::db/pool-or-conn conn) (dm/assert!
(us/assert! ::quote quote) "expected valid quote map"
(sm/validate schema:quote quote))
(when (contains? cf/flags :quotes) (when (contains? cf/flags :quotes)
(when @enabled (when @enabled
(check-quote (assoc quote ::conn conn ::target (name (::id quote))))))) ;; This approach add flexibility on how and where the
;; check-quote! can be called (in or out of transaction)
(db/run! ds (fn [cfg]
(-> (merge cfg quote)
(assoc ::target (name (::id quote)))
(check-quote)))))))
(defn- send-notification! (defn- send-notification!
[{:keys [::conn] :as params}] [{:keys [::db/conn] :as params}]
(l/warn :hint "max quote reached" (l/warn :hint "max quote reached"
:target (::target params) :target (::target params)
:profile-id (some-> params ::profile-id str) :profile-id (some-> params ::profile-id str)
@ -93,7 +96,7 @@
:content content}]})))) :content content}]}))))
(defn- generic-check! (defn- generic-check!
[{:keys [::conn ::incr ::quote-sql ::count-sql ::default ::target] :or {incr 1} :as params}] [{:keys [::db/conn ::incr ::quote-sql ::count-sql ::default ::target] :or {incr 1} :as params}]
(let [quote (->> (db/exec! conn quote-sql) (let [quote (->> (db/exec! conn quote-sql)
(map :quote) (map :quote)
(reduce max (- Integer/MAX_VALUE))) (reduce max (- Integer/MAX_VALUE)))
@ -347,7 +350,6 @@
(assoc ::count-sql [sql:get-comments-per-file file-id]) (assoc ::count-sql [sql:get-comments-per-file file-id])
(generic-check!))) (generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: DEFAULT ;; QUOTE: DEFAULT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

59
backend/src/app/rpc/retry.clj
View file

@ -6,8 +6,8 @@
(ns app.rpc.retry (ns app.rpc.retry
(:require (:require
[app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.db :as db]
[app.util.services :as sv]) [app.util.services :as sv])
(:import (:import
org.postgresql.util.PSQLException)) org.postgresql.util.PSQLException))
@ -15,12 +15,29 @@
(defn conflict-exception? (defn conflict-exception?
"Check if exception matches a insertion conflict on postgresql." "Check if exception matches a insertion conflict on postgresql."
[e] [e]
(and (instance? PSQLException e) (when-let [cause (ex/instance? PSQLException e)]
(= "23505" (.getSQLState ^PSQLException e)))) (= "23505" (.getSQLState ^PSQLException cause))))
(def ^:private always-false (def ^:private always-false
(constantly false)) (constantly false))
(defn invoke!
[{:keys [::max-retries] :or {max-retries 3} :as cfg} f & args]
(loop [rnum 1]
(let [match? (get cfg ::when always-false)
result (try
(apply f cfg args)
(catch Throwable cause
(if (and (match? cause) (<= rnum max-retries))
::retry
(throw cause))))]
(if (= ::retry result)
(let [label (get cfg ::label "anonymous")]
(l/warn :hint "retrying operation" :label label :retry rnum)
(recur (inc rnum)))
result))))
(defn wrap-retry (defn wrap-retry
[_ f {:keys [::sv/name] :as mdata}] [_ f {:keys [::sv/name] :as mdata}]
@ -29,36 +46,10 @@
matches? (get mdata ::when always-false)] matches? (get mdata ::when always-false)]
(l/dbg :hint "wrapping retry" :name name :max-retries max-retries) (l/dbg :hint "wrapping retry" :name name :max-retries max-retries)
(fn [cfg params] (fn [cfg params]
((fn recursive-invoke [retry] (-> cfg
(try (assoc ::max-retries max-retries)
(f cfg params) (assoc ::when matches?)
(catch Throwable cause (assoc ::label name)
(if (matches? cause) (invoke! f params))))
(let [current-retry (inc retry)]
(l/wrn :hint "retrying operation" :retry current-retry :service name)
(if (<= current-retry max-retries)
(recursive-invoke current-retry)
(throw cause)))
(throw cause))))) 1)))
f)) f))
(defn invoke
[{:keys [::db/conn ::max-retries] :or {max-retries 3} :as cfg} f & args]
(assert (db/connection? conn) "invalid database connection")
(loop [rnum 1]
(let [match? (get cfg ::when always-false)
result (let [spoint (db/savepoint conn)]
(try
(let [result (apply f cfg args)]
(db/release! conn spoint)
result)
(catch Throwable cause
(db/rollback! conn spoint)
(if (and (match? cause) (<= rnum max-retries))
::retry
(throw cause)))))]
(if (= ::retry result)
(let [label (get cfg ::label "anonymous")]
(l/warn :hint "retrying operation" :label label :retry rnum)
(recur (inc rnum)))
result))))

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

@ -71,6 +71,7 @@
:enable-email-verification :enable-email-verification
:enable-smtp :enable-smtp
:enable-quotes :enable-quotes
:enable-rpc-climit
:enable-feature-fdata-pointer-map :enable-feature-fdata-pointer-map
:enable-feature-fdata-objets-map :enable-feature-fdata-objets-map
:enable-feature-components-v2 :enable-feature-components-v2

7
common/src/app/common/exceptions.cljc
View file

@ -74,10 +74,9 @@
[class cause] [class cause]
(loop [cause cause] (loop [cause cause]
(if (c/instance? class cause) (if (c/instance? class cause)
true cause
(if-let [cause (ex-cause cause)] (when-let [cause (ex-cause cause)]
(recur cause) (recur cause))))))
false)))))
;; NOTE: idea for a macro for error handling ;; NOTE: idea for a macro for error handling
;; (pu/try-let [cause (p/await (get-object-data backend object))] ;; (pu/try-let [cause (p/await (get-object-data backend object))]

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

@ -319,6 +319,12 @@
::message (delay ~message)}) ::message (delay ~message)})
nil))) nil)))
(defmacro log
[level & params]
`(do
(log! ::logger ~(str *ns*) ::level ~level ~@params)
nil))
(defmacro info (defmacro info
[& params] [& params]
`(do `(do

14
frontend/src/app/main/ui/dashboard/pin_button.cljs
View file

@ -12,15 +12,21 @@
(:require (:require
[app.main.ui.icons :as i] [app.main.ui.icons :as i]
[app.util.i18n :as i18n :refer [tr]] [app.util.i18n :as i18n :refer [tr]]
[app.util.object :as obj]
[rumext.v2 :as mf])) [rumext.v2 :as mf]))
(def pin-icon (icon-xref :pin-refactor (stl/css :icon))) (def ^:private pin-icon
(icon-xref :pin-refactor (stl/css :icon)))
(mf/defc pin-button* (mf/defc pin-button*
{::mf/props :obj} {::mf/props :obj}
[{:keys [aria-label is-pinned class] :as props}] [{:keys [aria-label is-pinned class] :as props}]
(let [aria-label (or aria-label (tr "dashboard.pin-unpin")) (let [aria-label (or aria-label (tr "dashboard.pin-unpin"))
class (dm/str (or class "") " " (stl/css-case :button true :button-active is-pinned)) class (dm/str (or class "") " " (stl/css-case :button true :button-active is-pinned))
props (mf/spread-props props {:class class
:aria-label aria-label})] props (-> (obj/clone props)
[:> "button" props pin-icon])) (obj/unset! "isPinned")
(obj/set! "className" class)
(obj/set! "aria-label" aria-label))]
[:> "button" props pin-icon]))