diff --git a/backend/src/app/config.clj b/backend/src/app/config.clj
index 9a6f3a3c6..893cfb465 100644
--- a/backend/src/app/config.clj
+++ b/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
diff --git a/backend/src/app/http/errors.clj b/backend/src/app/http/errors.clj
index b95bdbbc8..a57265ba5 100644
--- a/backend/src/app/http/errors.clj
+++ b/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 error)))
- {:status 400
- :headers {"content-type" "text/html"}
- :body (str ""
- (:hint-verbose error)
- "
\n")}
+ (= :spec-validation (:code edata))
+ (if (str/starts-with? header "text/html")
+ {:status 400
+ :headers {"content-type" "text/html"}
+ :body (str ""
+ (with-out-str
+ (expound/printer (:data edata)))
+ "
\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]
- (log/errorf err (str "Internal Error\n" (get-context-string err request)))
- {:status 500
- :body {:type :internal-error
- :message (ex-message err)
- :data (ex-data err)}})
+ [error request]
+ (let [edata (ex-data error)]
+ (log/errorf error
+ (str "Internal Error\n"
+ (get-context-string request edata)))
+
+ {:status 500
+ :body (dissoc edata :data)}))
(defn handle
[error req]
diff --git a/backend/src/app/http/middleware.clj b/backend/src/app/http/middleware.clj
index e2fafae1a..d7384a06e 100644
--- a/backend/src/app/http/middleware.clj
+++ b/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)]
- (t/read! reader))
+ (case type
+ :json (parse-json body)
+ :transit (parse-transit body))
(catch Exception e
- (ex/raise :type :parse
- :message "Unable to parse transit from request body."
- :cause e))))]
+ (let [type (if (:debug cfg/config) :json-verbose :json)
+ data {:type :parse
+ :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
- (cond-> request
- (and (= "application/transit+json" (get headers "content-type"))
- (not= request-method :get))
- (assoc :body-params (parse-body body)))))))
+ (let [ctype (get headers "content-type")]
+ (handler
+ (case ctype
+ "application/transit+json"
+ (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)
- :json-verbose
- :json)]
+ type (if (:debug cfg/config) :json-verbose :json)]
(cond
(coll? body)
(-> response
diff --git a/common/app/common/spec.cljc b/common/app/common/spec.cljc
index 7639d7021..45b1be6a6 100644
--- a/common/app/common/spec.cljc
+++ b/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
- :data (s/explain-data spec x)
- :context context
- :message message
- #?@(:cljs [:stack (.-stack (ex-info message {}))]))))
+ (let [data (s/explain-data spec x)
+ hint (with-out-str (s/explain-out data))]
+ (ex/raise :type :assertion
+ :data data
+ :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)
- nhint (with-out-str
- (s/explain-out edata))
- vhint (with-out-str
- (expound/printer edata))]
+ (let [data (s/explain-data spec data)
+ hint (with-out-str
+ (s/explain-out data))]
(throw (ex/error :type :validation
:code :spec-validation
:data data
- :hint nhint
- :hint-verbose vhint))))
+ :hint hint))))
result))
(defmacro instrument!
diff --git a/frontend/src/app/main/ui.cljs b/frontend/src/app/main/ui.cljs
index 9af5d1109..62e2d44b0 100644
--- a/frontend/src/app/main/ui.cljs
+++ b/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)