♻️ Refactor error handlers and request/response body encoding/decoding.

backend/deps.edn

@@ -14,7 +14,6 @@
         metosin/reitit-ring {:mvn/version "0.3.9"}
         metosin/reitit-middleware {:mvn/version "0.3.9"}
         metosin/reitit-spec {:mvn/version "0.3.9"}
-        metosin/reitit-dev {:mvn/version "0.3.9"}
 
         danlentz/clj-uuid {:mvn/version "0.1.9"}
         org.jsoup/jsoup {:mvn/version "1.12.1"}
@@ -35,6 +34,10 @@
         commons-io/commons-io {:mvn/version "2.6"}
         com.draines/postal {:mvn/version "2.0.3"
                             :exclusions [commons-codec/commons-codec]}
+
+        ;; exception printing
+        io.aviso/pretty {:mvn/version "0.1.37"}
+
         hikari-cp/hikari-cp {:mvn/version "2.7.1"}
         mount/mount {:mvn/version "0.1.16"}
         environ/environ {:mvn/version "1.1.0"}
@@ -44,6 +47,7 @@
  {:dev
   {:extra-deps {com.bhauman/rebel-readline {:mvn/version "0.1.4"}
                 org.clojure/tools.namespace {:mvn/version "0.3.0"}
+                fipp/fipp {:mvn/version "0.6.19"}
                 clj-http/clj-http {:mvn/version "2.1.0"}
                 ring/ring-mock {:mvn/version "0.4.0"}
                 }

backend/src/uxbox/http.clj

@@ -6,10 +6,8 @@
 
 (ns uxbox.http
   (:require [mount.core :refer [defstate]]
-            [muuntaja.core :as m]
             [ring.adapter.jetty :as jetty]
             [reitit.ring :as rr]
-            [reitit.dev.pretty :as pretty]
             [uxbox.config :as cfg]
             [uxbox.http.middleware :refer [handler
                                            middleware
@@ -25,17 +23,9 @@
             [uxbox.api.svg :as api-svg]
             [uxbox.util.transit :as t]))
 
-(def ^:private muuntaja-instance
-  (m/create (update-in m/default-options [:formats "application/transit+json"]
-                       merge {:encoder-opts {:handlers t/+write-handlers+}
-                              :decoder-opts {:handlers t/+read-handlers+}})))
-
 (def ^:private router-options
-  {;;:reitit.middleware/transform dev/print-request-diffs
-   ::rr/default-options-handler options-handler
-   :exception pretty/exception
-   :data {:muuntaja muuntaja-instance
-          :middleware middleware}})
+  {::rr/default-options-handler options-handler
+   :data {:middleware middleware}})
 
 (def routes
   [["/media/*" (rr/create-resource-handler {:root "public/media"})]
@@ -114,8 +104,8 @@
 ;; --- State Initialization
 (def app
   (delay
-    (-> (rr/router routes router-options)
-        (rr/ring-handler (rr/create-default-handler)))))
+    (let [router (rr/router routes router-options)]
+      (rr/ring-handler router (rr/create-default-handler)))))
 
 (defn- start-server
   [config]

backend/src/uxbox/http/errors.clj

@@ -2,10 +2,11 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; Copyright (c) 20162019 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>
 
 (ns uxbox.http.errors
-  "A errors handling for the http server.")
+  "A errors handling for the http server."
+  (:require [io.aviso.exception :as e]))
 
 (defmulti handle-exception #(:type (ex-data %)))
 
@@ -15,13 +16,18 @@
     {:status 400
      :body response}))
 
+(defmethod handle-exception :parse
+  [err]
+  {:status 400
+   :body {:type :parse
+          :message (ex-message err)}})
+
 (defmethod handle-exception :default
   [err]
-  (let [response (ex-data err)]
-    {:status 500
-     :body response}))
-
-;; --- Entry Point
+  (e/write-exception err)
+  {:status 500
+   :body {:type :exception
+          :message (ex-message err)}})
 
 (defn- handle-data-access-exception
   [err]
@@ -29,47 +35,19 @@
         state (.getSQLState err)
         message (.getMessage err)]
     (case state
-      "P0002"
-      {:status 412 ;; precondition-failed
-       :body {:message message
-              :payload nil
-              :type :occ}}
-
-      (do
-        {:status 500
-         :message {:message message
-                   :type :unexpected
-                   :payload nil}}))))
-
-(defn- handle-unexpected-exception
-  [err]
-  (let [message (.getMessage err)]
-    {:status 500
-     :body {:message message
-            :type :unexpected
-            :payload nil}}))
+      "P0002" {:status 412 ;; precondition-failed
+               :body {:message message
+                      :type :occ}}
+      (handle-exception err))))
 
 (defn errors-handler
   [error context]
   (cond
-    (instance? clojure.lang.ExceptionInfo error)
-    (handle-exception error)
-
-    (instance? java.util.concurrent.CompletionException error)
-    (errors-handler context (.getCause error))
-
-    java.util.concurrent.ExecutionException
+    (or (instance? java.util.concurrent.CompletionException error)
+        (instance? java.util.concurrent.ExecutionException error))
     (errors-handler context (.getCause error))
 
     (instance? org.jooq.exception.DataAccessException error)
     (handle-data-access-exception error)
 
-    :else
-    (handle-unexpected-exception error)))
-
-(defn wrap-print-errors
-  [handler error request]
-  (println "\n*********** stack trace ***********")
-  (.printStackTrace error)
-  (println "\n********* end stack trace *********")
-  (handler error request))
+    :else (handle-exception error)))

