Polish implementations

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

@@ -15,6 +15,8 @@
 
 (defrecord ParameterCoercion [in style keywordize? open?])
 
+(def valid-type? #{::request-coercion ::response-coercion})
+
 (def ring-parameter-coercion
   {:query (->ParameterCoercion :query-params :string true true)
    :body (->ParameterCoercion :body-params :string false true)
@@ -47,6 +49,8 @@
          :request request
          :response response}))))
 
+;; TODO: support faster key walking, walk/keywordize-keys is quite slow...
+
 (defn request-coercer [coercion type model]
   (if coercion
     (let [{:keys [keywordize? open? in style]} (ring-parameter-coercion type)
@@ -81,7 +85,7 @@
 ;; middleware
 ;;
 
-(defn- coerce-parameters [coercers request]
+(defn- coerce-request [coercers request]
   (reduce-kv
     (fn [acc k coercer]
       (impl/fast-assoc acc k (coercer request)))
@@ -131,21 +135,21 @@
            (handler (impl/fast-assoc request :parameters coerced) respond raise)))))))
 
 (def gen-wrap-coerce-parameters
-  "Generator for pluggable request coercion middleware.
+  "Middleware for pluggable request coercion.
   Expects a :coercion of type `reitit.coercion.protocol/Coercion`
   and :parameters from route data, otherwise does not mount."
   (middleware/create
     {:name ::coerce-parameters
-     :gen-wrap (fn [{:keys [parameters coercion]} _]
+     :gen-wrap (fn [{:keys [coercion parameters]} _]
                  (if (and coercion parameters)
                    (let [coercers (request-coercers coercion parameters)]
                      (fn [handler]
                        (fn
                          ([request]
-                          (let [coerced (coerce-parameters coercers request)]
+                          (let [coerced (coerce-request coercers request)]
                             (handler (impl/fast-assoc request :parameters coerced))))
                          ([request respond raise]
-                          (let [coerced (coerce-parameters coercers request)]
+                          (let [coerced (coerce-request coercers request)]
                             (handler (impl/fast-assoc request :parameters coerced) respond raise))))))))}))
 
 (defn wrap-coerce-response
@@ -177,12 +181,12 @@
          (handler request respond raise))))))
 
 (def gen-wrap-coerce-response
-  "Generator for pluggable response coercion middleware.
+  "Middleware for pluggable response coercion.
   Expects a :coercion of type `reitit.coercion.protocol/Coercion`
   and :responses from route data, otherwise does not mount."
   (middleware/create
     {:name ::coerce-response
-     :gen-wrap (fn [{:keys [responses coercion opts]} _]
+     :gen-wrap (fn [{:keys [coercion responses opts]} _]
                  (if (and coercion responses)
                    (let [coercers (response-coercers coercion responses opts)]
                      (fn [handler]

modules/reitit-schema/src/reitit/ring/coercion/schema.cljc

@@ -1,112 +1,90 @@
 (ns reitit.ring.coercion.schema
-  (:require [clojure.spec.alpha :as s]
-            [spec-tools.core :as st #?@(:cljs [:refer [Spec]])]
-            [spec-tools.data-spec :as ds]
-            [spec-tools.conform :as conform]
+  (:require [schema.core :as s]
+            [schema-tools.core :as st]
+            [schema.coerce :as sc]
+            [schema.utils :as su]
+            [schema-tools.coerce :as stc]
             [spec-tools.swagger.core :as swagger]
+            [clojure.walk :as walk]
             [reitit.ring.coercion.protocol :as protocol])
-  #?(:clj
-     (:import (spec_tools.core Spec))))
+  (:import (schema.core OptionalKey RequiredKey)
+           (schema.utils ValidationError NamedError)))
 
-(def string-conforming
-  (st/type-conforming
-    (merge
-      conform/string-type-conforming
-      conform/strip-extra-keys-type-conforming)))
+(def string-coercion-matcher
+  stc/string-coercion-matcher)
 
-(def json-conforming
-  (st/type-conforming
-    (merge
-      conform/json-type-conforming
-      conform/strip-extra-keys-type-conforming)))
+(def json-coercion-matcher
+  stc/json-coercion-matcher)
 
-(def default-conforming
-  ::default)
-
-(defprotocol IntoSpec
-  (into-spec [this name]))
-
-(extend-protocol IntoSpec
-
-  #?(:clj  clojure.lang.PersistentArrayMap
-     :cljs cljs.core.PersistentArrayMap)
-  (into-spec [this name]
-    (ds/spec name this))
-
-  #?(:clj  clojure.lang.PersistentHashMap
-     :cljs cljs.core.PersistentHashMap)
-  (into-spec [this name]
-    (ds/spec name this))
-
-  Spec
-  (into-spec [this _] this)
-
-  #?(:clj  Object
-     :cljs default)
-  (into-spec [this _]
-    (st/create-spec {:spec this})))
-
-;; TODO: proper name!
-(def memoized-into-spec
-  (memoize #(into-spec %1 (gensym "spec"))))
+(def default-coercion-matcher
+  (constantly nil))
 
 (defmulti coerce-response? identity :default ::default)
 (defmethod coerce-response? ::default [_] true)
 
-(defrecord SpecCoercion [name conforming coerce-response?]
+(defn stringify [schema]
+  (walk/prewalk
+    (fn [x]
+      (cond
+        (class? x) (.getName ^Class x)
+        (instance? OptionalKey x) (pr-str (list 'opt (:k x)))
+        (instance? RequiredKey x) (pr-str (list 'req (:k x)))
+        (and (satisfies? s/Schema x) (record? x)) (try (pr-str (s/explain x)) (catch Exception _ x))
+        (instance? ValidationError x) (str (su/validation-error-explain x))
+        (instance? NamedError x) (str (su/named-error-explain x))
+        :else x))
+    schema))
+
+(defrecord SchemaCoercion [name matchers coerce-response?]
 
   protocol/Coercion
   (get-name [_] name)
 
   (compile [_ model _]
-    (memoized-into-spec model))
+    model)
 
   (get-apidocs [_ _ {:keys [parameters responses] :as info}]
     (cond-> (dissoc info :parameters :responses)
             parameters (assoc
                          ::swagger/parameters
-                         (into
-                           (empty parameters)
-                           (for [[k v] parameters]
-                             [k memoized-into-spec])))
+                         parameters)
             responses (assoc
                         ::swagger/responses
-                        (into
-                          (empty responses)
-                          (for [[k response] responses]
-                            [k (update response :schema memoized-into-spec)])))))
+                        responses)))
 
-  (make-open [_ spec] spec)
+  (make-open [_ schema] (st/open-schema schema))
 
   (encode-error [_ error]
-    (update error :spec (comp str s/form)))
+    (-> error
+        (update :schema stringify)
+        (update :errors stringify)))
 
-  (request-coercer [_ type spec]
-    (let [spec (memoized-into-spec spec)
-          {:keys [formats default]} (conforming type)]
+  ;; TODO: create all possible coercers ahead of time
+  (request-coercer [_ type schema]
+    (let [{:keys [formats default]} (matchers type)]
       (fn [value format]
-        (if-let [conforming (or (get formats format) default)]
-          (let [conformed (st/conform spec value conforming)]
-            (if (s/invalid? conformed)
-              (let [problems (st/explain-data spec value conforming)]
-                (protocol/map->CoercionError
-                  {:spec spec
-                   :problems (::s/problems problems)}))
-              (s/unform spec conformed)))
+        (if-let [matcher (or (get formats format) default)]
+          (let [coercer (sc/coercer schema matcher)
+                coerced (coercer value)]
+            (if-let [error (su/error-val coerced)]
+              (protocol/map->CoercionError
+                {:schema schema
+                 :errors error})
+              coerced))
           value))))
 
-  (response-coercer [this spec]
-    (if (coerce-response? spec)
-      (protocol/request-coercer this :response spec))))
+  (response-coercer [this schema]
+    (if (coerce-response? schema)
+      (protocol/request-coercer this :response schema))))
 
 (def default-options
   {:coerce-response? coerce-response?
-   :conforming {:body {:default default-conforming
-                       :formats {"application/json" json-conforming}}
-                :string {:default string-conforming}
-                :response {:default default-conforming}}})
+   :matchers {:body {:default default-coercion-matcher
+                     :formats {"application/json" json-coercion-matcher}}
+              :string {:default string-coercion-matcher}
+              :response {:default default-coercion-matcher}}})
 
-(defn create [{:keys [conforming coerce-response?]}]
-  (->SpecCoercion :spec conforming coerce-response?))
+(defn create [{:keys [matchers coerce-response?]}]
+  (->SchemaCoercion :schema matchers coerce-response?))
 
 (def coercion (create default-options))

modules/reitit-spec/src/reitit/ring/coercion/spec.cljc

@@ -50,6 +50,11 @@
 (def memoized-into-spec
   (memoize #(into-spec %1 (gensym "spec"))))
 
+(defn stringify-pred [pred]
+  (str (if (instance? clojure.lang.LazySeq pred)
+         (seq pred)
+         pred)))
+
 (defmulti coerce-response? identity :default ::default)
 (defmethod coerce-response? ::default [_] true)
 
@@ -79,7 +84,9 @@
   (make-open [_ spec] spec)
 
   (encode-error [_ error]
-    (update error :spec (comp str s/form)))
+    (-> error
+        (update :spec (comp str s/form))
+        (update :problems (partial mapv #(update % :pred stringify-pred)))))
 
   (request-coercer [_ type spec]
     (let [spec (memoized-into-spec spec)

modules/reitit/project.clj

@@ -8,4 +8,5 @@
                    :inherit [:deploy-repositories :managed-dependencies]}
   :dependencies [[metosin/reitit-core]
                  [metosin/reitit-ring]
-                 [metosin/reitit-spec]])
+                 [metosin/reitit-spec]
+                 [metosin/reitit-schema]])

project.clj

@@ -17,7 +17,7 @@
 
                          [meta-merge "1.0.0"]
                          [metosin/spec-tools "0.5.1"]
-                         [metosin/schema-tools "0.9.1"]]
+                         [metosin/schema-tools "0.10.0-SNAPSHOT"]]
 
   :plugins [[jonase/eastwood "0.2.5"]
             [lein-doo "0.1.8"]
@@ -38,8 +38,9 @@
                    :dependencies [[org.clojure/clojure "1.9.0-RC1"]
                                   [org.clojure/clojurescript "1.9.946"]
 
-                                  ;; all modules dependencies
+                                  ;; modules dependencies
                                   [metosin/reitit]
+                                  [metosin/schema-tools "0.10.0-SNAPSHOT"]
 
                                   [expound "0.3.2"]
                                   [orchestra "2017.08.13"]