This repository has been archived by the owner on Apr 29, 2023. It is now read-only.
/
common.clj
261 lines (219 loc) · 8.66 KB
/
common.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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
(ns oc.lib.api.common
(:require [clojure.string :as s]
[defun.core :refer (defun)]
[taoensso.timbre :as timbre]
[cheshire.core :as json]
[liberator.representation :refer (ring-response)]
[liberator.core :refer (by-method)]
[oc.lib.jwt :as jwt]))
(def UTF8 "utf-8")
(def malformed true)
(def good-json false)
(def json-mime-type "application/json")
(def text-mime-type "text/plain")
(def help-email "hello@carrot.io")
(def error-msg (str "We've been notified of this error. Please contact " help-email " for additional help."))
;; ----- Ring Middleware -----
(defn wrap-500
"
Ring middleware to ensure that in the case of a 500 error response or an exception, we don't leak error
details in the body of the response.
"
[handler]
(fn [request]
(try
(let [response (handler request)]
(if (= 500 (:status response))
(assoc response :body error-msg)
response))
(catch Throwable t
(timbre/error t)
{:status 500 :body error-msg}))))
;; ----- Responses -----
(defn text-response
"Helper to format a text ring response"
([body status] (text-response body status {}))
([body status headers]
{:pre [(string? body)
(integer? status)
(map? headers)]}
(ring-response {
:body body
:status status
:headers (merge {"Content-Type" text-mime-type} headers)})))
(defun json-response
"Helper to format a generic JSON body ring response"
([body status] (json-response body status json-mime-type {}))
([body status headers :guard map?] (json-response body status json-mime-type headers))
([body status mime-type :guard string?] (json-response body status mime-type {}))
([body :guard #(or (map? %) (sequential? %)) status mime-type headers]
(json-response (json/generate-string body {:pretty true}) status mime-type headers))
([body :guard string? status :guard integer? mime-type :guard string? headers :guard map?]
(ring-response {:body body
:status status
:headers (merge {"Content-Type" mime-type} headers)})))
(defn error-response
"Helper to format a JSON ring response with an error."
([error status] (error-response error status {}))
([error status headers]
{:pre [(integer? status)
(map? headers)]}
(ring-response {
:body error
:status status
:headers headers})))
(defn blank-response [] (ring-response {:status 204}))
(defn options-response [methods]
(ring-response {
:status 204
:headers {"Allow" (s/join ", " (map s/upper-case (map name methods)))}}))
(defn missing-response
([]
(ring-response {
:status 404
:body ""
:headers {"Content-Type" (format "text/plain;charset=%s" UTF8)}}))
([reason]
(ring-response {
:status 404
:body reason
:headers {"Content-Type" (format "text/plain;charset=%s" UTF8)}})))
(def unauthorized "Not authorized. Provide a Bearer JWToken in the Authorization header.")
(defn unauthorized-response []
(ring-response {
:status 401
:body unauthorized
:headers {"Content-Type" (format "text/plain;charset=%s" UTF8)}}))
(def forbidden "Forbidden. Provide a Bearer JWToken in the Authorization header that is allowed to do this operation.")
(defn forbidden-response []
(ring-response {
:status 403
:body forbidden
:headers {"Content-Type" (format "text/plain;charset=%s" UTF8)}}))
(defn unprocessable-entity-response [reason]
(ring-response
{:status 422
:body reason
:headers {"Content-Type" (format "text/plain;charset=%s" UTF8)}}))
(defn location-response
([location body media-type] (location-response location body 201 media-type))
([location body status media-type]
(ring-response
{:body body
:status status
:headers {"Location" location
"Content-Type" (format "%s;charset=%s" media-type UTF8)}})))
;; ----- Validations -----
(defun only-accept
([status media-types :guard sequential?] (only-accept status (s/join "," media-types)))
([status media-types :guard string?]
(ring-response
{:status status
:body (format "Acceptable media type: %s\nAcceptable charset: %s" media-types UTF8)
:headers {"Content-Type" (format "text/plain;charset=%s" UTF8)}})))
(defn malformed-json?
"Read in the body param from the request as a string, parse it into JSON, make sure all the
keys are keywords, and then return it, mapped to :data as the 2nd value in a vector,
with the first value indicating it's not malformed. Otherwise just indicate it's malformed."
([ctx] (malformed-json? ctx false))
([ctx allow-nil?]
(try
(if-let [data (-> (get-in ctx [:request :body]) slurp (json/parse-string true))]
; handle case of a string which is valid JSON, but still malformed for us (since it's not a map or seq)
(do (when-not (or (map? data) (seq? data)) (throw (Exception.)))
[good-json {:data data}]))
(catch Exception e
(if allow-nil?
[good-json {:data {}}]
(do (timbre/warn "Request body not processable as JSON: " e)
[malformed]))))))
(defn known-content-type?
[ctx content-type]
(if-let [request-type (get-in ctx [:request :headers "content-type"])]
(= (first (s/split content-type #";")) (first (s/split request-type #";")))
true))
;; ----- Authentication and Authorization -----
(defn authenticated?
"Return true if the request contains a valid JWToken"
[ctx]
(if (= (-> ctx :request :request-method) :options)
true ; always allow options
(and (:jwtoken ctx) (:user ctx))))
(defn get-token
"
Read supplied JWToken from the Authorization in the request headers.
Return nil if no JWToken provided.
"
[headers]
(if-let [authorization (or (get headers "Authorization") (get headers "authorization"))]
(last (s/split authorization #" "))))
(defn read-token
"Read supplied JWToken from the request headers.
If a valid token is supplied return a map containing :jwtoken and associated :user.
If invalid token is supplied return a map containing :jwtoken and false.
If no Authorization headers are supplied return nil."
[headers passphrase]
(when-let [token (get-token headers)]
(if (jwt/valid? token passphrase)
{:jwtoken token
:user (:claims (jwt/decode token))}
{:jwtoken false})))
(defn allow-anonymous
"Allow unless there is a JWToken provided and it's invalid."
[ctx]
(if (= (-> ctx :request :request-method) :options)
true ; allows allow options
(boolean (or (nil? (:jwtoken ctx)) (:jwtoken ctx)))))
(defn allow-authenticated
"Allow only if a valid JWToken is provided."
[ctx]
(if (= (-> ctx :request :request-method) :options)
true ; always allow options
(authenticated? ctx)))
;; ----- Resources - see: http://clojure-liberator.github.io/liberator/assets/img/decision-graph.svg
;; verify validity of JWToken if it's provided, but it's not required
(defn anonymous-resource [passphrase] {
:initialize-context (fn [ctx] (read-token (get-in ctx [:request :headers]) passphrase))
:authorized? allow-anonymous
:handle-unauthorized (fn [_] (unauthorized-response))
:handle-forbidden (fn [ctx] (if (:jwtoken ctx) (forbidden-response) (unauthorized-response)))})
;; verify validity and presence of required JWToken
(defn authenticated-resource [passphrase] {
:initialize-context (fn [ctx] (read-token (get-in ctx [:request :headers]) passphrase))
:authorized? (fn [ctx] (authenticated? ctx))
:handle-not-found (fn [_] (missing-response))
:handle-unauthorized (fn [_] (unauthorized-response))
:handle-forbidden (fn [_] (forbidden-response))})
(def open-company-resource {
:available-charsets [UTF8]
:handle-not-found (fn [_] (missing-response))
:handle-not-implemented (fn [_] (missing-response))
:handle-exception (fn [{ex :exception}] (timbre/error ex)
(error-response error-msg 500))
:allowed-methods [:options :get :put :patch :delete]
:respond-with-entity? (by-method {
:options false
:get true
:put true
:patch true
:delete false})
:malformed? (by-method {
:options false
:get false
:delete false
:post (fn [ctx] (malformed-json? ctx))
:put (fn [ctx] (malformed-json? ctx))
:patch (fn [ctx] (malformed-json? ctx))})
:can-put-to-missing? (fn [_] false)
:conflict? (fn [_] false)})
(defn open-company-anonymous-resource [passphrase]
(merge open-company-resource (anonymous-resource passphrase)))
(defn open-company-authenticated-resource [passphrase]
(merge open-company-resource (authenticated-resource passphrase)))
(defn rep
"Add ^:replace meta to the value to avoid Liberator deep merge/concat
it's value."
[v]
(if (instance? clojure.lang.IMeta v)
(with-meta v {:replace true})
v))