Merge remote-tracking branch 'origin/main' into develop

backend/src/app/cli/manage.clj

@@ -140,7 +140,6 @@
   indicating the action the program should take and the options provided."
   [args]
   (let [{:keys [options arguments errors summary] :as opts} (parse-opts args cli-options)]
-    ;; (pp/pprint opts)
     (cond
       (:help options) ; help => exit OK with usage summary
       {:exit-message (usage summary) :ok? true}

backend/src/app/db.clj

@@ -50,16 +50,26 @@
 (declare instrument-jdbc!)
 (declare apply-migrations!)
 
-(s/def ::name keyword?)
-(s/def ::uri ::us/not-empty-string)
-(s/def ::min-pool-size ::us/integer)
+(s/def ::connection-timeout ::us/integer)
 (s/def ::max-pool-size ::us/integer)
 (s/def ::migrations map?)
+(s/def ::min-pool-size ::us/integer)
+(s/def ::name keyword?)
+(s/def ::password ::us/string)
 (s/def ::read-only ::us/boolean)
+(s/def ::uri ::us/not-empty-string)
+(s/def ::username ::us/string)
+(s/def ::validation-timeout ::us/integer)
 
 (defmethod ig/pre-init-spec ::pool [_]
-  (s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size]
-          :opt-un [::migrations ::mtx/metrics ::read-only]))
+  (s/keys :req-un [::uri ::name ::username ::password]
+          :opt-un [::min-pool-size
+                   ::max-pool-size
+                   ::connection-timeout
+                   ::validation-timeout
+                   ::migrations
+                   ::mtx/metrics
+                   ::read-only]))
 
 (defmethod ig/init-key ::pool
   [_ {:keys [migrations metrics name read-only] :as cfg}]
@@ -111,11 +121,11 @@
       (.setPoolName (d/name (:name cfg)))
       (.setAutoCommit true)
       (.setReadOnly read-only)
-      (.setConnectionTimeout 10000)  ;; 10seg
-      (.setValidationTimeout 10000)  ;; 10seg
+      (.setConnectionTimeout (:connection-timeout cfg 10000))  ;; 10seg
+      (.setValidationTimeout (:validation-timeout cfg 10000))  ;; 10seg
       (.setIdleTimeout 120000)       ;; 2min
       (.setMaxLifetime 1800000)      ;; 30min
-      (.setMinimumIdle (:min-pool-size cfg 0))
+      (.setMinimumIdle     (:min-pool-size cfg 0))
       (.setMaximumPoolSize (:max-pool-size cfg 50))
       (.setConnectionInitSql initsql)
       (.setInitializationFailTimeout -1))

backend/src/app/http.clj

@@ -76,11 +76,11 @@
       (try
         (handler request)
         (catch Throwable e
-          (l/with-context (errors/get-error-context request e)
-            (l/error :hint "unexpected error processing request"
-                     :query-string (:query-string request)
-                     :cause e)
-            {:status 500 :body "internal server error"}))))))
+          (l/error :hint "unexpected error processing request"
+                   ::l/context (errors/get-error-context request e)
+                   :query-string (:query-string request)
+                   :cause e)
+          {:status 500 :body "internal server error"})))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Http Router
@@ -150,8 +150,8 @@
                           [middleware/errors errors/handle]
                           [middleware/cookies]]}
 
+     ["/health" {:get (:health-check debug)}]
      ["/_doc" {:get (doc/handler rpc)}]
-
      ["/feedback" {:middleware [(:middleware session)]
                    :post feedback}]
      ["/auth/oauth/:provider" {:post (:handler oauth)}]

backend/src/app/http/debug.clj

@@ -18,9 +18,9 @@
    [app.util.template :as tmpl]
    [app.util.time :as dt]
    [clojure.java.io :as io]
-   [clojure.pprint :as ppr]
    [cuerdas.core :as str]
    [datoteka.core :as fs]
+   [fipp.edn :as fpp]
    [integrant.core :as ig]))
 
 ;; (selmer.parser/cache-off!)
