Skip to content

Commit b93dd5c

Browse files
frenchy64frenchy64
committed
backport coercion
1 parent 66270ff commit b93dd5c

File tree

5 files changed

+271
-3
lines changed

5 files changed

+271
-3
lines changed

‎src/compojure/api/coercion.clj‎

Lines changed: 99 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,99 @@
1+
(ns compojure.api.coercion
2+
(:require [clojure.walk :as walk]
3+
[compojure.api.exception :as ex]
4+
[compojure.api.request :as request]
5+
[compojure.api.coercion.core :as cc]
6+
;; side effects
7+
compojure.api.coercion.register-schema
8+
compojure.api.coercion.register-spec)
9+
(:import (compojure.api.coercion.core CoercionError)))
10+
11+
(def default-coercion :schema)
12+
13+
(defn set-request-coercion [request coercion]
14+
(assoc request ::request/coercion coercion))
15+
16+
(defn get-request-coercion [request]
17+
(if-let [entry (find request ::request/coercion)]
18+
(val entry)
19+
default-coercion))
20+
21+
(defn resolve-coercion [coercion]
22+
(cond
23+
(nil? coercion) nil
24+
(keyword? coercion) (cc/named-coercion coercion)
25+
(satisfies? cc/Coercion coercion) coercion
26+
:else (throw (ex-info (str "invalid coercion " coercion) {:coercion coercion}))))
27+
28+
(defn get-apidocs [maybe-coercion spec info]
29+
(if-let [coercion (resolve-coercion maybe-coercion)]
30+
(cc/get-apidocs coercion spec info)))
31+
32+
(defn coerce-request! [model in type keywordize? open? request]
33+
(let [transform (if keywordize? walk/keywordize-keys identity)
34+
value (transform (in request))]
35+
(if-let [coercion (-> request
36+
(get-request-coercion)
37+
(resolve-coercion))]
38+
(let [model (if open? (cc/make-open coercion model) model)
39+
format (some-> request :muuntaja/request :format)
40+
result (cc/coerce-request coercion model value type format request)]
41+
(if (instance? CoercionError result)
42+
(throw (ex-info
43+
(str "Request validation failed: " (pr-str result))
44+
(merge
45+
(into {} result)
46+
{:type ::ex/request-validation
47+
:coercion coercion
48+
:value value
49+
:in [:request in]
50+
:request request})))
51+
result))
52+
value)))
53+
54+
(defn coerce-response! [request {:keys [status body] :as response} responses]
55+
(if-let [model (or (:schema (get responses status))
56+
(:schema (get responses :default)))]
57+
(if-let [coercion (-> request
58+
(get-request-coercion)
59+
(resolve-coercion))]
60+
(let [format (or (-> response :muuntaja/content-type)
61+
(some-> request :muuntaja/response :format))
62+
accept? (cc/accept-response? coercion model)]
63+
(if accept?
64+
(let [result (cc/coerce-response coercion model body :response format response)]
65+
(if (instance? CoercionError result)
66+
(throw (ex-info
67+
(str "Response validation failed: " (pr-str result))
68+
(merge
69+
(into {} result)
70+
{:type ::ex/response-validation
71+
:coercion coercion
72+
:value body
73+
:in [:response :body]
74+
:request request
75+
:response response})))
76+
(assoc response
77+
:compojure.api.meta/serializable? true
78+
:body result)))
79+
response))
80+
response)
81+
response))
82+
83+
;;
84+
;; middleware
85+
;;
86+
87+
(defn wrap-coerce-response [handler responses]
88+
(fn
89+
([request]
90+
(coerce-response! request (handler request) responses))
91+
([request respond raise]
92+
(handler
93+
request
94+
(fn [response]
95+
(try
96+
(respond (coerce-response! request response responses))
97+
(catch Exception e
98+
(raise e))))
99+
raise))))

