-
Notifications
You must be signed in to change notification settings - Fork 0
/
interceptor_chain.cljc
537 lines (429 loc) · 15.2 KB
/
interceptor_chain.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
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
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
(ns a-frame.interceptor-chain
(:require
[malli.util :as mu]
[malli.experimental :as mx]
[promesa.core :as pr]
[promisespromises.promise :as prpr]
[promisespromises.error :as err]
[taoensso.timbre :refer [warn error]]
[a-frame.schema :as af.schema]
[a-frame.registry :as registry]
[a-frame.interceptor-chain.data :as data]
[a-frame.interceptor-chain.data.tag-readers]))
;; a slightly more data-driven interceptor chain for a-frame
;;
;; the idea being that the interceptor context should be serializable,
;; and when there is an error the complete interceptor context
;; can be pretty-printed and used to resume the failed operation
;; for debugging
;;
;; interceptors are registered in the a-frame registry
;; and referenced by a keyword, much like fx and cofx
;;
;; this makes sense for a-frame, which already maintains a registry of different
;; kinds of handlers. it doesn't necessarily make sense for a general purpose
;; interceptor chain, which remains at promisespromises.interceptor-chain
(def Interceptor
"An Interceptor, all methods are optional but should be implemented as
follows:
* `::enter` takes 1 or 2 args:
- context -> context
- context -> data -> context
* `::leave` – takes 1 or 2 args:
- context -> context
- context -> data -> context
* `::error` – takes two args
- context -> error -> context
All methods may return either promises or plain values."
[:map
[::name {:optional true} :keyword]
[::enter {:optional true} fn?]
[::leave {:optional true} fn?]
[::error {:optional true} fn?]])
(def InterceptorSpec
"the interceptor chain is created with a list of InterceptorSpecs. each
InterceptorSpec is either
- simple keyword, referencing a registered interceptor which will cause
::enter and ::leave fns to be invoked with 1-arity, or
- a pair of [interceptor-kw interceptor-data]. if there is data
(either ::enter-data or ::leave-data) then ::enter and ::leave will
be invoked with their 2-arity
providing data like this allows a pure-data (in the re-frame sense - roughly
something which has no opaque objects and is serializable/deserializable)
interceptor chain to be registered, which has numerous benefits"
[:or
:keyword
[:map
[::key :keyword]
[::data [:map
[::enter-data {:optional true} :any]
[::leave-data {:optional true} :any]]]]])
(def InterceptorList
[:sequential InterceptorSpec])
(def interceptor-fn-keys
[::enter ::leave ::error])
(def InterceptorFnKey
(into [:enum] interceptor-fn-keys))
(def interceptor-fn-noop
::noop)
(def InterceptorFnHistoryKey
(conj InterceptorFnKey interceptor-fn-noop))
(def InterceptorHistoryElem
[:or
[:tuple InterceptorSpec InterceptorFnHistoryKey]
[:tuple InterceptorSpec InterceptorFnHistoryKey :any]])
(def InterceptorContext
[:map
[af.schema/a-frame-app-ctx :any]
[af.schema/a-frame-router :any]
[::queue [:vector InterceptorSpec]]
[::stack [:sequential InterceptorSpec]]
[::history [:vector InterceptorHistoryElem]]
[::errors {:optional true} :any]])
;; utility fns
(def opaque-context-keys
"keys which contain opaque data"
#{af.schema/a-frame-app-ctx
af.schema/a-frame-router})
(def context-keys
"The Interceptor specific keys that are added to contexts"
(->> InterceptorContext
(mu/keys)
(filter keyword?)
set))
(defn dissoc-context-keys
"Removes all interceptor related keys from `context`"
[context]
(apply dissoc context context-keys))
(defn sanitise-context
"remove impure / opaque data from a context"
[context]
(apply dissoc context opaque-context-keys))
(defn pr-loop-context*
"Helper fn to repeat execution of `step-fn` against `context` inside a promise
loop.
`step-fn` should return a tuple of either `[::break <value>]` or `[::recur
<new context>]`. The former will terminate the loop and return `<value>`, the
later will pass `<new context>` to the next loop iteration.
(Note: this mainly exists to abstract away and minimise the platform specific
aspects of handling promise loops.)"
[context step-fn]
#_{:clj-kondo/ignore [:loop-without-recur]}
(pr/loop [context context]
(prpr/handle-always
(step-fn context)
(fn [[t c] e]
(cond
(some? e) (err/wrap-uncaught e)
(= ::break t) c
:else (pr/recur c))))))
(defn pr-loop-context
[context step-fn]
(pr/let [r (pr-loop-context* context step-fn)]
(err/unwrap r)))
(mx/defn assoc-opaque-keys
"add the opaque keys to the interceptor context
they are removed from reported contexts by `sanitise-context`"
[ctx app-ctx a-frame-router]
(merge
ctx
{af.schema/a-frame-app-ctx app-ctx
af.schema/a-frame-router a-frame-router}))
(mx/defn ^:always-validate initiate
:- InterceptorContext
"Given a sequence of [[InterceptorSpec]]s and a map of `initial-context` values,
returns a new [[InterceptorContext]] ready to [[execute]]"
[app-ctx
a-frame-router
interceptor-chain :- InterceptorList
initial-context]
(->
initial-context
(merge {::queue (vec interceptor-chain)
::stack '()
::history []})
(assoc-opaque-keys app-ctx a-frame-router)))
(mx/defn ^:always-validate enqueue
:- InterceptorContext
"Adds `interceptors` to the end of the interceptor queue within `context`"
[context :- InterceptorContext
interceptors :- InterceptorList]
(update context ::queue into interceptors))
(mx/defn ^:always-validate terminate
:- InterceptorContext
"Removes all queued interceptors from `context`"
[context :- InterceptorContext]
(assoc context ::queue []))
(mx/defn ^:always-validate clear-errors
:- InterceptorContext
"Removes any associated `::errors` from `context`"
[context :- InterceptorContext]
(dissoc context ::errors))
(mx/defn ^:always-validate register-interceptor
[interceptor-key :- :keyword
interceptor :- Interceptor]
(registry/register-handler ::interceptor interceptor-key interceptor))
(defn resolve-interceptor
[interceptor-key]
(let [interceptor (registry/get-handler ::interceptor interceptor-key)]
(when (nil? interceptor)
(throw (ex-info "no interceptor" {:interceptor-key interceptor-key})))
interceptor))
(defn interceptor-data-key
[interceptor-fn-key]
(case interceptor-fn-key
::enter ::enter-data
::leave ::leave-data))
(defn normalize-interceptor-spec
"turns keyword interceptor-specs into maps
{::key <interceptor-key>}"
[interceptor-spec]
(if (keyword? interceptor-spec)
{::key interceptor-spec}
interceptor-spec))
(defn wrap-error
[resume-context e]
(ex-info
"interceptor failed"
{::context (sanitise-context resume-context)
::interceptor-fn-key ::enter}
e))
(defn unwrap-original-error
"unwrap layers of error wrapping (in case of nested :dispatch)
to get at the causal exception"
[e]
(let [{ctx ::context} (ex-data e)
cause (ex-cause e)]
(if (and (some? ctx)
(some? cause))
(unwrap-original-error cause)
e)))
(defn resolve-interceptor-data
"resolve the interceptor data, returning either
- [data-val] if there was data specified
- nil if no data was specified"
[interceptor-fn-key
interceptor-data-specs
context]
(condp contains? interceptor-fn-key
#{::enter ::leave}
(let [data-key (interceptor-data-key interceptor-fn-key)]
(when (contains? interceptor-data-specs data-key)
(let [spec (get interceptor-data-specs data-key)
data (data/resolve-data spec context)]
;; (warn "resolve-interceptor-data" spec data)
[data])))
#{::error}
nil))
(defn interceptor-fn-history-thunk
"returns a [<history-entry> <interceptor-fn-thunk>]"
[interceptor-fn-key
interceptor-spec
context
error]
(let [{interceptor-kw ::key
interceptor-data-specs ::data} (normalize-interceptor-spec
interceptor-spec)
interceptor (resolve-interceptor interceptor-kw)]
(if-let [f (get interceptor interceptor-fn-key)]
(condp contains? interceptor-fn-key
#{::enter ::leave}
(let [[data-val :as data] (resolve-interceptor-data
interceptor-fn-key
interceptor-data-specs
context)
thunk (if (some? data)
(fn [ctx] (f ctx data-val))
(fn [ctx] (f ctx)))]
[(if (some? data)
[interceptor-spec interceptor-fn-key data-val]
[interceptor-spec interceptor-fn-key])
thunk])
#{::error}
[[interceptor-spec
interceptor-fn-key]
(fn [ctx] (f ctx error))])
;; no interceptor fn, so no thunk
[[interceptor-kw ::noop interceptor-fn-key]])))
(defn maybe-execute-interceptor-fn-thunk
[thunk
context]
(if (some? thunk)
(thunk context)
context))
(defn maybe-execute-interceptor-fn
"call an interceptor fn on an interceptor, resolving
any supplied data"
[interceptor-fn-key
interceptor-spec
context
error]
(let [[_ thunk] (interceptor-fn-history-thunk
interceptor-fn-key
interceptor-spec
context
error)]
(maybe-execute-interceptor-fn-thunk thunk context)))
(defn wrap-interceptor-error
"wrap an exception and add to the interceptor errors"
[resume-context
new-context
e]
(-> new-context
terminate
;; add an error referencing the context,
;; which can be used to resume at the
;; point of failure
(update ::errors conj (wrap-error resume-context e))))
;; processing fns
(mx/defn enter-next
"Executes the next `::enter` interceptor queued within `context`, returning a
promise that will resolve to the next [[pr-loop-context]] action to take"
[{queue ::queue
stack ::stack
_history ::history
:as context} :- InterceptorContext]
(if (empty? queue)
[::break context]
(let [interceptor-spec (first queue)
[history thunk] (interceptor-fn-history-thunk
::enter
interceptor-spec
context
nil)
new-context (-> context
(assoc ::queue (vec (rest queue)))
(assoc ::stack (conj stack interceptor-spec))
(update ::history conj history))]
(-> (maybe-execute-interceptor-fn-thunk thunk new-context)
(prpr/catch-always
(partial wrap-interceptor-error context new-context))
(pr/chain
(fn [{queue ::queue :as c}]
(if (empty? queue)
[::break c]
[::recur c])))))))
(mx/defn ^:always-validate enter-all
"Process the `:queue` of `context`, calling each `:enter` `fn` in turn.
If an error is raised it is captured, stored in the `context`s `:error` key,
and the queue is cleared (to prevent further processing.)"
[context :- InterceptorContext]
(pr-loop-context context enter-next))
(mx/defn leave-next
"Executes the next `::leave` or `::error` interceptor on the stack within
`context`, returning a promise that will resolve to the next
[[pr-loop-context]] action to take"
[{stack ::stack
_history ::history
[error :as _errors] ::errors
:as context} :- InterceptorContext]
(if (empty? stack)
[::break context]
(let [interceptor-spec (peek stack)
interceptor-fn-key (if (some? error) ::error ::leave)
[history thunk] (interceptor-fn-history-thunk
interceptor-fn-key
interceptor-spec
context
error)
new-context (-> context
(assoc ::stack (pop stack))
(update ::history conj history))]
(-> (maybe-execute-interceptor-fn-thunk thunk new-context)
(prpr/catch-always
(partial wrap-interceptor-error context new-context))
(pr/chain
(fn [{stack ::stack :as c}]
(if (empty? stack)
[::break c]
[::recur c])))))))
(mx/defn ^:always-validate leave-all
"Process the `::stack` of `context`, calling, in LIFO order.
If an `::error` is present in the `context` then the `::error` handling `fn`
of the interceptors will be called otherwise the `:leave` `fn`s will be
called.
Any thrown errors will replace the current `::error` with stack unwinding
continuing from that point forwards."
[context :- InterceptorContext]
(pr-loop-context context leave-next))
;; the main interaction fn
(defn default-error-handler
[e]
(throw e))
(defn default-suppressed-error-handler
[errors]
(warn (str "suppressed (" (count errors) ")"
" errors from interceptor execution"))
(doseq [e errors]
(warn e)))
(mx/defn execute*
([context :- InterceptorContext]
(execute*
default-error-handler
default-suppressed-error-handler
context))
([error-handler
suppressed-error-handler
context :- InterceptorContext]
(pr/chain
(enter-all context)
leave-all
(fn [{[err & other-errs] ::errors :as c}]
(if (some? err)
(do
(when (not-empty other-errs)
(prpr/catch-always
(suppressed-error-handler other-errs)
(fn [e]
(error e "error in suppressed-error-handler"))))
(error-handler err))
c)))))
(mx/defn ^:always-validate execute
"Returns a Promise encapsulating the execution of the given [[InterceptorContext]].
Runs all `:enter` interceptor fns (in FIFO order) and then all `:leave` fns
(in LIFO order) returning the end result `context` map.
If an error occurs during execution `:enter` processing is terminated and the
`:error` handlers of all executed interceptors are called (in LIFO order),
with the original error wrapped in an ex-info with ex-data containing the
::context at the point of failure - this can be used to resume processing
from the failure point
If the resulting `context` _still_ contains an error after this processing it
will be re-thrown when the execution promise is realised. "
([app-ctx
a-frame-router
interceptor-chain :- InterceptorList
initial-context]
(->> (initiate app-ctx
a-frame-router
interceptor-chain
initial-context)
(execute*))))
(defn resume
"resume a failed interceptor chain, from either
a thrown exception or a logged resume-context"
([app-ctx
a-frame-router
err-or-resume-context]
(resume
app-ctx
a-frame-router
default-error-handler
default-suppressed-error-handler
err-or-resume-context))
([app-ctx
a-frame-router
error-handler
suppressed-error-handler
err-or-resume-context]
(let [ctx (if (map? err-or-resume-context)
err-or-resume-context
(get (ex-data err-or-resume-context) ::context))]
(when (nil? ctx)
(throw
(ex-info
"no resume context in ex-data"
{:err-or-resume-context err-or-resume-context})))
(execute*
error-handler
suppressed-error-handler
(assoc-opaque-keys ctx app-ctx a-frame-router)))))