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