✨ Improve exception formating on backend

backend/dev/user.clj

@@ -12,6 +12,7 @@
    [app.common.logging :as l]
    [app.common.perf :as perf]
    [app.common.pprint :as pp]
+   [app.common.spec :as us]
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.config :as cfg]
@@ -29,11 +30,13 @@
    [clojure.pprint :refer [pprint print-table]]
    [clojure.repl :refer :all]
    [clojure.spec.alpha :as s]
+   [clojure.stacktrace :as trace]
    [clojure.test :as test]
    [clojure.test.check.generators :as gen]
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
    [criterium.core  :as crit]
+   [cuerdas.core :as str]
    [datoteka.core]
    [integrant.core :as ig]))
 
@@ -78,12 +81,15 @@
 
 (defn- start
   []
+  (try
     (alter-var-root #'system (fn [sys]
                                (when sys (ig/halt! sys))
                                (-> (merge main/system-config main/worker-config)
                                    (ig/prep)
                                    (ig/init))))
-  :started)
+    :started
+    (catch Throwable cause
+      (ex/print-throwable cause))))
 
 (defn- stop
   []

backend/resources/log4j2-devenv.xml

@@ -2,11 +2,13 @@
 <Configuration status="info" monitorInterval="30">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
+                     alwaysWriteExceptions="false" />
     </Console>
 
     <RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
+                     alwaysWriteExceptions="false" />
       <Policies>
         <SizeBasedTriggeringPolicy size="50M"/>
       </Policies>

backend/resources/log4j2.xml

@@ -2,7 +2,8 @@
 <Configuration status="info" monitorInterval="60">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
+                     alwaysWriteExceptions="false" />
     </Console>
   </Appenders>
 

backend/src/app/auth/oidc.clj

@@ -50,7 +50,7 @@
 (defn- discover-oidc-config
   [{:keys [http-client]} {:keys [base-uri] :as opts}]
   (let [discovery-uri (u/join base-uri ".well-known/openid-configuration")
-        response      (ex/try (http/req! http-client {:method :get :uri (str discovery-uri)} {:sync? true}))]
+        response      (ex/try! (http/req! http-client {:method :get :uri (str discovery-uri)} {:sync? true}))]
     (cond
       (ex/exception? response)
       (do

backend/src/app/config.clj

@@ -340,7 +340,8 @@
       (when (ex/ex-info? e)
         (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
         (println "Error on validating configuration:")
-        (println (us/pretty-explain (ex-data e)))
+        (println (some-> e ex-data ex/explain))
+        (println (ex/explain (ex-data e)))
         (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"))
       (throw e))))
 

backend/src/app/http/errors.clj

@@ -10,7 +10,6 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
    [app.http :as-alias http]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
@@ -64,7 +63,7 @@
   (let [{:keys [code] :as data} (ex-data err)]
     (cond
       (= code :spec-validation)
-      (let [explain (us/pretty-explain data)]
+      (let [explain (ex/explain data)]
         (yrs/response :status 400
                       :body   (-> data
                                   (dissoc ::s/problems ::s/value)
@@ -79,7 +78,7 @@
 (defmethod handle-exception :assertion
   [error request]
   (let [edata (ex-data error)
-        explain (us/pretty-explain edata)]
+        explain (ex/explain edata)]
     (l/error ::l/raw (str (ex-message error) "\n" explain)
              ::l/context (get-context request)
              :cause error)

backend/src/app/main.clj

@@ -534,4 +534,9 @@
 
 (defn -main
   [& _args]
-  (start))
+  (try
+    (start)
+    (catch Throwable cause
+      (l/error :hint (ex-message cause)
+               :cause cause)
+      (System/exit -1))))

backend/src/app/rpc/rlimit.clj

@@ -358,7 +358,7 @@
 (defn- on-refresh-error
   [_ cause]
   (when-not (instance? java.util.concurrent.RejectedExecutionException cause)
-    (if-let [explain (-> cause ex-data us/pretty-explain)]
+    (if-let [explain (-> cause ex-data ex/explain)]
       (l/warn ::l/raw (str "unable to refresh config, invalid format:\n" explain)
               ::l/async false)
       (l/warn :hint "unexpected exception on loading config"

backend/src/app/storage/fs.clj

@@ -75,8 +75,10 @@
 (defmethod impl/get-object-bytes :fs
   [backend object]
   (p/let [input (impl/get-object-data backend object)]
-    (ex/with-always (io/close! input)
+    (try
-      (io/read-as-bytes input))))
+      (io/read-as-bytes input)
+      (finally
+        (io/close! input)))))
 
 (defmethod impl/get-object-url :fs
   [{:keys [uri executor] :as backend} {:keys [id] :as object} _]

backend/src/app/worker.clj

@@ -501,8 +501,8 @@
       :spec-value    (some->> data ::s/value)
       :data          (some-> data (dissoc ::s/problems ::s/value ::s/spec))
       :params        item}
-     (when (and data (::s/problems data))
+     (when-let [explain (ex/explain data)]
-       {:spec-explain (us/pretty-explain data)}))))
+       {:spec-explain explain}))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; CRON

common/src/app/common/exceptions.cljc

@@ -6,34 +6,25 @@
 
 (ns app.common.exceptions
   "A helpers for work with exceptions."
-  #?(:cljs
+  #?(:cljs (:require-macros [app.common.exceptions]))
-     (:require-macros [app.common.exceptions]))
+  (:require
-  (:require [clojure.spec.alpha :as s]))
+   #?(:clj [clojure.stacktrace :as strace])
+   [app.common.pprint :as pp]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [expound.alpha :as expound]))
 
-(s/def ::type keyword?)
+(defmacro error
-(s/def ::code keyword?)
+  [& {:keys [type hint] :as params}]
-(s/def ::hint string?)
+  `(ex-info ~(or hint (pr-str type))
-(s/def ::cause #?(:clj #(instance? Throwable %)
+            (merge
-                  :cljs #(instance? js/Error %)))
+             ~(dissoc params :cause ::data)
-
+             ~(::data params))
-(s/def ::error-params
+            ~(:cause params)))
-  (s/keys :req-un [::type]
-          :opt-un [::code
-                   ::hint
-                   ::cause]))
-
-(defn error
-  [& {:keys [hint cause ::data type] :as params}]
-  (s/assert ::error-params params)
-  (let [payload (-> params
-                    (dissoc :cause ::data)
-                    (merge data))
-        hint    (or hint (pr-str type))]
-    (ex-info hint payload cause)))
 
 (defmacro raise
-  [& args]
+  [& params]
-  `(throw (error ~@args)))
+  `(throw (error ~@params)))
 
 (defn try*
   [f on-error]
@@ -46,20 +37,10 @@
   [& exprs]
   `(try* (^:once fn* [] ~@exprs) (constantly nil)))
 
-(defmacro try
-  [& exprs]
-  `(try* (^:once fn* [] ~@exprs) identity))
-
 (defmacro try!
   [& exprs]
   `(try* (^:once fn* [] ~@exprs) identity))
 
-(defn with-always
-  "A helper that evaluates an exptession independently if the body
-  raises exception or not."
-  [always-expr & body]
-  `(try ~@body (finally ~always-expr)))
-
 (defn ex-info?
   [v]
   (instance? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) v))
@@ -68,7 +49,6 @@
   [v]
   (instance? #?(:clj java.lang.Throwable :cljs js/Error) v))
 
-
 #?(:cljs
    (deftype WrappedException [cause meta]
      cljs.core/IMeta
@@ -84,7 +64,6 @@
      clojure.lang.IDeref
      (deref [_] cause)))
 
-
 #?(:clj (ns-unmap 'app.common.exceptions '->WrappedException))
 #?(:clj (ns-unmap 'app.common.exceptions 'map->WrappedException))
 
@@ -95,3 +74,125 @@
 (defn wrap-with-context
   [cause context]
   (WrappedException. cause context))
+
+(defn explain
+  ([data] (explain data nil))
+  ([data {:keys [max-problems] :or {max-problems 10} :as opts}]
+   (cond
+     ;; ;; NOTE: a special case for spec validation errors on integrant
+     (and (= (:reason data) :integrant.core/build-failed-spec)
+          (contains? data :explain))
+     (explain (:explain data) opts)
+
+     (and (::s/problems data)
+          (::s/value data)
+          (::s/spec data))
+     (binding [s/*explain-out* expound/printer]
+       (with-out-str
+         (s/explain-out (update data ::s/problems #(take max-problems %))))))))
+
+#?(:clj
+(defn print-throwable
+  [^Throwable cause
+   & {:keys [trace? data? chain? data-level data-length trace-length explain-length]
+      :or {trace? true
+           data? true
+           chain? true
+           explain-length 10
+           data-length 10
+           data-level 3}}]
+  (letfn [(print-trace-element [^StackTraceElement e]
+            (let [class (.getClassName e)
+                  method (.getMethodName e)]
+              (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" (str class))]
+                (if (and match (= "invoke" method))
+                  (apply printf "%s/%s" (rest match))
+                  (printf "%s.%s" class method))))
+            (printf "(%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
+
+          (print-explain [explain]
+            (print "    xp: ")
+            (let [[line & lines] (str/lines explain)]
+              (print line)
+              (newline)
+              (doseq [line lines]
+                (println "       " line))))
+
+          (print-data [data]
+            (when (seq data)
+              (print "    dt: ")
+              (let [[line & lines] (str/lines (pp/pprint-str data :level data-level :length data-length ))]
+                (print line)
+                (newline)
+                (doseq [line lines]
+                  (println "       " line)))))
+
+          (print-trace-title [cause]
+            (print   " →  ")
+            (printf "%s: %s" (.getName (class cause)) (first (str/lines (ex-message cause))))
+
+            (when-let [e (first (.getStackTrace cause))]
+              (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
+
+            (newline))
+
+          (print-summary [cause]
+            (let [causes (loop [cause (.getCause cause)
+                                result []]
+                           (if cause
+                             (recur (.getCause cause)
+                                    (conj result cause))
+                             result))]
+              (println "TRACE:")
+              (print-trace-title cause)
+              (doseq [cause causes]
+                (print-trace-title cause))))
+
+          (print-trace [cause]
+            (print-trace-title cause)
+            (let [st (.getStackTrace cause)]
+              (print "    at: ")
+              (if-let [e (first st)]
+                (print-trace-element e)
+                (print "[empty stack trace]"))
+              (newline)
+
+              (doseq [e (if (nil? trace-length) (rest st) (take (dec trace-length) (rest st)))]
+                (print "        ")
+                (print-trace-element e)
+                (newline))))
+
+          (print-all [cause]
+            (print-summary cause)
+            (newline)
+            (println "DETAIL:")
+
+            (when trace?
+              (print-trace cause))
+
+            (when data?
+              (when-let [data (ex-data cause)]
+                (if-let [explain (explain data)]
+                  (print-explain explain)
+                  (print-data data))))
+
+            (when chain?
+              (loop [cause cause]
+                (when-let [cause (.getCause cause)]
+                  (newline)
+                  (print-trace cause)
+
+                  (when data?
+                    (when-let [data (ex-data cause)]
+                      (if-let [explain (explain data)]
+                        (print-explain explain)
+                        (print-data data))))
+
+                  (recur cause)))))
+          ]
+
+    (println
+     (with-out-str
+       (print-all cause))))))
+
+

common/src/app/common/logging.cljc

@@ -32,19 +32,30 @@
 (def ^:private reserved-props
   #{:level :cause ::logger ::async ::raw ::context})
 
-(def ^:private props-xform
+(defn build-message-kv
-  (comp (partition-all 2)
-        (remove (fn [[k]] (contains? reserved-props k)))
-        (map vec)))
-
-(defn build-message
   [props]
-  (loop [pairs  (sequence props-xform props)
+  (loop [pairs  (remove (fn [[k]] (contains? reserved-props k)) props)
          result []]
     (if-let [[k v] (first pairs)]
       (recur (rest pairs)
              (conj result (str/concat (d/name k) "=" (pr-str v))))
-      result)))
+      (str/join ", " result))))
+
+(defn build-message-cause
+  [props]
+  #?(:clj (when-let [[_ cause] (d/seek (fn [[k]] (= k :cause)) props)]
+            (with-out-str
+              (ex/print-throwable cause)))
+     :cljs nil))
+
+(defn build-message
+  [props]
+  (let [props      (sequence (comp (partition-all 2) (map vec)) props)
+        message-kv (build-message-kv props)
+        message-ex (build-message-cause props)]
+    (cond-> message-kv
+      (some? message-ex)
+      (str "\n" message-ex))))
 
 #?(:clj
    (def logger-context
@@ -169,8 +180,8 @@
          :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))}
-        (when (and data (::s/problems data))
+        (when-let [explain (ex/explain data)]
-          {:spec-explain (us/pretty-explain data)})))))
+          {:spec-explain explain})))))
 
 (defmacro log
   [& props]

common/src/app/common/spec.cljc

@@ -375,7 +375,8 @@
       ;; argument is a qualified keyword.
       (= 2 pcnt)
       (let [[spec-or-expr value-or-msg] params]
-        (if (qualified-keyword? spec-or-expr)
+        (if (or (qualified-keyword? spec-or-expr)
+                (symbol? spec-or-expr))
           `(assert-spec* ~spec-or-expr ~value-or-msg nil)
           `(assert-expr* ~spec-or-expr ~value-or-msg)))
 
@@ -419,6 +420,8 @@
                       (spec-assert* ~spec params# ~message mdata#)
                       (apply origf# params#)))))))
 
+
+;; FIXME: REMOVE
 (defn pretty-explain
   ([data] (pretty-explain data nil))
   ([data {:keys [max-problems] :or {max-problems 10}}]
@@ -428,3 +431,11 @@
      (binding [s/*explain-out* expound/printer]
        (with-out-str
          (s/explain-out (update data ::s/problems #(take max-problems %))))))))
+
+(defn validation-error?
+  [cause]
+  (if (and (map? cause) (= :spec-validation (:type cause)))
+    cause
+    (when (ex/ex-info? cause)
+      (validation-error? (ex-data cause)))))
+

frontend/src/app/main/data/media.cljs

@@ -41,7 +41,7 @@
   (when-not (contains? cm/valid-image-types (.-type file))
     (ex/raise :type :validation
               :code :media-type-not-allowed
-              :hint (str/fmt "media type %s is not supported" (.-type file))))
+              :hint (str/ffmt "media type % is not supported" (.-type file))))
   file)
 
 (defn notify-start-loading

frontend/src/app/main/data/workspace/svg_upload.cljs

@@ -7,6 +7,7 @@
 (ns app.main.data.workspace.svg-upload
   (:require
    [app.common.data :as d]
+   [app.common.spec :as us]
    [app.common.exceptions :as ex]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
@@ -35,10 +36,11 @@
 (defonce default-image {:x 0 :y 0 :width 1 :height 1 :rx 0 :ry 0})
 
 (defn- assert-valid-num [attr num]
-  (when (or (not (d/num? num))
+  (us/verify!
-            (>= num max-safe-int )
+   :expr (and (d/num? num)
-            (<= num  min-safe-int))
+              (<= num max-safe-int)
-    (ex/raise (str (d/name attr) " attribute invalid: " num)))
+              (>= num min-safe-int))
+   :hint (str/ffmt "%1 attribute has invalid value: %2" (d/name attr) num))
 
   ;; If the number is between 0-1 we round to 1 (same in negative form
   (cond
@@ -46,11 +48,12 @@
     (and (< num 0) (> num -1))  -1
     :else                       num))
 
-(defn- assert-valid-pos-num [attr num]
+(defn- assert-valid-pos-num
-  (let [num (assert-valid-num attr num)]
+  [attr num]
-    (when (< num 0)
+  (us/verify!
-      (ex/raise (str (d/name attr) " attribute invalid: " num)))
+   :expr (pos? num)
-    num))
+   :hint (str/ffmt "%1 attribute should be positive" (d/name attr)))
+  num)
 
 (defn- svg-dimensions [data]
   (let [width (get-in data [:attrs :width] 100)

frontend/src/app/util/color.cljs

@@ -162,7 +162,7 @@
   [[r g b]]
   (cond
     (and (= 255 r) (= 255 g) (= 255 b))
-    (ex/raise "Cannot get next color")
+    (throw (ex-info "cannot get next color" {:r r :g g :b b}))
 
     (and (= 255 g) (= 255 b))
     [(inc r) 0 0]