/
schema.cljc
170 lines (141 loc) · 5.86 KB
/
schema.cljc
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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
(ns martian.schema
(:require #?(:clj [schema.core :as s]
:cljs [schema.core :as s :refer [AnythingSchema Maybe EnumSchema EqSchema]])
#?(:cljs [goog.Uri])
[schema.coerce :as sc]
[schema-tools.core :as st]
[schema-tools.coerce :as stc]
[martian.parameter-aliases :refer [unalias-data]])
#?(:clj (:import [schema.core AnythingSchema Maybe EnumSchema EqSchema])))
(defn- keyword->string [s]
(if (keyword? s) (name s) s))
(defn- string-enum-matcher [schema]
(when (or (and (instance? EnumSchema schema)
(every? string? (.-vs ^EnumSchema schema)))
(and (instance? EqSchema schema)
(string? (.-v ^EqSchema schema))))
keyword->string))
(defn coercion-matchers [schema]
(or (sc/string-coercion-matcher schema)
({s/Str keyword->string} schema)
(string-enum-matcher schema)))
(defn build-coercion-matchers [use-defaults?]
(if use-defaults?
(fn [schema]
(or (stc/default-matcher schema)
(coercion-matchers schema)))
coercion-matchers))
(defn- from-maybe [s]
(if (instance? Maybe s)
(:schema s)
s))
(defn coerce-data
"Extracts the data referred to by the schema's keys and coerces it"
[schema data & [parameter-aliases use-defaults?]]
(let [coercion-matchers (build-coercion-matchers use-defaults?)]
(when-let [s (from-maybe schema)]
(cond
(or (coercion-matchers schema)
(instance? AnythingSchema s))
((sc/coercer! schema coercion-matchers) data)
(map? s)
(stc/coerce (unalias-data parameter-aliases data) s (stc/forwarding-matcher coercion-matchers stc/map-filter-matcher))
(coll? s) ;; primitives, arrays, arrays of maps
((sc/coercer! schema coercion-matchers)
(map #(if (map? %)
(unalias-data parameter-aliases %)
%)
data))
:else
((sc/coercer! schema coercion-matchers) data)))))
(declare make-schema)
(defn schemas-for-parameters
"Given a collection of swagger parameters returns a schema map"
[ref-lookup parameters]
(->> parameters
(map (fn [{:keys [name required] :as param}]
{(cond-> (keyword name)
(not required)
s/optional-key)
(make-schema ref-lookup param)}))
(into {})))
(defn- resolve-ref [ref-lookup ref]
(let [[_ category k] (re-find #"#/(definitions|parameters)/(.*)" ref)]
(get-in ref-lookup [(keyword category) (keyword k)])))
(def URI
#?(:clj java.net.URI
:cljs goog.Uri))
(defn leaf-schema [{:keys [type enum format]}]
(cond
enum (apply s/enum enum)
(= "string" type) (case format
"uuid" (s/cond-pre s/Str s/Uuid)
"uri" (s/cond-pre s/Str URI)
"date-time" (s/cond-pre s/Str s/Inst)
"int-or-string" (s/cond-pre s/Str s/Int)
s/Str)
(= "integer" type) s/Int
(= "number" type) s/Num
(= "boolean" type) s/Bool
:else
s/Any))
(defn wrap-default [{:keys [default]} schema]
(if (some? default)
(st/default schema default)
schema))
(defn- schema-type [ref-lookup {:keys [type $ref] :as param}]
(let [schema (if (or (= "object" type) $ref)
(make-schema ref-lookup param)
(leaf-schema param))]
(wrap-default param schema)))
(def ^:dynamic *visited-refs* #{})
(defn- denormalise-object-properties [{:keys [required properties] :as s}]
(map (fn [[parameter-name param]]
(assoc (if (= "object" (:type param))
(assoc param :properties (into {} (map (juxt :name identity)
(denormalise-object-properties param))))
param)
:name parameter-name
:required (or (when-not (= "object" (:type param))
(:required param))
(and (coll? required)
(contains? (set required) (name parameter-name))))))
properties))
(defn- make-object-schema [ref-lookup {:keys [additionalProperties] :as schema}]
;; It's possible for an 'object' to omit properties and
;; additionalProperties. If this is the case - anything is allowed.
(if (or (contains? schema :properties)
(contains? schema :additionalProperties))
(cond-> (schemas-for-parameters ref-lookup (denormalise-object-properties schema))
additionalProperties (assoc s/Any s/Any))
{s/Any s/Any}))
(defn make-schema
"Takes a swagger parameter and returns a schema"
[ref-lookup {:keys [required type schema $ref items] :as param}]
(if (let [ref (or $ref (:$ref schema))]
(and ref (contains? *visited-refs* ref)))
s/Any ;; avoid potential recursive loops
(cond
$ref
(binding [*visited-refs* (conj *visited-refs* $ref)]
(make-schema ref-lookup (-> (dissoc param :$ref)
(merge (resolve-ref ref-lookup $ref)))))
(:$ref schema)
(binding [*visited-refs* (conj *visited-refs* (:$ref schema))]
(make-schema ref-lookup (-> (dissoc param :schema)
(merge (resolve-ref ref-lookup (:$ref schema))))))
:else
(cond-> (cond
(= "array" type)
[(schema-type ref-lookup (assoc items :required true))]
(= "array" (:type schema))
[(schema-type ref-lookup (assoc (:items schema) :required true))]
(= "object" type)
(make-object-schema ref-lookup param)
(= "object" (:type schema))
(make-object-schema ref-lookup schema)
:else
(schema-type ref-lookup param))
(and (not required)
(not= "array" type) (not= "array" (:type schema)))
s/maybe))))