backend/src/uxbox/http/middleware.clj

@@ -5,24 +5,33 @@
 ;; Copyright (c) 2016-2019 Andrey Antukh <niwi@niwi.nz>
 
 (ns uxbox.http.middleware
-  (:require [promesa.core :as p]
-            [cuerdas.core :as str]
-            [struct.core :as st]
-            [reitit.ring :as rr]
-            [reitit.ring.middleware.multipart :as multipart]
-            [reitit.ring.middleware.muuntaja :as muuntaja]
-            [reitit.ring.middleware.parameters :as parameters]
-            [reitit.ring.middleware.exception :as exception]
-            [ring.middleware.session :refer [wrap-session]]
-            [ring.middleware.session.cookie :refer [cookie-store]]
-            [ring.middleware.multipart-params :refer [wrap-multipart-params]]
-            [uxbox.config :as cfg]
-            [uxbox.http.etag :refer [wrap-etag]]
-            [uxbox.http.cors :refer [wrap-cors]]
-            [uxbox.http.errors :as errors]
-            [uxbox.http.response :as rsp]
-            [uxbox.util.data :refer [normalize-attrs]]
-            [uxbox.util.exceptions :as ex]))
+  (:require
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [promesa.core :as p]
+   [reitit.ring :as rr]
+   [reitit.ring.middleware.exception :as exception]
+   [reitit.ring.middleware.multipart :as multipart]
+   [reitit.ring.middleware.parameters :as parameters]
+   [ring.middleware.multipart-params :refer [wrap-multipart-params]]
+   [ring.middleware.session :refer [wrap-session]]
+   [ring.middleware.session.cookie :refer [cookie-store]]
+   [struct.core :as st]
+   [uxbox.config :as cfg]
+   [uxbox.http.cors :refer [wrap-cors]]
+   [uxbox.http.errors :as errors]
+   [uxbox.http.etag :refer [wrap-etag]]
+   [uxbox.http.response :as rsp]
+   [uxbox.util.data :refer [normalize-attrs]]
+   [uxbox.util.exceptions :as ex]
+   [uxbox.util.spec :as us]
+   [uxbox.util.transit :as t]))
+
+(extend-protocol ring.core.protocols/StreamableResponseBody
+  (Class/forName "[B")
+  (write-body-to-stream [body _ ^java.io.OutputStream output-stream]
+    (with-open [out output-stream]
+      (.write out ^bytes body))))
 
 (defn- transform-handler
   [handler]
@@ -37,6 +46,9 @@
       (catch Exception e
         (raise e)))))
 
+;; The middleware that transform string keys to keywords and perform
+;; usability transformations.
+
 (def ^:private normalize-params-middleware
   {:name ::normalize-params-middleware
    :wrap (fn [handler]
@@ -89,18 +101,61 @@
                    (assoc-in req [:parameters (:key spec)] result))))
              request parameters))
 
