✨ Add generic (blocking) retry macro

And use it on audit handling

backend/src/app/loggers/audit.clj

@@ -21,6 +21,7 @@
    [app.main :as-alias main]
    [app.metrics :as mtx]
    [app.tokens :as tokens]
+   [app.util.retry :as rtry]
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
@@ -143,22 +144,29 @@
 (defn- persist-event!
   [pool event]
   (us/verify! ::event event)
-  (let [now    (dt/now)
-        params {:id (uuid/next)
+  (let [params {:id (uuid/next)
                 :name (:name event)
                 :type (:type event)
                 :profile-id (:profile-id event)
-                :created-at now
-                :tracked-at now
                 :ip-addr (:ip-addr event)
                 :props (:props event)}]
 
     (when (contains? cf/flags :audit-log)
-      (db/insert! pool :audit-log
-                  (-> params
-                      (update :props db/tjson)
-                      (update :ip-addr db/inet)
-                      (assoc :source "backend"))))
+
+      ;; 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.
+      (rtry/with-retry {::rtry/when rtry/conflict-exception?
+                        ::rtry/max-retries 6
+                        ::rtry/label "persist-audit-log-event"}
+        (let [now (dt/now)]
+          (db/insert! pool :audit-log
+                      (-> params
+                          (update :props db/tjson)
+                          (update :ip-addr db/inet)
+                          (assoc :created-at now)
+                          (assoc :tracked-at now)
+                          (assoc :source "backend"))))))
 
     (when (and (contains? cf/flags :webhooks)
                (::webhooks/event? event))

backend/src/app/rpc/retry.clj

@@ -5,23 +5,23 @@
 ;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.retry
-  "A fault tolerance helpers. Allow retry some operations that we know
-  we can retry."
+  "A fault tolerance RPC middleware. Allow retry some operations that we
+  know we can retry."
   (:require
    [app.common.logging :as l]
+   [app.util.retry :refer [conflict-exception?]]
    [app.util.services :as sv]
    [promesa.core :as p]))
 
 (defn conflict-db-insert?
   "Check if exception matches a insertion conflict on postgresql."
   [e]
-  (and (instance? org.postgresql.util.PSQLException e)
-       (= "23505" (.getSQLState e))))
+  (conflict-exception? e))
+
+(def always-false (constantly false))
 
 (defn wrap-retry
-  [_ f {:keys [::matches ::sv/name]
-        :or {matches (constantly false)}
-        :as mdata}]
+  [_ f {:keys [::matches ::sv/name] :or {matches always-false} :as mdata}]
 
   (when (::enabled mdata)
     (l/debug :hint "wrapping retry" :name name))
@@ -29,8 +29,8 @@
   (if-let [max-retries (::max-retries mdata)]
     (fn [cfg params]
       (letfn [(run [retry]
-                (-> (f cfg params)
-                    (p/catch (partial handle-error retry))))
+                (->> (f cfg params)
+                     (p/merr (partial handle-error retry))))
 
               (handle-error [retry cause]
                 (if (matches cause)
@@ -40,6 +40,6 @@
                       (run current-retry)
                       (throw cause)))
                   (throw cause)))]
-        (run 0)))
+        (run 1)))
     f))
 

backend/src/app/util/retry.clj

@@ -0,0 +1,34 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.util.retry
+  "A fault tolerance helpers. Allow retry some operations that we know
+  we can retry."
+  (:require
+   [app.common.logging :as l])
+  (:import
+   org.postgresql.util.PSQLException))
+
+(defn conflict-exception?
+  "Check if exception matches a insertion conflict on postgresql."
+  [e]
+  (and (instance? PSQLException e)
+       (= "23505" (.getSQLState ^PSQLException e))))
+
+(defmacro with-retry
+  [{:keys [::when ::max-retries ::label] :or {max-retries 3}} & body]
+  `(loop [tnum# 1]
+     (let [result# (try
+                     ~@body
+                     (catch Throwable cause#
+                       (if (and (~when cause#) (<= tnum# ~max-retries))
+                         ::retry
+                         (throw cause#))))]
+       (if (= ::retry result#)
+         (do
+           (l/warn :hint "retrying operation" :label ~label)
+           (recur (inc tnum#)))
+         result#))))