Response coercion is decode + validate + encode

modules/reitit-malli/src/reitit/coercion/malli.cljc

@@ -3,9 +3,11 @@
             [malli.transform :as mt]
             [malli.edn :as edn]
             [malli.error :as me]
+            [malli.util :as mu]
             [malli.swagger :as swagger]
             [malli.core :as m]
-            [clojure.set :as set]))
+            [clojure.set :as set]
+            [clojure.walk :as walk]))
 
 ;;
 ;; coercion
@@ -13,28 +15,22 @@
 
 (defrecord Coercer [decoder encoder validator explainer])
 
-(def string-transformer
-  (mt/transformer
-    mt/strip-extra-keys-transformer
-    mt/string-transformer
-    mt/default-value-transformer))
+(defprotocol TransformationProvider
+  (-transformer [this options]))
 
-(def json-transformer
-  (mt/transformer
-    mt/strip-extra-keys-transformer
-    mt/json-transformer
-    mt/default-value-transformer))
+(defn- -provider [transformer]
+  (reify TransformationProvider
+    (-transformer [_ {:keys [strip-extra-keys default-values]}]
+      (mt/transformer
+        (if strip-extra-keys (mt/strip-extra-keys-transformer))
+        transformer
+        (if default-values (mt/default-value-transformer))))))
 
-(def default-transformer
-  (mt/transformer
-    mt/strip-extra-keys-transformer
-    mt/default-value-transformer))
+(def string-transformer-provider (-provider (mt/string-transformer)))
+(def json-transformer-provider (-provider (mt/json-transformer)))
+(def default-transformer-provider (-provider nil))
 
-;; TODO: are these needed?
-(defmulti coerce-response? identity :default ::default)
-(defmethod coerce-response? ::default [_] true)
-
-(defn- -coercer [schema type transformers f opts]
+(defn- -coercer [schema type transformers f encoder opts]
   (if schema
     (let [->coercer (fn [t] (if t (->Coercer (m/decoder schema opts t)
                                              (m/encoder schema opts t)
@@ -42,17 +38,18 @@
                                              (m/explainer schema opts))))
           {:keys [formats default]} (transformers type)
           default-coercer (->coercer default)
+          encode (or encoder (fn [value _format] value))
           format-coercers (some->> (for [[f t] formats] [f (->coercer t)]) (filter second) (seq) (into {}))
           get-coercer (cond format-coercers (fn [format] (or (get format-coercers format) default-coercer))
                             default-coercer (constantly default-coercer))]
       (if get-coercer
         (if (= f :decode)
-          ;; transform -> validate
+          ;; decode -> validate
           (fn [value format]
             (if-let [coercer (get-coercer format)]
-              (let [transform (:decoder coercer)
+              (let [decoder (:decoder coercer)
                     validator (:validator coercer)
-                    transformed (transform value)]
+                    transformed (decoder value)]
                 (if (validator transformed)
                   transformed
                   (let [explainer (:explainer coercer)
@@ -60,16 +57,18 @@
                     (coercion/map->CoercionError
                       (assoc error :transformed transformed)))))
               value))
-          ;; validate -> transform
+          ;; decode -> validate -> encode
           (fn [value format]
             (if-let [coercer (get-coercer format)]
-              (let [transform (:encoder coercer)
+              (let [decoder (:decoder coercer)
                     validator (:validator coercer)
-                    explainer (:explainer coercer)]
-                (if (validator value)
-                  (transform value)
-                  (coercion/map->CoercionError
-                    (explainer value))))
+                    transformed (decoder value)]
+                (if (validator transformed)
+                  (encode transformed format)
+                  (let [explainer (:explainer coercer)
+                        error (explainer transformed)]
+                    (coercion/map->CoercionError
+                      (assoc error :transformed transformed)))))
               value)))))))
 
 ;;
@@ -104,14 +103,18 @@
 ;;
 
 (def default-options
-  {:coerce-response? coerce-response?
-   :transformers {:body {:default default-transformer
-                         :formats {"application/json" json-transformer}}
-                  :string {:default string-transformer}
-                  :response {:default default-transformer
-                             :formats {"application/json" json-transformer}}}
+  {:transformers {:body {:default default-transformer-provider
+                         :formats {"application/json" json-transformer-provider}}
+                  :string {:default string-transformer-provider}
+                  :response {:default default-transformer-provider}}
    ;; set of keys to include in error messages
    :error-keys #{:type :coercion :in :schema :value :errors :humanized #_:transformed}
+   ;; schema identity function
+   :compile mu/closed-schema
+   ;; strip-extra-keys (effects only default transformers!)
+   :strip-extra-keys true
+   ;; add default values
+   :default-values true
    ;; malli options
    :options nil})
 
@@ -119,8 +122,9 @@
   ([]
    (create nil))
   ([opts]
-   (let [{:keys [transformers coerce-response? options error-keys] :as opts} (merge default-options opts)
-         show? (fn [key] (contains? error-keys key))]
+   (let [{:keys [transformers compile options error-keys] :as opts} (merge default-options opts)
+         show? (fn [key] (contains? error-keys key))
+         transformers (walk/prewalk #(if (satisfies? TransformationProvider %) (-transformer % opts) %) transformers)]
      ^{:type ::coercion/coercion}
      (reify coercion/Coercion
        (-get-name [_] :malli)
@@ -131,7 +135,7 @@
                       (if parameters
                         {:parameters
                          (->> (for [[in schema] parameters
-                                    parameter (extract-parameter in schema)]
+                                    parameter (extract-parameter in (compile schema))]
                                 parameter)
                               (into []))})
                       (if responses
@@ -143,13 +147,15 @@
                                            (set/rename-keys $ {:body :schema})
                                            (update $ :description (fnil identity ""))
                                            (if (:schema $)
-                                             (update $ :schema swagger/transform {:type :schema})
+                                             (-> $
+                                                 (update :schema compile)
+                                                 (update :schema swagger/transform {:type :schema}))
                                              $))]))}))
            (throw
              (ex-info
                (str "Can't produce Schema apidocs for " specification)
                {:type specification, :coercion :schema}))))
-       (-compile-model [_ model _] (m/schema model))
+       (-compile-model [_ model _] (compile model))
        (-open-model [_ schema] schema)
        (-encode-error [_ error]
          (cond-> error
@@ -159,9 +165,10 @@
                                      (update :errors (partial map #(update % :schema edn/write-string opts))))
                  (seq error-keys) (select-keys error-keys)))
        (-request-coercer [_ type schema]
-         (-coercer schema type transformers :decode options))
+         (-coercer (compile schema) type transformers :decode nil options))
        (-response-coercer [_ schema]
-         (if (coerce-response? schema)
-           (-coercer schema :response transformers :encode options)))))))
+         (let [schema (compile schema)
+               encoder (-coercer schema :body transformers :encode nil options)]
+           (-coercer schema :response transformers :encode encoder options)))))))
 
 (def coercion (create default-options))

