✨ Many improvements on error reporting.

backend/src/app/config.clj

@@ -45,7 +45,8 @@
    :allow-demo-users true
    :registration-enabled true
    :registration-domain-whitelist ""
-   :debug-humanize-transit true
+
+   :debug true
 
    ;; This is the time should transcurr after the last page
    ;; modification in order to make the file ellegible for
@@ -95,7 +96,7 @@
 (s/def ::allow-demo-users ::us/boolean)
 (s/def ::registration-enabled ::us/boolean)
 (s/def ::registration-domain-whitelist ::us/string)
-(s/def ::debug-humanize-transit ::us/boolean)
+(s/def ::debug ::us/boolean)
 (s/def ::public-uri ::us/string)
 (s/def ::backend-uri ::us/string)
 
@@ -153,7 +154,7 @@
                    ::smtp-ssl
                    ::host
                    ::file-trimming-threshold
-                   ::debug-humanize-transit
+                   ::debug
                    ::allow-demo-users
                    ::registration-enabled
                    ::registration-domain-whitelist

backend/src/app/http/errors.clj

@@ -15,6 +15,17 @@
    [cuerdas.core :as str]
    [expound.alpha :as expound]))
 
+
+(defn get-context-string
+  [err request]
+  (str
+   "=| uri:          " (pr-str (:uri request)) "\n"
+   "=| method:       " (pr-str (:request-method request)) "\n"
+   "=| params:       " (pr-str (:params request)) "\n"
+   (when (ex/ex-info? err)
+     (str "=| ex-data:      " (pr-str (ex-data err)) "\n"))
+   "\n"))
+
 (defmulti handle-exception
   (fn [err & _rest]
     (let [edata (ex-data err)]
@@ -29,18 +40,32 @@
 (defmethod handle-exception :validation
   [err req]
   (let [header (get-in req [:headers "accept"])
-        error  (ex-data err)]
+        edata  (ex-data err)]
     (cond
-      (and (str/starts-with? header "text/html")
+      (= :spec-validation (:code edata))
-           (= :spec-validation (:code error)))
+      (if (str/starts-with? header "text/html")
-      {:status 400
+        {:status 400
-       :headers {"content-type" "text/html"}
+         :headers {"content-type" "text/html"}
-       :body (str "<pre style='font-size:16px'>"
+         :body (str "<pre style='font-size:16px'>"
-                  (:hint-verbose error)
+                    (with-out-str
-                  "</pre>\n")}
+                      (expound/printer (:data edata)))
+                    "</pre>\n")}
+        {:status 400
+         :body (assoc edata :explain (with-out-str (expound/printer (:data edata))))})
+
       :else
       {:status 400
-       :body error})))
+       :body edata})))
+
+(defmethod handle-exception :assertion
+  [error request]
+  (let [edata (ex-data error)]
+    (log/errorf error
+                (str "Assertion error\n"
+                     (get-context-string request edata)
+                     (with-out-str (expound/printer (:data edata)))))
+    {:status 500
+     :body (assoc edata :explain (with-out-str (expound/printer (:data edata))))}))
 
 (defmethod handle-exception :not-found
   [err _]
@@ -52,48 +77,16 @@
   [err req]
   (handle-exception (.getCause ^Throwable err) req))
 