@@ -147,21 +147,20 @@
              (some-> (db/get-by-id pool :server-error-report id) :content db/decode-transit-pgobject)))
 
           (render-template [report]
-            (binding [ppr/*print-right-margin* 300]
-              (let [context (dissoc report
-                                    :trace :cause :params :data :spec-problems
-                                    :spec-explain :spec-value :error :explain :hint)
-                    params  {:context (with-out-str (ppr/pprint context))
-                             :hint    (:hint report)
-                             :spec-explain  (:spec-explain report)
-                             :spec-problems (:spec-problems report)
-                             :spec-value    (:spec-value report)
-                             :data          (:data report)
-                             :trace         (or (:trace report)
-                                                (some-> report :error :trace))
-                             :params        (:params report)}]
-                (-> (io/resource "templates/error-report.tmpl")
-                    (tmpl/render params)))))
+            (let [context (dissoc report
+                                  :trace :cause :params :data :spec-problems
+                                  :spec-explain :spec-value :error :explain :hint)
+                  params  {:context (with-out-str (fpp/pprint context {:width 300}))
+                           :hint    (:hint report)
+                           :spec-explain  (:spec-explain report)
+                           :spec-problems (:spec-problems report)
+                           :spec-value    (:spec-value report)
+                           :data          (:data report)
+                           :trace         (or (:trace report)
+                                              (some-> report :error :trace))
+                           :params        (:params report)}]
+              (-> (io/resource "templates/error-report.tmpl")
+                  (tmpl/render params))))
           ]
 
     (when-not (authorized? pool request)
@@ -195,9 +194,17 @@
      :body (-> (io/resource "templates/error-list.tmpl")
                (tmpl/render {:items items}))}))
 
+(defn health-check
+  "Mainly a task that performs a health check."
+  [{:keys [pool]} _]
+  (db/with-atomic [conn pool]
+    (db/exec-one! conn ["select count(*) as count from server_prop;"])
+    {:status 200 :body "Ok"}))
+
 (defmethod ig/init-key ::handlers
   [_ cfg]
   {:index (partial index cfg)
+   :health-check (partial health-check cfg)
    :retrieve-file-data (partial retrieve-file-data cfg)
    :retrieve-file-changes (partial retrieve-file-changes cfg)
    :retrieve-error (partial retrieve-error cfg)

backend/src/app/http/errors.clj

@@ -11,7 +11,6 @@
    [app.common.logging :as l]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
-   [clojure.pprint]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
@@ -36,6 +35,7 @@
       :data          (some-> data (dissoc ::s/problems ::s/value ::s/spec))
       :ip-addr       (parse-client-ip request)
       :profile-id    (:profile-id request)}
+
      (let [headers (:headers request)]
        {:user-agent (get headers "user-agent")
         :frontend-version (get headers "x-frontend-version" "unknown")})
@@ -70,8 +70,10 @@
 (defmethod handle-exception :assertion
   [error request]
   (let [edata (ex-data error)]
-    (l/with-context (get-error-context request error)
-      (l/error ::l/raw (ex-message error) :cause error))
+    (l/error ::l/raw (ex-message error)
+             ::l/context (get-error-context request error)
+             :cause error)
+
     {:status 500
      :body {:type :server-error
             :code :assertion
@@ -93,9 +95,9 @@
              (ex/exception? (:handling edata)))
       (handle-exception (:handling edata) request)
       (do
-        (l/with-context (get-error-context request error)
-          (l/error ::l/raw (ex-message error) :cause error))
-
+        (l/error ::l/raw (ex-message error)
+                 ::l/context (get-error-context request error)
+                 :cause error)
         {:status 500
          :body {:type :server-error
                 :code :unexpected
@@ -105,10 +107,9 @@
 (defmethod handle-exception org.postgresql.util.PSQLException
   [error request]
   (let [state (.getSQLState ^java.sql.SQLException error)]
-
-    (l/with-context (get-error-context request error)
-      (l/error ::l/raw (ex-message error) :cause error))
-
+    (l/error ::l/raw (ex-message error)
+             ::l/context (get-error-context request error)
+             :cause error)
     (cond
       (= state "57014")
       {:status 504

backend/src/app/loggers/audit.clj

@@ -193,20 +193,21 @@
 (defn- persist-events
   [{:keys [pool executor] :as cfg} events]
   (letfn [(event->row [event]
-            [(uuid/next)
-             (:name event)
-             (:type event)
-             (:profile-id event)
-             (:tracked-at event)
-             (some-> (:ip-addr event) db/inet)
-             (db/tjson (:props event))
-             "backend"])]
+            (when (:profile-id event)
+              [(uuid/next)
+               (:name event)
+               (:type event)
+               (:profile-id event)
+               (:tracked-at event)
+               (some-> (:ip-addr event) db/inet)
+               (db/tjson (:props event))
+               "backend"]))]
     (aa/with-thread executor
       (when (seq events)
         (db/with-atomic [conn pool]
           (db/insert-multi! conn :audit-log
                             [:id :name :type :profile-id :tracked-at :ip-addr :props :source]
-                            (sequence (map event->row) events)))))))
+                            (sequence (keep event->row) events)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Archive Task

backend/src/app/loggers/database.clj

@@ -70,12 +70,15 @@
 (defmethod ig/pre-init-spec ::reporter [_]
   (s/keys :req-un [::wrk/executor ::db/pool ::receiver]))
 
+(defn error-event?
+  [event]
+  (= "error" (:logger/level event)))
+
 (defmethod ig/init-key ::reporter
   [_ {:keys [receiver] :as cfg}]
   (l/info :msg "initializing database error persistence")
-  (let [output (a/chan (a/sliding-buffer 128)
-                       (filter (fn [event]
-                                 (= (:logger/level event) "error"))))]
+  (let [output (a/chan (a/sliding-buffer 5)
+                       (filter error-event?))]
     (receiver :sub output)
     (a/go-loop []
       (let [msg (a/<! output)]

backend/src/app/loggers/sentry.clj

@@ -120,8 +120,6 @@
               (.captureMessage ^IHub shub msg)
               ))
           ]
-    ;; (clojure.pprint/pprint event)
-
     (when @enabled
       (.withScope ^IHub shub (reify ScopeCallback
                                (run [_ scope]

backend/src/app/main.clj

@@ -22,7 +22,7 @@
     :migrations (ig/ref :app.migrations/all)
     :name :main
     :min-pool-size 0
-    :max-pool-size 30}
+    :max-pool-size 60}
 
    :app.migrations/migrations
    {}

backend/src/app/srepl/main.clj

@@ -17,7 +17,7 @@
    [app.srepl.dev :as dev]
    [app.util.blob :as blob]
    [app.util.time :as dt]
-   [clojure.pprint :refer [pprint]]
+   [fipp.edn :refer [pprint]]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [expound.alpha :as expound]))

backend/src/app/util/time.clj

@@ -8,7 +8,8 @@
   (:require
    [app.common.exceptions :as ex]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str])
+   [cuerdas.core :as str]
+   [fipp.ednize :as fez])
   (:import
    java.time.Duration
    java.time.Instant
@@ -111,6 +112,11 @@
 (defmethod print-dup Duration [o w]
   (print-method o w))
 
+(extend-protocol fez/IEdn
+  Duration
+  (-edn [o] (pr-str o)))
+
+
 ;; --- INSTANT
 
 (defn instant
@@ -175,6 +181,10 @@
 (defmethod print-dup Instant [o w]
   (print-method o w))
 
+(extend-protocol fez/IEdn
+  Instant
+  (-edn [o] (pr-str o)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Cron Expression
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/app/util/websocket.clj

@@ -15,7 +15,9 @@
    [clojure.core.async :as a]
    [yetti.websocket :as yws])
   (:import
-   java.nio.ByteBuffer))
+   java.nio.ByteBuffer
+   org.eclipse.jetty.io.EofException))
+
 
 (declare decode-beat)
 (declare encode-beat)
@@ -132,17 +134,25 @@
 (defn- ws-send!
   [conn s]
   (let [ch (a/chan 1)]
-    (yws/send! conn s (fn [e]
-                        (when e (a/offer! ch e))
-                        (a/close! ch)))
+    (try
+      (yws/send! conn s (fn [e]
+                          (when e (a/offer! ch e))
+                          (a/close! ch)))
+      (catch EofException cause
+        (a/offer! ch cause)
+        (a/close! ch)))
     ch))
 
 (defn- ws-ping!
   [conn s]
   (let [ch (a/chan 1)]
-    (yws/ping! conn s (fn [e]
-                        (when e (a/offer! ch e))
-                        (a/close! ch)))
+    (try
+      (yws/ping! conn s (fn [e]
+                          (when e (a/offer! ch e))
+                          (a/close! ch)))
+      (catch EofException cause
+        (a/offer! ch cause)
+        (a/close! ch)))
     ch))
 
 (defn- encode-beat

backend/src/app/worker.clj

@@ -260,10 +260,16 @@
 
 (defn get-error-context
   [error item]
-  (let [edata (ex-data error)]
-    {:id      (uuid/next)
-     :data    edata
-     :params  item}))
+  (let [data (ex-data error)]
+    (merge
+     {:id            (uuid/next)
+      :hint          (ex-message error)
+      :spec-problems (some->> data ::s/problems (take 10) seq vec)
+      :spec-value    (some->> data ::s/value)
+      :data          (some-> data (dissoc ::s/problems ::s/value ::s/spec))
+      :params        item}
+     (when (and data (::s/problems data))
+       {:spec-explain (us/pretty-explain data)}))))
 
 (defn- handle-exception
   [error item]
@@ -277,8 +283,10 @@
 
         (= ::noop (:strategy edata))
         (assoc :inc-by 0))
-      (l/with-context (get-error-context error item)
-        (l/error :cause error :hint "unhandled exception on task")
+      (do
+        (l/error :hint "unhandled exception on task"
+                 ::l/context (get-error-context error item)
+                 :cause error)
         (if (>= (:retry-num item) (:max-retries item))
           {:status :failed :task item :error error}
           {:status :retry :task item :error error})))))

common/src/app/common/logging.cljc

@@ -9,6 +9,7 @@
    [app.common.exceptions :as ex]
    [clojure.pprint :refer [pprint]]
    [cuerdas.core :as str]
+   [fipp.edn :as fpp]
    #?(:clj [io.aviso.exception :as ie])
    #?(:cljs [goog.log :as glog]))
   #?(:cljs (:require-macros [app.common.logging])
@@ -52,22 +53,16 @@
    (defn stringify-data
      [val]
      (cond
-       (instance? clojure.lang.Named val)
-       (name val)
-
-       (instance? Throwable val)
-       (binding [ie/*app-frame-names* [#"app.*"]
-                 ie/*fonts* nil
-                 ie/*traditional* true]
-         (ie/format-exception val nil))
-
        (string? val)
        val
 
+       (instance? clojure.lang.Named val)
+       (name val)
+
        (coll? val)
-       (binding [clojure.pprint/*print-right-margin* 200]
-         (-> (with-out-str (pprint val))
-             (simple-prune (* 1024 1024 3))))
+       (binding [*print-level* 5
+                 *print-length* 20]
+         (with-out-str (fpp/pprint val {:width 200})))
 
        :else
        (str val))))
@@ -163,13 +158,13 @@
      (.isEnabled ^Logger logger ^Level level)))
 
 (defmacro log
-  [& {:keys [level cause ::logger ::async ::raw] :or {async true} :as props}]
+  [& {:keys [level cause ::logger ::async ::raw ::context] :or {async true} :as props}]
   (if (:ns &env) ; CLJS
     `(write-log! ~(or logger (str *ns*))
                  ~level
                  ~cause
-                 (or ~raw ~(dissoc props :level :cause ::logger ::raw)))
-    (let [props      (dissoc props :level :cause ::logger ::async ::raw)
+                 (or ~raw ~(dissoc props :level :cause ::logger ::raw ::context)))
+    (let [props      (dissoc props :level :cause ::logger ::async ::raw ::context)
           logger     (or logger (str *ns*))
           logger-sym (gensym "log")
           level-sym  (gensym "log")]
@@ -180,7 +175,7 @@
               `(->> (ThreadContext/getImmutableContext)
                     (send-off logging-agent
                               (fn [_# cdata#]
-                                (with-context (into {} cdata#)
+                                (with-context (-> {} (into cdata#) (into ~context))
                                   (->> (or ~raw (build-map-message ~props))
                                        (write-log! ~logger-sym ~level-sym ~cause))))))
 

frontend/src/app/worker/import.cljs

@@ -340,7 +340,10 @@
         pre-process-images
         (->> (rx/from nodes)
              (rx/filter media-node?)
-             (rx/merge-map
+             ;; TODO: this should be merge-map, but we disable the
+             ;; parallel upload until we resolve resource usage issues
+             ;; on backend.
+             (rx/mapcat
               (fn [node]
                 (->> (resolve-media context file-id node)
                      (rx/map (fn [result] [node result])))))