0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-01-07 15:39:42 -05:00

Improve internal API of retry mechanism

This commit is contained in:
Andrey Antukh 2024-01-26 15:09:01 +01:00
parent 16a051d7e0
commit dabb9d0a82
3 changed files with 38 additions and 51 deletions

View file

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

View file

@ -6,8 +6,8 @@
(ns app.rpc.retry
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.db :as db]
[app.util.services :as sv])
(:import
org.postgresql.util.PSQLException))
@ -15,12 +15,29 @@
(defn conflict-exception?
"Check if exception matches a insertion conflict on postgresql."
[e]
(and (instance? PSQLException e)
(= "23505" (.getSQLState ^PSQLException e))))
(when-let [cause (ex/instance? PSQLException e)]
(= "23505" (.getSQLState ^PSQLException cause))))
(def ^:private always-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
[_ f {:keys [::sv/name] :as mdata}]
@ -29,36 +46,10 @@
matches? (get mdata ::when always-false)]
(l/dbg :hint "wrapping retry" :name name :max-retries max-retries)
(fn [cfg params]
((fn recursive-invoke [retry]
(try
(f cfg params)
(catch Throwable cause
(if (matches? cause)
(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)))
(-> cfg
(assoc ::max-retries max-retries)
(assoc ::when matches?)
(assoc ::label name)
(invoke! f params))))
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))))

View file

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