🎉 Add generic retry middleware for rpc methods.

backend/src/app/rpc.clj

@@ -14,6 +14,7 @@
    [app.loggers.audit :as audit]
    [app.metrics :as mtx]
    [app.rlimits :as rlm]
+   [app.util.retry :as retry]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
@@ -92,6 +93,7 @@
 (defn- wrap-impl
   [{:keys [audit] :as cfg} f mdata]
   (let [f      (wrap-with-rlimits cfg f mdata)
+        f      (retry/wrap-retry cfg f mdata)
         f      (wrap-with-metrics cfg f mdata)
         spec   (or (::sv/spec mdata) (s/spec any?))
         auth?  (:auth mdata true)]
@@ -99,7 +101,6 @@
     (l/trace :action "register" :name (::sv/name mdata))
     (with-meta
       (fn [params]
-
         ;; Raise authentication error when rpc method requires auth but
         ;; no profile-id is found in the request.
         (when (and auth? (not (uuid? (:profile-id params))))

backend/src/app/rpc/mutations/comments.clj

@@ -12,6 +12,9 @@
    [app.rpc.queries.comments :as comments]
    [app.rpc.queries.files :as files]
    [app.util.blob :as blob]
+   #_:clj-kondo/ignore
+   [app.util.retry :as retry]
+
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
@@ -32,6 +35,9 @@
   (s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id]))
 
 (sv/defmethod ::create-comment-thread
+  {::retry/enabled true
+   ::retry/max-retries 3
+   ::retry/matches retry/conflict-db-insert?}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-read-permissions! conn profile-id file-id)
@@ -43,7 +49,7 @@
         res (db/exec-one! conn [sql file-id])]
     (:next-seqn res)))
 
-(defn- create-comment-thread*
+(defn- create-comment-thread
   [conn {:keys [profile-id file-id page-id position content] :as params}]
   (let [seqn    (retrieve-next-seqn conn file-id)
         now     (dt/now)
@@ -78,24 +84,6 @@
 
     (select-keys thread [:id :file-id :page-id])))
 
-(defn- create-comment-thread
-  [conn params]
-  (loop [sp (db/savepoint conn)
-         rc 0]
-    (let [res (ex/try (create-comment-thread* conn params))]
-      (cond
-        (and (instance? Throwable res)
-             (< rc 3))
-        (do
-          (db/rollback! conn sp)
-          (recur (db/savepoint conn)
-                 (inc rc)))
-
-        (instance? Throwable res)
-        (throw res)
-
-        :else res))))
-
 (defn- retrieve-page-name
   [conn {:keys [file-id page-id]}]
   (let [{:keys [data]} (db/get-by-id conn :file file-id)

backend/src/app/util/retry.clj

@@ -0,0 +1,43 @@
+;; 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) UXBOX Labs SL
+
+(ns app.util.retry
+  "A fault tolerance helpers. Allow retry some operations that we know
+  we can retry."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.util.async :as aa]
+   [app.util.services :as sv]))
+
+(defn conflict-db-insert?
+  "Check if exception matches a insertion conflict on postgresql."
+  [e]
+  (and (instance? org.postgresql.util.PSQLException e)
+       (= "23505" (.getSQLState e))))
+
+(defn wrap-retry
+  [_ f {:keys [::max-retries ::matches ::sv/name]
+        :or {max-retries 3
+             matches (constantly false)}
+        :as mdata}]
+  (when (::enabled mdata)
+    (l/debug :hint "wrapping retry" :name name))
+  (if (::enabled mdata)
+    (fn [cfg params]
+      (loop [retry 1]
+        (when (> retry 1)
+          (l/debug :hint "retrying controlled function" :retry retry :name name))
+        (let [res (ex/try (f cfg params))]
+          (if (ex/exception? res)
+            (if (and (matches res) (< retry max-retries))
+              (do
+                (aa/thread-sleep (* 100 retry))
+                (recur (inc retry)))
+              (throw res))
+            res))))
+    f))
+