project.clj

@@ -33,7 +33,7 @@
                          [metosin/muuntaja "0.6.5"]
                          [metosin/jsonista "0.2.5"]
                          [metosin/sieppari "0.0.0-alpha7"]
-                         [metosin/malli "0.0.1-20191228.073043-6"]
+                         [metosin/malli "0.0.1-20200106.232607-10"]
 
                          [meta-merge "1.0.0"]
                          [fipp "0.6.21" :exclusions [org.clojure/core.rrb-vector]]

test/cljc/reitit/ring_coercion_test.cljc

@@ -265,7 +265,72 @@
 
         (testing "invalid response"
           (let [{:keys [status]} (app invalid-request2)]
-            (is (= 500 status))))))))
+            (is (= 500 status))))))
+
+    (testing "open & closed schemas"
+      (let [endpoint (fn [schema]
+                       {:get {:parameters {:body schema}
+                              :responses {200 {:body schema}}
+                              :handler (fn [{{:keys [body]} :parameters}]
+                                         {:status 200, :body (assoc body :response true)})}})
+            ->app (fn [options]
+                    (ring/ring-handler
+                      (ring/router
+                        ["/api"
+                         ["/default" (endpoint [:map [:x int?]])]
+                         ["/closed" (endpoint [:map {:closed true} [:x int?]])]
+                         ["/open" (endpoint [:map {:closed false} [:x int?]])]]
+                        {:data {:middleware [rrc/coerce-exceptions-middleware
+                                             rrc/coerce-request-middleware
+                                             rrc/coerce-response-middleware]
+                                :coercion (malli/create options)}})))
+            ->request (fn [uri] {:uri (str "/api/" uri)
+                                 :request-method :get
+                                 :muuntaja/request {:format "application/json"}
+                                 :body-params {:x 1, :request true}})]
+
+        (testing "with defaults"
+          (let [app (->app nil)]
+
+            (testing "default: keys are stripped"
+              (is (= {:status 200, :body {:x 1}}
+                     (app (->request "default")))))
+
+            (testing "closed: keys are stripped"
+              (is (= {:status 200, :body {:x 1}}
+                     (app (->request "closed")))))
+
+            (testing "open: keys are NOT stripped"
+              (is (= {:status 200, :body {:x 1, :request true, :response true}}
+                     (app (->request "open")))))))
+
+        (testing "when schemas are not closed"
+          (let [app (->app {:compile identity})]
+
+            (testing "default: keys are stripped"
+              (is (= {:status 200, :body {:x 1}}
+                     (app (->request "default")))))
+
+            (testing "closed: keys are stripped"
+              (is (= {:status 200, :body {:x 1}}
+                     (app (->request "closed")))))
+
+            (testing "open: keys are NOT stripped"
+              (is (= {:status 200, :body {:x 1, :request true, :response true}}
+                     (app (->request "open")))))))
+
+        (testing "when schemas are not closed and extra keys are not stripped"
+          (let [app (->app {:compile identity, :strip-extra-keys false})]
+            (testing "default: keys are NOT stripped"
+              (is (= {:status 200, :body {:x 1, :request true, :response true}}
+                     (app (->request "default")))))
+
+            (testing "closed: FAILS for extra keys"
+              (is (= 400 (:status (app (->request "closed"))))))
+
+            (testing "open: keys are NOT stripped"
+              (is (= {:status 200, :body {:x 1, :request true, :response true}}
+                     (app (->request "open")))))))))))
 
 #?(:clj
    (deftest muuntaja-test