‎src/compojure/api/coercion/register_schema.clj‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
(ns compojure.api.coercion.register-schema
2+
(:require [compojure.api.coercion.core :as cc]))
3+
4+
(defmethod cc/named-coercion :schema [_]
5+
(deref
6+
(or (resolve 'compojure.api.coercion.schema/default-coercion)
7+
(do (require 'compojure.api.coercion.schema)
8+
(resolve 'compojure.api.coercion.schema/default-coercion)))))

‎src/compojure/api/coercion/register_spec.clj‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
(ns compojure.api.coercion.register-spec
2+
(:require [compojure.api.coercion.core :as cc]))
3+
4+
(defmethod cc/named-coercion :spec [_]
5+
(deref
6+
(or (resolve 'compojure.api.coercion.spec/default-coercion)
7+
(do (require 'compojure.api.coercion.spec)
8+
(resolve 'compojure.api.coercion.spec/default-coercion)))))

‎src/compojure/api/coercion/schema.clj‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,9 @@
55
[compojure.api.coercion.core :as cc]
66
[clojure.walk :as walk]
77
[schema.core :as s]
8-
[compojure.api.common :as common])
8+
[compojure.api.common :as common]
9+
;; side effects
10+
compojure.api.coercion.register-schema)
911
(:import (java.io File)
1012
(schema.core OptionalKey RequiredKey)
1113
(schema.utils ValidationError NamedError)))
@@ -84,5 +86,3 @@
8486
(->SchemaCoercion :schema options))
8587

8688
(def default-coercion (create-coercion default-options))
87-
88-
(defmethod cc/named-coercion :schema [_] default-coercion)

‎src/compojure/api/coercion/spec.clj‎

Lines changed: 153 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,153 @@
1+
(ns compojure.api.coercion.spec
2+
(:require [schema.core]
3+
[clojure.spec.alpha :as s]
4+
[spec-tools.core :as st]
5+
[spec-tools.data-spec :as ds]
6+
[clojure.walk :as walk]
7+
[compojure.api.coercion.core :as cc]
8+
[spec-tools.swagger.core :as swagger]
9+
[compojure.api.common :as common]
10+
;; side effects
11+
compojure.api.coercion.register-spec)
12+
(:import (clojure.lang IPersistentMap)
13+
(schema.core RequiredKey OptionalKey)
14+
(spec_tools.core Spec)
15+
(spec_tools.data_spec Maybe)))
16+
17+
(def string-transformer
18+
(st/type-transformer
19+
st/string-transformer
20+
st/strip-extra-keys-transformer
21+
{:name :string}))
22+
23+
(def json-transformer
24+
(st/type-transformer
25+
st/json-transformer
26+
st/strip-extra-keys-transformer
27+
{:name :json}))
28+
29+
(defn default-transformer
30+
([] (default-transformer :default))
31+
([name] (st/type-transformer {:name name})))
32+
33+
(defprotocol Specify
34+
(specify [this name]))
35+
36+
(extend-protocol Specify
37+
IPersistentMap
38+
(specify [this name]
39+
(-> (->>
40+
(walk/postwalk
41+
(fn [x]
42+
(if (and (map? x) (not (record? x)))
43+
(->> (for [[k v] (dissoc x schema.core/Keyword)
44+
:let [k (cond
45+
;; Schema required
46+
(instance? RequiredKey k)
47+
(ds/req (schema.core/explicit-schema-key k))
48+
49+
;; Schema options
50+
(instance? OptionalKey k)
51+
(ds/opt (schema.core/explicit-schema-key k))
52+
53+
:else
54+
k)]]
55+
[k v])
56+
(into {}))
57+
x))
58+
this)
59+
(ds/spec name))
60+
(dissoc :name)))
61+
62+
Maybe
63+
(into-spec [this name]
64+
(ds/spec name this))
65+
66+
Spec
67+
(specify [this _] this)
68+
69+
Object
70+
(specify [this _]
71+
(st/create-spec {:spec this})))
72+
73+
(def memoized-specify
74+
(common/fifo-memoize #(specify %1 (keyword "spec" (name (gensym "")))) 1000))
75+
76+
(defn maybe-memoized-specify [spec]
77+
(if (keyword? spec)
78+
(specify spec nil)
79+
(memoized-specify spec)))
80+
81+
(defn stringify-pred [pred]
82+
(str (if (instance? clojure.lang.LazySeq pred)
83+
(seq pred)
84+
pred)))
85+
86+
(defmulti coerce-response? identity :default ::default)
87+
(defmethod coerce-response? ::default [_] true)
88+
89+
(defrecord SpecCoercion [name options]
90+
cc/Coercion
91+
(get-name [_] name)
92+
93+
(get-apidocs [_ _ {:keys [parameters responses] :as info}]
94+
(cond-> (dissoc info :parameters :responses)
95+
parameters (assoc
96+
::swagger/parameters
97+
(into
98+
(empty parameters)
99+
(for [[k v] parameters]
100+
[k (maybe-memoized-specify v)])))
101+
responses (assoc
102+
::swagger/responses
103+
(into
104+
(empty responses)
105+
(for [[k response] responses]
106+
[k (update response :schema #(some-> % maybe-memoized-specify))])))))
107+
108+
(make-open [_ spec] spec)
109+
110+
(encode-error [_ error]
111+
(let [problems (-> error :problems ::s/problems)]
112+
(-> error
113+
(update :spec (comp str s/form))
114+
(assoc :problems (mapv #(update % :pred stringify-pred) problems)))))
115+
116+
(coerce-request [_ spec value type format _]
117+
(let [spec (maybe-memoized-specify spec)
118+
type-options (options type)]
119+
(if-let [transformer (or (get (get type-options :formats) format)
120+
(get type-options :default))]
121+
(let [coerced (st/coerce spec value transformer)]
122+
(if (s/valid? spec coerced)
123+
coerced
124+
(let [conformed (st/conform spec coerced transformer)]
125+
(if (s/invalid? conformed)
126+
(let [problems (st/explain-data spec coerced transformer)]
127+
(cc/map->CoercionError
128+
{:spec spec
129+
:problems problems}))
130+
(s/unform spec conformed)))))
131+
value)))
132+
133+
(accept-response? [_ spec]
134+
(boolean (coerce-response? spec)))
135+
136+
(coerce-response [this spec value type format request]
137+
(cc/coerce-request this spec value type format request)))
138+
139+
(def default-options
140+
{:body {:default (default-transformer)
141+
:formats {"application/json" json-transformer
142+
"application/msgpack" json-transformer
143+
"application/x-yaml" json-transformer}}
144+
:string {:default string-transformer}
145+
:response {:default (default-transformer)
146+
:formats {"application/json" (default-transformer :json)
147+
"application/msgpack" (default-transformer :json)
148+
"application/x-yaml" (default-transformer :json)}}})
149+
150+
(defn create-coercion [options]
151+
(->SpecCoercion :spec options))
152+
153+
(def default-coercion (create-coercion default-options))

0 commit comments

Comments
 (0)