-(defmethod handle-exception :parse
-  [err _]
-  {:status 400
-   :body {:type :parse
-          :message (ex-message err)}})
-
-(defn get-context-string
-  [err request]
-  (str
-   "=| uri:          " (pr-str (:uri request)) "\n"
-   "=| method:       " (pr-str (:request-method request)) "\n"
-   "=| path-params:  " (pr-str (:path-params request)) "\n"
-   "=| query-params: " (pr-str (:query-params request)) "\n"
-
-   (when-let [bparams (:body-params request)]
-     (str "=| body-params:  " (pr-str bparams) "\n"))
-
-   (when (ex/ex-info? err)
-     (str "=| ex-data:      " (pr-str (ex-data err)) "\n"))
-
-   "\n"))
-
-
-(defmethod handle-exception :assertion
-  [err request]
-  (let [{:keys [data] :as edata} (ex-data err)]
-    (log/errorf err
-                (str "Assertion error\n"
-                     (get-context-string err request)
-                     (with-out-str (expound/printer data))))
-    {:status 500
-     :body {:type :internal-error
-            :message "Assertion error"
-            :data (ex-data err)}}))
 
 (defmethod handle-exception :default
-  [err request]
+  [error request]
-  (log/errorf err (str "Internal Error\n" (get-context-string err request)))
+  (let [edata (ex-data error)]
-  {:status 500
+    (log/errorf error
-   :body {:type :internal-error
+                (str "Internal Error\n"
-          :message (ex-message err)
+                     (get-context-string request edata)))
-          :data (ex-data err)}})
+
+    {:status 500
+     :body (dissoc edata :data)}))
 
 (defn handle
   [error req]

backend/src/app/http/middleware.clj

@@ -13,6 +13,8 @@
    [app.config :as cfg]
    [app.metrics :as mtx]
    [app.util.transit :as t]
+   [clojure.data.json :as json]
+   [clojure.java.io :as io]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
    [ring.middleware.multipart-params :refer [wrap-multipart-params]]
@@ -21,20 +23,42 @@
 
 (defn- wrap-parse-request-body
   [handler]
-  (letfn [(parse-body [body]
+  (letfn [(parse-transit [body]
+            (let [reader (t/reader body)]
+              (t/read! reader)))
+          (parse-json [body]
+            (let [reader (io/reader body)]
+              (json/read reader)))
+
+          (parse [type body]
             (try
-              (let [reader (t/reader body)]
+              (case type
-                (t/read! reader))
+                :json (parse-json body)
+                :transit (parse-transit body))
               (catch Exception e
-                (ex/raise :type :parse
+                (let [type (if (:debug cfg/config) :json-verbose :json)
-                          :message "Unable to parse transit from request body."
+                      data {:type :parse
-                          :cause e))))]
+                            :hint "Unable to parse request body"
+                            :message (ex-message e)}]
+                  {:status 400
+                   :body (t/encode-str data {:type type})}))))]
     (fn [{:keys [headers body request-method] :as request}]
-      (handler
+      (let [ctype (get headers "content-type")]
-       (cond-> request
+        (handler
-         (and (= "application/transit+json" (get headers "content-type"))
+         (case ctype
-              (not= request-method :get))
+           "application/transit+json"
-         (assoc :body-params (parse-body body)))))))
+           (let [params (parse :transit body)]
+             (-> request
+                 (assoc :body-params params)
+                 (update :params merge params)))
+
+           "application/json"
+           (let [params (parse :json body)]
+             (-> request
+                 (assoc :body-params params)
+                 (update :params merge params)))
+
+           request))))))
 
 (def parse-request-body
   {:name ::parse-request-body
@@ -43,9 +67,7 @@
 (defn- impl-format-response-body
   [response]
   (let [body (:body response)
-        type (if (:debug-humanize-transit cfg/config)
+        type (if (:debug cfg/config) :json-verbose :json)]
-               :json-verbose
-               :json)]
     (cond
       (coll? body)
       (-> response

common/app/common/spec.cljc

@@ -135,24 +135,18 @@
 
 ;; --- Macros
 
-(defn spec-assert
-  [spec x message]
-  (if (s/valid? spec x)
-    x
-    (ex/raise :type :assertion
-              :data (s/explain-data spec x)
-              :message message
-              #?@(:cljs [:stack (.-stack (ex-info message {}))]))))
-
 (defn spec-assert*
   [spec x message context]
   (if (s/valid? spec x)
     x
-    (ex/raise :type :assertion
+    (let [data (s/explain-data spec x)
-              :data (s/explain-data spec x)
+          hint (with-out-str (s/explain-out data))]
-              :context context
+      (ex/raise :type :assertion
-              :message message
+                :data data
-              #?@(:cljs [:stack (.-stack (ex-info message {}))]))))
+                :hint hint
+                :context context
+                :message message
+                #?@(:cljs [:stack (.-stack (ex-info message {}))])))))
 
 
 (defmacro assert
@@ -186,16 +180,13 @@
   [spec data]
   (let [result (s/conform spec data)]
     (when (= result ::s/invalid)
-      (let [edata (s/explain-data spec data)
+      (let [data (s/explain-data spec data)
-            nhint (with-out-str
+            hint (with-out-str
-                    (s/explain-out edata))
+                   (s/explain-out data))]
-            vhint (with-out-str
-                    (expound/printer edata))]
         (throw (ex/error :type :validation
                          :code :spec-validation
                          :data data
-                         :hint nhint
+                         :hint hint))))
-                         :hint-verbose vhint))))
     result))
 
 (defmacro instrument!

frontend/src/app/main/ui.cljs

@@ -242,11 +242,15 @@
   (st/emit! (rt/nav :login))
   (ts/schedule
    (st/emitf (dm/show {:content "Not authorized to see this content."
-                       :timeout 5000
+                       :timeout 3000
                        :type :error}))))
 
 (defmethod ptk/handle-error :assertion
   [{:keys [data stack message context] :as error}]
+  (ts/schedule
+   (st/emitf (dm/show {:content "Internal assertion error."
+                       :type :error
+                       :timeout 2000})))
   (js/console.group message)
   (js/console.info (str/format "ns: '%s'\nname: '%s'\nfile: '%s:%s'"
                                 (:ns context)