-
-
Notifications
You must be signed in to change notification settings - Fork 42
/
interceptors.cljc
176 lines (151 loc) · 7.71 KB
/
interceptors.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
171
172
173
174
175
176
(ns martian.interceptors
(:require [martian.schema :as schema]
[clojure.walk :refer [keywordize-keys stringify-keys]]
[tripod.context :as tc]
[schema.core :as s]
[camel-snake-kebab.core :refer [->kebab-case-keyword]]
[martian.encoding :as encoding]
[martian.encoders :as encoders]))
(defn remove-stack [ctx]
(-> ctx tc/terminate (dissoc ::tc/stack)))
(def request-only-handler
{:name ::request-only-handler
:leave remove-stack})
(defn- create-only [m k v]
(if (get m k)
m
(assoc m k v)))
(defn- insert-or-merge [m k v]
(cond
(get m k) (update m k #(merge v %))
(not-empty v) (assoc m k v)
:else m))
(def set-method
{:name ::method
:enter (fn [{:keys [handler] :as ctx}]
(update ctx :request create-only :method (:method handler)))})
(def set-url
{:name ::url
:enter (fn [{:keys [params url-for handler] :as ctx}]
(update ctx :request create-only :url (url-for (:route-name handler) params)))})
(defn coerce-data [{:keys [parameter-aliases] :as handler} schema-key params opts]
(schema/coerce-data (get handler schema-key) params (get parameter-aliases schema-key) (:use-defaults? opts)))
(def keywordize-params
{:name ::keywordize-params
:enter (fn [ctx] (update ctx :params keywordize-keys))})
(def set-query-params
{:name ::query-params
:enter (fn [{:keys [params handler opts] :as ctx}]
(update ctx :request insert-or-merge :query-params (coerce-data handler :query-schema params opts)))})
(def set-body-params
{:name ::body-params
:enter (fn [{:keys [params handler opts] :as ctx}]
(if-let [[body-key] (first (:body-schema handler))]
(let [body-key (s/explicit-schema-key body-key)
body-params (or (:martian.core/body params)
(get params body-key)
(get params (->kebab-case-keyword body-key))
params)]
(update ctx :request insert-or-merge :body (get (coerce-data handler :body-schema {body-key body-params} opts) body-key)))
ctx))})
(def set-form-params
{:name ::form-params
:enter (fn [{:keys [params handler opts] :as ctx}]
(update ctx :request insert-or-merge :form-params (coerce-data handler :form-schema params opts)))})
(def set-header-params
{:name ::header-params
:enter (fn [{:keys [params handler opts] :as ctx}]
(update ctx :request insert-or-merge :headers (stringify-keys (coerce-data handler :headers-schema params opts))))})
(def enqueue-route-specific-interceptors
{:name ::enqueue-route-specific-interceptors
:enter (fn [{:keys [handler] :as ctx}]
(if-let [i (:interceptors handler)]
(update ctx ::tc/queue #(into (into tc/queue i) %))
ctx))})
(defn encode-body [encoders]
{:name ::encode-body
:encodes (keys encoders)
:enter (fn [{:keys [request handler] :as ctx}]
(let [content-type (and (:body request)
(not (get-in request [:headers "Content-Type"]))
(encoding/choose-content-type encoders (:consumes handler)))
{:keys [encode]} (encoding/find-encoder encoders content-type)]
(cond-> ctx
(get-in ctx [:request :body]) (update-in [:request :body] encode)
content-type (assoc-in [:request :headers "Content-Type"] content-type))))})
(def default-encode-body (encode-body (encoders/default-encoders)))
(defn coerce-response [encoders]
{:name ::coerce-response
:decodes (keys encoders)
:enter (fn [{:keys [request handler] :as ctx}]
(let [content-type (and (not (get-in request [:headers "Accept"]))
(encoding/choose-content-type encoders (:produces handler)))
{:keys [as] :or {as :text}} (encoding/find-encoder encoders content-type)]
(cond-> (assoc-in ctx [:request :as] as)
content-type (assoc-in [:request :headers "Accept"] content-type))))
:leave (fn [{:keys [response] :as ctx}]
(assoc ctx :response
(let [content-type (and (:body response)
(not-empty (get-in response [:headers :content-type])))
{:keys [decode]} (encoding/find-encoder encoders content-type)]
(update response :body decode))))})
(def default-coerce-response (coerce-response (encoders/default-encoders)))
(defn validate-response-body
"Validate responses against the appropriate response schema.
Optional strict mode throws an error if it is invalid"
([] (validate-response-body {:strict? false}))
([{:keys [strict?]}]
{:name ::validate-response
:leave (fn [{:keys [handler response] :as ctx}]
(if-let [body-schema (some (fn [schema]
(when-not (s/check (:status schema) (:status response))
(:body schema)))
(:response-schemas handler))]
(s/validate body-schema (:body response))
(when strict?
(throw (ex-info (str "No response body schema found for status " (:status response))
{:response response
:response-schemas (:response-schemas handler)}))))
ctx)}))
(defn supported-content-types
"Return the full set of supported content-types as declared by any encoding/decoding interceptors"
[interceptors]
(reduce (fn [acc interceptor]
(merge-with into acc (select-keys interceptor [:encodes :decodes])))
{:encodes #{}
:decodes #{}}
interceptors))
;; borrowed from https://github.com/walmartlabs/lacinia-pedestal/blob/master/src/com/walmartlabs/lacinia/pedestal.clj#L40
(defn inject
"Locates the named interceptor in the list of interceptors and adds (or replaces)
the new interceptor to the list.
relative-position may be :before, :after, or :replace.
For :replace, the new interceptor may be nil, in which case the interceptor is removed.
The named interceptor must exist, or an exception is thrown."
[interceptors new-interceptor relative-position interceptor-name]
(let [*found? (volatile! false)
final-result (reduce (fn [result interceptor]
;; An interceptor can also be a bare handler function, which is 'nameless'
(if-not (= interceptor-name (when (map? interceptor)
(:name interceptor)))
(conj result interceptor)
(do
(vreset! *found? true)
(case relative-position
:before
(conj result new-interceptor interceptor)
:after
(conj result interceptor new-interceptor)
:replace
(if new-interceptor
(conj result new-interceptor)
result)))))
[]
interceptors)]
(when-not @*found?
(throw (ex-info "Could not find existing interceptor."
{:interceptors interceptors
:new-interceptor new-interceptor
:relative-position relative-position
:interceptor-name interceptor-name})))
final-result))