From 853be27780cd4ece697baa3e66b74f40818ba0bc Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Thu, 5 Jan 2023 13:21:45 +0100
Subject: [PATCH] :bug: Fix issues on database logger

---
 backend/src/app/loggers/database.clj   | 74 ++++++++++++++------------
 backend/src/app/loggers/mattermost.clj | 14 ++---
 backend/src/app/main.clj               |  5 +-
 common/deps.edn                        |  2 +-
 common/src/app/common/exceptions.cljc  |  6 +--
 5 files changed, 54 insertions(+), 47 deletions(-)

diff --git a/backend/src/app/loggers/database.clj b/backend/src/app/loggers/database.clj
index 530dc8765..f9a853f72 100644
--- a/backend/src/app/loggers/database.clj
+++ b/backend/src/app/loggers/database.clj
@@ -11,12 +11,12 @@
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
-   [app.util.async :as aa]
-   [app.worker :as wrk]
+   [app.loggers.zmq :as lzmq]
    [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [integrant.core :as ig]))
+   [integrant.core :as ig]
+   [promesa.exec :as px]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Error Listener
@@ -27,7 +27,7 @@
 (defonce enabled (atom true))
 
 (defn- persist-on-database!
-  [{:keys [pool] :as cfg} {:keys [id] :as event}]
+  [{:keys [::db/pool] :as cfg} {:keys [id] :as event}]
   (when-not (db/read-only? pool)
     (db/insert! pool :server-error-report {:id id :content (db/tjson event)})))
 
@@ -53,41 +53,49 @@
       (assoc :version (:full cf/version))
       (update :id #(or % (uuid/next)))))
 
-(defn handle-event
-  [{:keys [executor] :as cfg} event]
-  (aa/with-thread executor
-    (try
-      (let [event (parse-event event)
-            uri   (cf/get :public-uri)]
+(defn- handle-event
+  [cfg event]
+  (try
+    (let [event (parse-event event)
+          uri   (cf/get :public-uri)]
 
-        (l/debug :hint "registering error on database" :id (:id event)
-                 :uri (str uri "/dbg/error/" (:id event)))
+      (l/debug :hint "registering error on database" :id (:id event)
+               :uri (str uri "/dbg/error/" (:id event)))
 
-        (persist-on-database! cfg event))
-      (catch Exception cause
-        (l/warn :hint "unexpected exception on database error logger" :cause cause)))))
+      (persist-on-database! cfg event))
+    (catch Throwable cause
+      (l/warn :hint "unexpected exception on database error logger" :cause cause))))
 
-(defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req-un [::wrk/executor ::db/pool ::receiver]))
-
-(defn error-event?
+(defn- error-event?
   [event]
   (= "error" (:logger/level event)))
 
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req [::db/pool ::lzmq/receiver]))
+
 (defmethod ig/init-key ::reporter
-  [_ {:keys [receiver] :as cfg}]
-  (l/info :msg "initializing database error persistence")
-  (let [output (a/chan (a/sliding-buffer 5) (filter error-event?))]
-    (receiver :sub output)
-    (a/go-loop []
-      (let [msg (a/<! output)]
-        (if (nil? msg)
-          (l/info :msg "stopping error reporting loop")
-          (do
-            (a/<! (handle-event cfg msg))
-            (recur)))))
-    output))
+  [_ {:keys [::lzmq/receiver] :as cfg}]
+  (px/thread
+    {:name "penpot/database-reporter"}
+    (l/info :hint "initializing database error persistence")
+
+    (let [input (a/chan (a/sliding-buffer 5)
+                        (filter error-event?))]
+      (try
+        (lzmq/sub! receiver input)
+        (loop []
+          (when-let [msg (a/<!! input)]
+            (handle-event cfg msg))
+          (recur))
+
+        (catch InterruptedException _
+          (l/debug :hint "reporter interrupted"))
+        (catch Throwable cause
+          (l/error :hint "unexpected error" :cause cause))
+        (finally
+          (a/close! input)
+          (l/info :hint "reporter terminated"))))))
 
 (defmethod ig/halt-key! ::reporter
-  [_ output]
-  (a/close! output))
+  [_ thread]
+  (some-> thread px/interrupt!))
diff --git a/backend/src/app/loggers/mattermost.clj b/backend/src/app/loggers/mattermost.clj
index f7a1efb49..de89ba207 100644
--- a/backend/src/app/loggers/mattermost.clj
+++ b/backend/src/app/loggers/mattermost.clj
@@ -38,13 +38,13 @@
 
 (defn handle-event
   [cfg event]
-  (try
-    (let [event (ldb/parse-event event)]
-      (when @enabled
-        (send-mattermost-notification! cfg event)))
-    (catch Throwable cause
-      (l/warn :hint "unhandled error"
-              :cause cause))))
+  (when @enabled
+    (try
+      (let [event (ldb/parse-event event)]
+        (send-mattermost-notification! cfg event))
+      (catch Throwable cause
+        (l/warn :hint "unhandled error"
+                :cause cause)))))
 
 (defmethod ig/pre-init-spec ::reporter [_]
   (s/keys :req [::http/client
diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj
index b3d543108..045846a18 100644
--- a/backend/src/app/main.clj
+++ b/backend/src/app/main.clj
@@ -450,9 +450,8 @@
     ::http.client/client (ig/ref ::http.client/client)}
 
    :app.loggers.database/reporter
-   {:receiver (ig/ref :app.loggers.zmq/receiver)
-    :pool     (ig/ref ::db/pool)
-    :executor (ig/ref ::wrk/executor)}
+   {::lzmq/receiver (ig/ref :app.loggers.zmq/receiver)
+    ::db/pool       (ig/ref ::db/pool)}
 
    ::sto/storage
    {:pool     (ig/ref ::db/pool)
diff --git a/common/deps.edn b/common/deps.edn
index a8919e73d..2d94cc322 100644
--- a/common/deps.edn
+++ b/common/deps.edn
@@ -23,7 +23,7 @@
   com.cognitect/transit-cljs {:mvn/version "0.8.280"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
-  funcool/promesa {:mvn/version "10.0.571"}
+  funcool/promesa {:mvn/version "10.0.594"}
   funcool/cuerdas {:mvn/version "2022.06.16-403"}
 
   lambdaisland/uri {:mvn/version "1.13.95"
diff --git a/common/src/app/common/exceptions.cljc b/common/src/app/common/exceptions.cljc
index 333af7472..0b36e532d 100644
--- a/common/src/app/common/exceptions.cljc
+++ b/common/src/app/common/exceptions.cljc
@@ -89,9 +89,9 @@
           (contains? data :explain))
      (explain (:explain data) opts)
 
-     (and (::s/problems data)
-          (::s/value data)
-          (::s/spec data))
+     (and (contains? data ::s/problems)
+          (contains? data ::s/value)
+          (contains? data ::s/spec))
      (binding [s/*explain-out* expound/printer]
        (with-out-str
          (s/explain-out (update data ::s/problems #(take max-problems %))))))))