+          (compile-struct [route opts parameters]
+            (let [parameters (prepare parameters)]
+              (fn [handler]
+                (fn
+                  ([request]
+                   (handler (validate request parameters)))
+                  ([request respond raise]
+                   (try
+                     (handler (validate request parameters false) respond raise)
+                     (catch Exception e
+                       (raise e))))))))
+
+          (prepare-spec [parameters]
+            (reduce-kv (fn [acc key s]
+                         (let [rk (case key
+                                    :path :path-params
+                                    :query :query-params
+                                    :body :body-params
+                                    :multipart :multipart-params
+                                    (throw (ex-info "Not supported key on :parameters" {})))]
+                           (assoc acc rk {:key key
+                                          :fn #(us/conform s %)})))
+                       {}
+                       parameters))
+
+          (validate-spec [request parameters]
+            (reduce-kv
+             (fn [req key spec]
+               (let [[result errors] ((:fn spec) (get req key))]
+                 (if errors
+                   (ex/raise :type :validation
+                             :code :parameters
+                             :context {:problems (vec (::s/problems errors))
+                                       :spec (::s/spec errors)
+                                       :value (::s/value errors)})
+                   (assoc-in req [:parameters (:key spec)] result))))
+             request parameters))
+
+          (compile-spec [route opts parameters]
+            (let [parameters (prepare-spec parameters)]
+              (fn [handler]
+                (fn
+                  ([request]
+                   (handler (validate-spec request parameters)))
+                  ([request respond raise]
+                   (try
+                     (handler (validate-spec request parameters) respond raise)
+                     (catch Exception e
+                       (raise e))))))))
+
           (compile [route opts]
             (when-let [parameters (:parameters route)]
-              (let [parameters (prepare parameters)]
-                (fn [handler]
-                  (fn
-                    ([request]
-                     (handler (validate request parameters)))
-                    ([request respond raise]
-                     (try
-                       (handler (validate request parameters false) respond raise)
-                       (catch Exception e
-                         (raise e)))))))))]
+              (if (= :spec (:validation route))
+                (compile-spec route opts parameters)
+                (compile-struct route opts parameters))))]
     {:name ::parameters-validation-middleware
      :compile compile}))
 
@@ -135,8 +190,8 @@
 (def ^:private exception-middleware
   (exception/create-exception-middleware
    (assoc exception/default-handlers
-          ::exception/default errors/errors-handler
-          ::exception/wrap errors/wrap-print-errors)))
+          :muuntaja/decode errors/errors-handler
+          ::exception/default errors/errors-handler)))
 
 (def authorization-middleware
   {:name ::authorization-middleware
@@ -151,6 +206,49 @@
                 (handler (assoc request :identity identity :user identity) respond raise)
                 (respond (rsp/forbidden nil))))))})
 
+(def format-response-middleware
+  (letfn [(process-response [{:keys [body] :as rsp}]
+            (if body
+              (let [body (t/encode body {:type :json-verbose})]
+                (-> rsp
+                    (assoc :body body)
+                    (update :headers assoc "content-type" "application/transit+json")))
+              rsp))]
+    {:name ::format-response-middleware
+     :wrap (fn [handler]
+             (fn
+               ([request]
+                (process-response (handler request)))
+               ([request respond raise]
+                (handler request (fn [res] (respond (process-response res))) raise))))}))
+
+(def parse-request-middleware
+  (letfn [(get-content-type [request]
+            (or (:content-type request)
+                (get (:headers request) "content-type")))
+          (process-request [request]
+            (let [ctype (get-content-type request)]
+              (if (= "application/transit+json" ctype)
+                (try
+                  (assoc request :body-params (t/decode (:body request)))
+                  (catch Exception e
+                    (ex/raise :type :parse
+                              :message "Unable to parse transit from request body."
+                              :cause e)))
+                request)))]
+
+    {:name ::parse-request-middleware
+     :wrap (fn [handler]
+             (fn
+               ([request]
+                (handler (process-request request)))
+               ([request respond raise]
+                (try
+                  (let [request (process-request request)]
+                    (handler request respond raise))
+                  (catch Exception e
+                    (raise e))))))}))
+
 (def middleware
   [cors-middleware
    session-middleware
@@ -159,18 +257,22 @@
    etag-middleware
 
    parameters/parameters-middleware
-   muuntaja/format-negotiate-middleware
-   ;; encoding response body
-   muuntaja/format-response-middleware
-   ;; exception handling
-   exception-middleware
-   ;; decoding request body
-   muuntaja/format-request-middleware
 
-   ;; multipart
+   ;; Format the body into transit
+   format-response-middleware
+
+   ;; main exception handling
+   exception-middleware
+
+   ;; parse transit format from request body
+   parse-request-middleware
+
+   ;; multipart parsing
    multipart-params-middleware
+
    ;; parameters normalization
    normalize-params-middleware
+
    ;; parameters validation
    parameters-validation-middleware])