Initial Spec request/response coercion (fixes #20)

This commit is contained in:
Tommi Reiman 2017-08-30 08:19:21 +03:00
parent 86acee9098
commit dcd559bf27
7 changed files with 600 additions and 17 deletions

View file

@ -0,0 +1,174 @@
(ns reitit.coercion-perf-test
(:require [clojure.test :refer [deftest testing is]]
[criterium.core :as cc]
[reitit.perf-utils :refer :all]
[clojure.spec.alpha :as s]
[spec-tools.core :as st]
[reitit.core :as reitit]
[reitit.ring :as ring]
[reitit.coercion :as coercion]
[reitit.coercion.spec :as spec]
[reitit.coercion.protocol :as protocol]
[spec-tools.data-spec :as ds]))
;;
;; start repl with `lein perf repl`
;; perf measured with the following setup:
;;
;; Model Name: MacBook Pro
;; Model Identifier: MacBookPro11,3
;; Processor Name: Intel Core i7
;; Processor Speed: 2,5 GHz
;; Number of Processors: 1
;; Total Number of Cores: 4
;; L2 Cache (per Core): 256 KB
;; L3 Cache: 6 MB
;; Memory: 16 GB
;;
(comment
(do
(s/def ::x (s/and (s/conformer #(if (string? %) (Long/parseLong %) %) identity) int?))
(s/def ::y (s/and (s/conformer #(if (string? %) (Long/parseLong %) %) identity) int?))
(s/def ::k (s/keys :req-un [::x ::y]))
(let [spec (spec/specify {:x int?, :y int?} ::jeah)
coercers (#'coercion/request-coercers spec/coercion {:body spec})
params {:x "1", :y "2"}
request {:body-params {:x "1", :y "2"}}]
;; 4600ns
(bench!
"coerce-parameters"
(#'coercion/coerce-parameters coercers request))
;; 2700ns
(bench!
"st/conform"
(st/conform
spec
params
spec/string-conforming))
;; 4100ns
(bench!
"st/conform + s/unform"
(s/unform
spec
(st/conform
spec
params
spec/string-conforming)))
;; 610ns
(bench!
"s/conform"
(s/conform
::k
params))
;; 2700ns
(bench!
"s/conform + s/unform"
(s/unform
::k
(s/conform
::k
params))))))
(defrecord NoOpCoercion []
protocol/Coercion
(get-name [_] :no-op)
(compile [_ model] model)
(get-apidocs [_ _ {:keys [parameters responses] :as info}])
(make-open [_ spec] spec)
(encode-error [_ error] error)
(request-coercer [_ type spec] (fn [value format] value))
(response-coercer [this spec] (protocol/request-coercer this :response spec)))
(comment
(doseq [coercion [nil (->NoOpCoercion) spec/coercion]]
(suite (str (if coercion (protocol/get-name coercion))))
(let [routes ["/api"
["/ping" {:parameters {:body {:x int?, :y int?}}
:responses {200 {:schema {:total pos-int?}}}
:get {:handler (fn [request]
(let [{:keys [x y]} (-> request :parameters :body)]
{:status 200
:body {:total (+ (or x 0) (or y 0))}}))}}]]
app (ring/ring-handler
(ring/router
routes
{:meta {:middleware [coercion/wrap-coerce-parameters]
:coercion coercion}}))
app2 (ring/ring-handler
(ring/router
routes
{:meta {:middleware [coercion/gen-wrap-coerce-parameters]
:coercion coercion}}))
app3 (ring/ring-handler
(ring/router
routes
{:meta {:middleware [coercion/wrap-coerce-parameters
coercion/wrap-coerce-response]
:coercion coercion}}))
app4 (ring/ring-handler
(ring/router
routes
{:meta {:middleware [coercion/gen-wrap-coerce-parameters
coercion/gen-wrap-coerce-response]
:coercion coercion}}))
req {:request-method :get
:uri "/api/ping"
:body-params {:x 1, :y 2}}]
;; 210ns
;; 1300ns
;; 7400ns
(bench! "wrap-coerce-parameters" (app req))
;; 170ns (-19%)
;; 500ns (-62%)
;; 5400ns (-26%)
(bench! "gen-wrap-coerce-parameters" (app2 req))
;; 340ns
;; 2400ns
;; 14800ns
(bench! "wrap-coerce-parameters & responses" (app3 req))
;; 180ns (-47%)
;; 580ns (-76%)
;; 8300ns (-44%)
(bench! "gen-wrap-coerce-parameters & responses" (app4 req)))))
(comment
(do
(require '[reitit.ring :as ring])
(require '[reitit.coercion :as coercion])
(require '[reitit.coercion.spec :as spec])
(def app
(ring/ring-handler
(ring/router
["/api"
["/ping" {:parameters {:body {:x int?, :y int?}}
:responses {200 {:schema {:total pos-int?}}}
:get {:handler (fn [{{{:keys [x y]} :body} :parameters}]
{:status 200
:body {:total (+ x y)}})}}]]
{:meta {:middleware [coercion/gen-wrap-coerce-parameters
coercion/gen-wrap-coerce-response]
:coercion spec/coercion}})))
(app
{:request-method :get
:uri "/api/ping"
:body-params {:x 1, :y 2}})
; {:status 200, :body {:total 3}}
(let [req {:request-method :get
:uri "/api/ping"
:body-params {:x 1, :y 2}}]
(cc/quick-bench (app req)))))

View file

@ -22,6 +22,10 @@
:jvm-opts ^:replace ["-server"]
:dependencies [[org.clojure/clojure "1.9.0-alpha17"]
[org.clojure/clojurescript "1.9.660"]
[metosin/spec-tools "0.3.2"]
[org.clojure/spec.alpha "0.1.123"]
[criterium "0.4.4"]
[org.clojure/test.check "0.9.0"]
[org.clojure/tools.namespace "0.2.11"]

192
src/reitit/coercion.cljc Normal file
View file

@ -0,0 +1,192 @@
(ns reitit.coercion
(:require [clojure.walk :as walk]
[spec-tools.core :as st]
[reitit.coercion.protocol :as protocol]
[reitit.middleware :as middleware]
[reitit.ring :as ring]
[reitit.impl :as impl]))
(defn get-apidocs [coercion spec info]
(protocol/get-apidocs coercion spec info))
;;
;; coercer
;;
(defrecord ParameterCoercion [in style keywordize? open?])
(def ring-parameter-coercion
{:query (->ParameterCoercion :query-params :string true true)
:body (->ParameterCoercion :body-params :string false true)
:form (->ParameterCoercion :form-params :string true true)
:header (->ParameterCoercion :header-params :string true true)
:path (->ParameterCoercion :path-params :string true true)})
(defn request-coercion-failed! [result coercion value in request]
(throw
(ex-info
(str "Request coercion failed: " (pr-str result))
(merge
(into {} result)
{:type ::request-coercion
:coercion coercion
:value value
:in [:request in]
:request request}))))
(defn response-coercion-failed! [result coercion value request response]
(throw
(ex-info
(str "Response coercion failed: " (pr-str result))
(merge
(into {} result)
{:type ::response-coercion
:coercion coercion
:value value
:in [:response :body]
:request request
:response response}))))
(defn request-coercer [coercion type model]
(if coercion
(let [{:keys [keywordize? open? in style]} (ring-parameter-coercion type)
transform (comp (if keywordize? walk/keywordize-keys identity) in)
model (if open? (protocol/make-open coercion model) model)
coercer (protocol/request-coercer coercion style model)]
(fn [request]
(let [value (transform request)
format (some-> request :muuntaja/request :format)
result (coercer value format)]
(if (protocol/error? result)
(request-coercion-failed! result coercion value in request)
result))))))
(defn- response-format [request response]
(or (-> response :muuntaja/content-type)
(some-> request :muuntaja/response :format)))
(defn response-coercer [coercion model]
(if coercion
(let [coercer (protocol/response-coercer coercion model)]
(fn [request response]
(let [format (response-format request response)
value (:body response)
result (coercer value format)]
(if (protocol/error? result)
(response-coercion-failed! result coercion value request response)
result))))))
;;
;; middleware
;;
(defn- coerce-parameters [coercers request]
(reduce-kv
(fn [acc k coercer]
(impl/fast-assoc acc k (coercer request)))
{}
coercers))
(defn- coerce-response [coercers request response]
(if response
(if-let [coercer (or (coercers (:status response)) (coercers :default))]
(impl/fast-assoc response :body (coercer request response)))))
(defn ^:no-doc request-coercers [coercion parameters]
(->> (for [[k v] parameters
:when v]
[k (request-coercer coercion k v)])
(into {})))
(defn ^:no-doc response-coercers [coercion responses]
(->> (for [[status {:keys [schema]}] responses :when schema]
[status (response-coercer coercion schema)])
(into {})))
(defn wrap-coerce-parameters
"Pluggable request coercion middleware.
Expects a :coercion of type `reitit.coercion.protocol/Coercion`
from injected route meta, otherwise does not mount."
[handler]
(fn
([request]
(let [method (:request-method request)
match (ring/get-match request)
parameters (-> match :result method :meta :parameters)
coercion (-> match :meta :coercion)]
(if coercion
(let [coercers (request-coercers coercion parameters)
coerced (coerce-parameters coercers request)]
(handler (impl/fast-assoc request :parameters coerced)))
(handler request))))
([request respond raise]
(let [method (:request-method request)
match (ring/get-match request)
parameters (-> match :result method :meta :parameters)
coercion (-> match :meta :coercion)]
(if coercion
(let [coercers (request-coercers coercion parameters)
coerced (coerce-parameters coercers request)]
(handler (impl/fast-assoc request :parameters coerced) respond raise)))))))
(def gen-wrap-coerce-parameters
"Generator for pluggable request coercion middleware.
Expects a :coercion of type `reitit.coercion.protocol/Coercion`
from injected route meta, otherwise does not mount."
(middleware/gen
(fn [{:keys [parameters coercion]} _]
(if coercion
(let [coercers (request-coercers coercion parameters)]
(fn [handler]
(fn
([request]
(let [coerced (coerce-parameters coercers request)]
(handler (impl/fast-assoc request :parameters coerced))))
([request respond raise]
(let [coerced (coerce-parameters coercers request)]
(handler (impl/fast-assoc request :parameters coerced) respond raise))))))))))
(defn wrap-coerce-response
"Pluggable response coercion middleware.
Expects a :coercion of type `reitit.coercion.protocol/Coercion`
from injected route meta, otherwise does not mount."
[handler]
(fn
([request]
(let [response (handler request)
method (:request-method request)
match (ring/get-match request)
responses (-> match :result method :meta :responses)
coercion (-> match :meta :coercion)]
(if coercion
(let [coercers (response-coercers coercion responses)
coerced (coerce-response coercers request response)]
(coerce-response coercers request (handler request)))
(handler request))))
([request respond raise]
(let [response (handler request)
method (:request-method request)
match (ring/get-match request)
responses (-> match :result method :meta :responses)
coercion (-> match :meta :coercion)]
(if coercion
(let [coercers (response-coercers coercion responses)
coerced (coerce-response coercers request response)]
(handler request #(respond (coerce-response coercers request %))))
(handler request respond raise))))))
(def gen-wrap-coerce-response
"Generator for pluggable response coercion middleware.
Expects a :coercion of type `reitit.coercion.protocol/Coercion`
from injected route meta, otherwise does not mount."
(middleware/gen
(fn [{:keys [responses coercion]} _]
(if coercion
(let [coercers (response-coercers coercion responses)]
(fn [handler]
(fn
([request]
(coerce-response coercers request (handler request)))
([request respond raise]
(handler request #(respond (coerce-response coercers request %)) raise)))))))))

View file

@ -0,0 +1,16 @@
(ns reitit.coercion.protocol
(:refer-clojure :exclude [compile]))
(defprotocol Coercion
(get-name [this])
(compile [this model])
(get-apidocs [this model data])
(make-open [this model])
(encode-error [this error])
(request-coercer [this type model])
(response-coercer [this model]))
(defrecord CoercionError [])
(defn error? [x]
(instance? CoercionError x))

View file

@ -0,0 +1,113 @@
(ns reitit.coercion.spec
(: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]
[spec-tools.swagger.core :as swagger]
[reitit.coercion.protocol :as protocol])
#?(:clj
(:import (spec_tools.core Spec))))
(def string-conforming
(st/type-conforming
(merge
conform/string-type-conforming
conform/strip-extra-keys-type-conforming)))
(def json-conforming
(st/type-conforming
(merge
conform/json-type-conforming
conform/strip-extra-keys-type-conforming)))
(def default-conforming
::default)
(defprotocol Specify
(specify [this name]))
(extend-protocol Specify
#?(:clj clojure.lang.PersistentArrayMap
:cljs cljs.core.PersistentArrayMap)
(specify [this name]
(ds/spec name this))
#?(:clj clojure.lang.PersistentHashMap
:cljs cljs.core.PersistentHashMap)
(specify [this name]
(ds/spec name this))
Spec
(specify [this _] this)
Object
(specify [this _]
(st/create-spec {:spec this})))
;; TODO: proper name!
(def memoized-specify
(memoize #(specify %1 (gensym "spec"))))
(defmulti coerce-response? identity :default ::default)
(defmethod coerce-response? ::default [_] true)
(defrecord SpecCoercion [name conforming coerce-response?]
protocol/Coercion
(get-name [_] name)
(compile [_ model]
(memoized-specify 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-specify])))
responses (assoc
::swagger/responses
(into
(empty responses)
(for [[k response] responses]
[k (update response :schema memoized-specify)])))))
(make-open [_ spec] spec)
(encode-error [_ error]
(update error :spec (comp str s/form)))
(request-coercer [_ type spec]
(let [spec (memoized-specify spec)
{:keys [formats default]} (conforming 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)))
value))))
(response-coercer [this spec]
(if (coerce-response? spec)
(protocol/request-coercer this :response spec))))
(def default-options
{:coerce-response? coerce-response?
:conforming {:body {:default default-conforming
:formats {"application/json" json-conforming
"application/msgpack" json-conforming
"application/x-yaml" json-conforming}}
:string {:default string-conforming}
:response {:default default-conforming}}})
(defn create [{:keys [conforming coerce-response?]}]
(->SpecCoercion :spec conforming coerce-response?))
(def coercion (create default-options))

View file

@ -5,7 +5,8 @@
[reitit.impl :as impl]))
(def http-methods #{:get :head :patch :delete :options :post :put})
(defrecord MethodHandlers [get head patch delete options post put])
(defrecord Methods [get head post put delete trace options connect patch any])
(defrecord Endpoint [meta handler])
(defn- group-keys [meta]
(reduce-kv
@ -19,10 +20,27 @@
(fn
([request]
(if-let [match (reitit/match-by-path router (:uri request))]
((:handler match) (impl/fast-assoc request ::match match))))
(let [method (:request-method request :any)
params (:params match)
result (:result match)
handler (or (-> result method :handler)
(-> result :any :handler))]
(if handler
(handler
(cond-> (impl/fast-assoc request ::match match)
params (impl/fast-assoc :path-params params)))))))
([request respond raise]
(if-let [match (reitit/match-by-path router (:uri request))]
((:handler match) (impl/fast-assoc request ::match match) respond raise))))
(let [method (:request-method request :any)
params (:params match)
result (:result match)
handler (or (-> result method :handler)
(-> result :any :handler))]
(if handler
(handler
(cond-> (impl/fast-assoc request ::match match)
params (impl/fast-assoc :path-params params))
respond raise))))))
{::router router}))
(defn get-router [handler]
@ -41,20 +59,23 @@
(defn compile-handler [[path meta] opts]
(let [[top childs] (group-keys meta)]
(if-not (seq childs)
(middleware/compile-handler [path meta] opts)
(let [handlers (map->MethodHandlers
(reduce-kv
#(assoc %1 %2 (middleware/compile-handler
[path (meta-merge top %3)] opts %2))
{} childs))
default-handler (if (:handler top) (middleware/compile-handler [path meta] opts))]
(fn
([request]
(if-let [handler (or ((:request-method request) handlers) default-handler)]
(handler request)))
([request respond raise]
(if-let [handler (or ((:request-method request) handlers) default-handler)]
(handler request respond raise))))))))
(map->Methods
{:any (map->Endpoint
{:handler (middleware/compile-handler [path top] opts)
:meta top})})
(let [any-handler (if (:handler top) (middleware/compile-handler [path meta] opts))]
(reduce-kv
(fn [acc method meta]
(let [meta (meta-merge top meta)
handler (middleware/compile-handler [path meta] opts method)]
(assoc acc method (map->Endpoint
{:handler handler
:meta meta}))))
(map->Methods
{:any (map->Endpoint
{:handler (if (:handler top) (middleware/compile-handler [path meta] opts))
:meta top})})
childs)))))
(defn router
([data]

View file

@ -0,0 +1,63 @@
(ns reitit.middleware-test
(:require [clojure.test :refer [deftest testing is]]
[reitit.ring :as ring]
[reitit.coercion :as coercion]
[reitit.coercion.spec :as spec])
#?(:clj
(:import (clojure.lang ExceptionInfo))))
(defn handler
([{:keys [::mw]}]
{:status 200 :body (conj mw :ok)})
([request respond raise]
(respond (handler request))))
(deftest coercion-test
(let [app (ring/ring-handler
(ring/router
["/api"
["/plus/:e"
{:get {:parameters {:query {:a int?}
:body {:b int?}
:form {:c int?}
:header {:d int?}
:path {:e int?}}
:responses {200 {:schema {:total pos-int?}}}
:handler (fn [{{{:keys [a]} :query
{:keys [b]} :body
{:keys [c]} :form
{:keys [d]} :header
{:keys [e]} :path} :parameters}]
{:status 200
:body {:total (+ a b c d e)}})}}]]
{:meta {:middleware [coercion/gen-wrap-coerce-parameters
coercion/gen-wrap-coerce-response]
:coercion spec/coercion}}))]
(testing "all good"
(is (= {:status 200
:body {:total 15}}
(app {:uri "/api/plus/5"
:request-method :get
:query-params {"a" "1"}
:body-params {:b 2}
:form-params {:c 3}
:header-params {:d 4}}))))
(testing "invalid request"
(is (thrown-with-msg?
ExceptionInfo
#"Request coercion failed"
(app {:uri "/api/plus/5"
:request-method :get}))))
(testing "invalid response"
(is (thrown-with-msg?
ExceptionInfo
#"Response coercion failed"
(app {:uri "/api/plus/5"
:request-method :get
:query-params {"a" "1"}
:body-params {:b 2}
:form-params {:c 3}
:header-params {:d -40}}))))))