mirror of
https://github.com/metosin/reitit.git
synced 2025-12-17 16:31:11 +00:00
dead code
This commit is contained in:
Tommi Reiman
parent
d68e1b81fb
commit
69550febfa
1 changed files with 0 additions and 382 deletions
|
|
@ -1,382 +0,0 @@
|
||||||
; Copyright 2013 Relevance, Inc.
|
|
||||||
; Copyright 2014-2016 Cognitect, Inc.
|
|
||||||
|
|
||||||
; The use and distribution terms for this software are covered by the
|
|
||||||
; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0)
|
|
||||||
; which can be found in the file epl-v10.html at the root of this distribution.
|
|
||||||
;
|
|
||||||
; By using this software in any fashion, you are agreeing to be bound by
|
|
||||||
; the terms of this license.
|
|
||||||
;
|
|
||||||
; You must not remove this notice, or any other, from this software.
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(ns reitit.chain
|
|
||||||
"Interceptor pattern. Executes a chain of Interceptor functions on a
|
|
||||||
common \"context\" map, maintaining a virtual \"stack\", with error
|
|
||||||
handling and support for asynchronous execution."
|
|
||||||
(:refer-clojure :exclude (name))
|
|
||||||
(:require [clojure.core.async :as async :refer [<! go]]
|
|
||||||
[io.pedestal.log :as log]
|
|
||||||
[io.pedestal.interceptor :as interceptor])
|
|
||||||
(:import java.util.concurrent.atomic.AtomicLong))
|
|
||||||
|
|
||||||
(defrecord Context [execution-id stack queue terminators supressed async-info rebind])
|
|
||||||
|
|
||||||
(declare execute)
|
|
||||||
(declare execute-only)
|
|
||||||
|
|
||||||
(defn- channel? [c] (instance? clojure.core.async.impl.protocols.Channel c))
|
|
||||||
|
|
||||||
;; This is used for printing out interceptors within debug messages
|
|
||||||
(defn- name [interceptor]
|
|
||||||
(:name interceptor (pr-str interceptor)))
|
|
||||||
|
|
||||||
(defn- throwable->ex-info [^Throwable t execution-id interceptor stage]
|
|
||||||
(let [iname (name interceptor)
|
|
||||||
throwable-str (pr-str (type t))]
|
|
||||||
(ex-info (str throwable-str " in Interceptor " iname " - " (.getMessage t))
|
|
||||||
(merge {:execution-id execution-id
|
|
||||||
:stage stage
|
|
||||||
:interceptor iname
|
|
||||||
:exception-type (keyword throwable-str)
|
|
||||||
:exception t}
|
|
||||||
(ex-data t))
|
|
||||||
t)))
|
|
||||||
|
|
||||||
(defn- try-f
|
|
||||||
"If f is not nil, invokes it on context. If f throws an exception,
|
|
||||||
assoc's it on to context as :error."
|
|
||||||
[context interceptor stage]
|
|
||||||
(let [execution-id (:execution-id context)]
|
|
||||||
(if-let [f (stage interceptor)]
|
|
||||||
(try (log/debug :interceptor (name interceptor)
|
|
||||||
:stage stage
|
|
||||||
:execution-id execution-id
|
|
||||||
:fn f)
|
|
||||||
(f context)
|
|
||||||
(catch Throwable t
|
|
||||||
(log/debug :throw t :execution-id execution-id)
|
|
||||||
(assoc context :error (throwable->ex-info t execution-id interceptor stage))))
|
|
||||||
(do (log/trace :interceptor (name interceptor)
|
|
||||||
:skipped? true
|
|
||||||
:stage stage
|
|
||||||
:execution-id execution-id)
|
|
||||||
context))))
|
|
||||||
|
|
||||||
(defn- try-error
|
|
||||||
"If error-fn is not nil, invokes it on context and the current :error
|
|
||||||
from context."
|
|
||||||
[context interceptor]
|
|
||||||
(let [execution-id (:execution-id context)]
|
|
||||||
(if-let [error-fn (:error interceptor)]
|
|
||||||
(let [ex (:error context)
|
|
||||||
stage :error]
|
|
||||||
(log/debug :interceptor (name interceptor)
|
|
||||||
:stage :error
|
|
||||||
:execution-id execution-id)
|
|
||||||
(try (error-fn (assoc context :error nil) ex)
|
|
||||||
(catch Throwable t
|
|
||||||
(if (identical? (type t) (type (:exception ex)))
|
|
||||||
(do (log/debug :rethrow t :execution-id execution-id)
|
|
||||||
context)
|
|
||||||
(do (log/debug :throw t :suppressed (:exception-type ex) :execution-id execution-id)
|
|
||||||
(-> context
|
|
||||||
(assoc :error (throwable->ex-info t execution-id interceptor :error))
|
|
||||||
(update :suppressed conj ex)))))))
|
|
||||||
(do (log/trace :interceptor (name interceptor)
|
|
||||||
:skipped? true
|
|
||||||
:stage :error
|
|
||||||
:execution-id execution-id)
|
|
||||||
context))))
|
|
||||||
|
|
||||||
(defn- check-terminators
|
|
||||||
"Invokes each predicate in :terminators on context. If any predicate
|
|
||||||
returns true, removes :queue from context."
|
|
||||||
[context]
|
|
||||||
(if (some #(% context) (:terminators context))
|
|
||||||
(let [execution-id (:execution-id context)]
|
|
||||||
(log/debug :in 'check-terminators
|
|
||||||
:terminate? true
|
|
||||||
:execution-id execution-id)
|
|
||||||
(assoc context :queue nil))
|
|
||||||
context))
|
|
||||||
|
|
||||||
(defn- prepare-for-async
|
|
||||||
"Call all of the :enter-async functions in a context. The purpose of these
|
|
||||||
functions is to ready backing servlets or any other machinery for preparing
|
|
||||||
an asynchronous response."
|
|
||||||
[{:keys [enter-async] :as context}]
|
|
||||||
(doseq [enter-async-fn enter-async]
|
|
||||||
(enter-async-fn context)))
|
|
||||||
|
|
||||||
(defn- go-async
|
|
||||||
"When presented with a channel as the return value of an enter function,
|
|
||||||
wait for the channel to return a new-context (via a go block). When a new
|
|
||||||
context is received, restart execution of the interceptor chain with that
|
|
||||||
context.
|
|
||||||
This function is non-blocking, returning nil immediately (a signal to halt
|
|
||||||
further execution on this thread)."
|
|
||||||
([old-context context-channel]
|
|
||||||
(prepare-for-async old-context)
|
|
||||||
(go
|
|
||||||
(if-let [new-context (<! context-channel)]
|
|
||||||
(execute new-context)
|
|
||||||
(execute (assoc (assoc old-context :queue nil :async-info nil)
|
|
||||||
:stack (get-in old-context [:async-info :stack])
|
|
||||||
:error (ex-info "Async Interceptor closed Context Channel before delivering a Context"
|
|
||||||
{:execution-id (:execution-id old-context)
|
|
||||||
:stage (get-in old-context [:async-info :stage])
|
|
||||||
:interceptor (name (get-in old-context [:async-info :interceptor]))
|
|
||||||
:exception-type :PedestalChainAsyncPrematureClose})))))
|
|
||||||
nil)
|
|
||||||
([old-context context-channel interceptor-key]
|
|
||||||
(prepare-for-async old-context)
|
|
||||||
(go
|
|
||||||
(if-let [new-context (<! context-channel)]
|
|
||||||
(execute-only new-context interceptor-key)
|
|
||||||
(execute-only (assoc (assoc old-context :queue nil :async-info nil)
|
|
||||||
:stack (get-in old-context [:async-info :stack])
|
|
||||||
:error (ex-info "Async Interceptor closed Context Channel before delivering a Context"
|
|
||||||
{:execution-id (:execution-id old-context)
|
|
||||||
:stage (get-in old-context [:async-info :stage])
|
|
||||||
:interceptor (name (get-in old-context [:async-info :interceptor]))
|
|
||||||
:exception-type :PedestalChainAsyncPrematureClose}))
|
|
||||||
interceptor-key)))
|
|
||||||
nil))
|
|
||||||
|
|
||||||
(defn- process-all-with-binding
|
|
||||||
"Invokes `interceptor-key` functions of all Interceptors on the execution
|
|
||||||
:queue of context, saves them on the :stack of context.
|
|
||||||
Returns updated context.
|
|
||||||
By default, `interceptor-key` is :enter"
|
|
||||||
([context]
|
|
||||||
(process-all-with-binding context :enter))
|
|
||||||
([context interceptor-key]
|
|
||||||
(log/debug :in 'process-all :handling interceptor-key :execution-id (:execution-id context))
|
|
||||||
(loop [context context]
|
|
||||||
(let [queue (:queue context)
|
|
||||||
stack (:stack context)]
|
|
||||||
(log/trace :context context)
|
|
||||||
(if (empty? queue)
|
|
||||||
context
|
|
||||||
(let [interceptor (peek queue)
|
|
||||||
old-context context
|
|
||||||
new-queue (pop queue)
|
|
||||||
;; conj on nil returns a list, acts like a stack:
|
|
||||||
new-stack (conj stack interceptor)
|
|
||||||
context (-> context
|
|
||||||
(assoc :queue new-queue)
|
|
||||||
(assoc :stack new-stack)
|
|
||||||
(try-f interceptor interceptor-key))]
|
|
||||||
(cond
|
|
||||||
(channel? context) (go-async (assoc old-context
|
|
||||||
:async-info {:interceptor interceptor
|
|
||||||
:stage interceptor-key
|
|
||||||
:stack new-stack})
|
|
||||||
context)
|
|
||||||
(:error context) (assoc context :queue nil)
|
|
||||||
(not= (:bindings context) (:bindings old-context)) (assoc context :rebind true)
|
|
||||||
true (recur (check-terminators context)))))))))
|
|
||||||
|
|
||||||
(defn- process-all
|
|
||||||
[context interceptor-key]
|
|
||||||
;; If we're processing leave handlers, reverse the queue
|
|
||||||
(let [context (if (= interceptor-key :leave) (update context :queue reverse) context)
|
|
||||||
context (with-bindings (or (:bindings context)
|
|
||||||
{})
|
|
||||||
(process-all-with-binding context interceptor-key))]
|
|
||||||
(if (:rebind context)
|
|
||||||
(recur (assoc context :rebind nil) interceptor-key)
|
|
||||||
context)))
|
|
||||||
|
|
||||||
(defn- process-any-errors-with-binding
|
|
||||||
"Unwinds the context by invoking :error functions of Interceptors on
|
|
||||||
the :stack of context, but **only** if there is an :error present in the context."
|
|
||||||
[context]
|
|
||||||
(log/debug :in 'process-any-errors :execution-id (:execution-id context))
|
|
||||||
(loop [context context]
|
|
||||||
(let [stack (:stack context)]
|
|
||||||
(log/trace :context context)
|
|
||||||
(if (empty? stack)
|
|
||||||
context
|
|
||||||
(let [interceptor (peek stack)
|
|
||||||
pre-bindings (:bindings context)
|
|
||||||
old-context context
|
|
||||||
context (assoc context :stack (pop stack))
|
|
||||||
context (if (:error context)
|
|
||||||
(try-error context interceptor)
|
|
||||||
context)]
|
|
||||||
(cond
|
|
||||||
(channel? context) (go-async old-context context)
|
|
||||||
(not= (:bindings context) pre-bindings) (assoc context :rebind true)
|
|
||||||
true (recur context)))))))
|
|
||||||
|
|
||||||
(defn- process-any-errors
|
|
||||||
"Establish the bindings present in `context` as thread local
|
|
||||||
bindings, and then invoke process-any-errors-with-binding.
|
|
||||||
Conditionally re-establish bindings if a change in bindings is made by an
|
|
||||||
interceptor."
|
|
||||||
[context]
|
|
||||||
(let [context (with-bindings (or (:bindings context) {})
|
|
||||||
(process-any-errors-with-binding context))]
|
|
||||||
(if (:rebind context)
|
|
||||||
(recur (assoc context :rebind nil))
|
|
||||||
context)))
|
|
||||||
|
|
||||||
(defn- enter-all
|
|
||||||
"Establish the bindings present in `context` as thread local
|
|
||||||
bindings, and then invoke enter-all-with-binding. Conditionally
|
|
||||||
re-establish bindings if a change in bindings is made by an
|
|
||||||
interceptor."
|
|
||||||
[context]
|
|
||||||
(process-all context :enter))
|
|
||||||
|
|
||||||
(defn- leave-all-with-binding
|
|
||||||
"Unwinds the context by invoking :leave functions of Interceptors on
|
|
||||||
the :stack of context. Returns updated context."
|
|
||||||
[context]
|
|
||||||
(log/debug :in 'leave-all :execution-id (:execution-id context))
|
|
||||||
(loop [context context]
|
|
||||||
(let [stack (:stack context)]
|
|
||||||
(log/trace :context context)
|
|
||||||
(if (empty? stack)
|
|
||||||
context
|
|
||||||
(let [interceptor (peek stack)
|
|
||||||
pre-bindings (:bindings context)
|
|
||||||
old-context context
|
|
||||||
context (assoc context :stack (pop stack))
|
|
||||||
context (if (:error context)
|
|
||||||
(try-error context interceptor)
|
|
||||||
(try-f context interceptor :leave))]
|
|
||||||
(cond
|
|
||||||
(channel? context) (go-async old-context context)
|
|
||||||
(not= (:bindings context) pre-bindings) (assoc context :rebind true)
|
|
||||||
true (recur context)))))))
|
|
||||||
|
|
||||||
(defn- leave-all
|
|
||||||
"Establish the bindings present in `context` as thread local
|
|
||||||
bindings, and then invoke leave-all-with-binding. Conditionally
|
|
||||||
re-establish bindings if a change in bindings is made by an
|
|
||||||
interceptor."
|
|
||||||
[context]
|
|
||||||
(let [context (with-bindings (or (:bindings context) {})
|
|
||||||
(leave-all-with-binding context))]
|
|
||||||
(if (:rebind context)
|
|
||||||
(recur (assoc context :rebind nil))
|
|
||||||
context)))
|
|
||||||
|
|
||||||
(defn enqueue
|
|
||||||
"Adds interceptors to the end of context's execution queue. Creates
|
|
||||||
the queue if necessary. Returns updated context."
|
|
||||||
[context interceptors]
|
|
||||||
{:pre (every? interceptor/interceptor? interceptors)}
|
|
||||||
(log/trace :enqueue (map name interceptors) :context context)
|
|
||||||
(update context :queue
|
|
||||||
(fnil into clojure.lang.PersistentQueue/EMPTY)
|
|
||||||
interceptors))
|
|
||||||
|
|
||||||
(defn enqueue*
|
|
||||||
"Like 'enqueue' but vararg.
|
|
||||||
If the last argument is a sequence of interceptors,
|
|
||||||
they're unpacked and to added to the context's execution queue."
|
|
||||||
[context & interceptors-and-seq]
|
|
||||||
(if (seq? (last interceptors-and-seq))
|
|
||||||
(enqueue context (apply list* interceptors-and-seq))
|
|
||||||
(enqueue context interceptors-and-seq)))
|
|
||||||
|
|
||||||
(defn terminate
|
|
||||||
"Removes all remaining interceptors from context's execution queue.
|
|
||||||
This effectively short-circuits execution of Interceptors' :enter
|
|
||||||
functions and begins executing the :leave functions."
|
|
||||||
[context]
|
|
||||||
(log/trace :in 'terminate :context context)
|
|
||||||
(assoc context :queue nil))
|
|
||||||
|
|
||||||
(defn terminate-when
|
|
||||||
"Adds pred as a terminating condition of the context. pred is a
|
|
||||||
function that takes a context as its argument. It will be invoked
|
|
||||||
after every Interceptor's :enter function. If pred returns logical
|
|
||||||
true, execution will stop at that Interceptor."
|
|
||||||
[context pred]
|
|
||||||
(update context :terminators conj pred))
|
|
||||||
|
|
||||||
(def ^:private ^AtomicLong execution-id (AtomicLong.))
|
|
||||||
|
|
||||||
(defn- begin [context]
|
|
||||||
(if (:execution-id context)
|
|
||||||
context
|
|
||||||
(let [execution-id (.incrementAndGet execution-id)]
|
|
||||||
(log/debug :in 'begin :execution-id execution-id)
|
|
||||||
(log/trace :context context)
|
|
||||||
(assoc context :execution-id execution-id))))
|
|
||||||
|
|
||||||
(defn- end [context]
|
|
||||||
(if (:execution-id context)
|
|
||||||
(do
|
|
||||||
(log/debug :in 'end :execution-id (:execution-id context) :context-keys (keys context))
|
|
||||||
(log/trace :context context)
|
|
||||||
(assoc context :stack nil :execution-id nil))
|
|
||||||
context))
|
|
||||||
|
|
||||||
(defn execute-only
|
|
||||||
"Like `execute`, but only processes the interceptors in a single direction,
|
|
||||||
using `interceptor-key` (i.e. :enter, :leave) to determine which functions
|
|
||||||
to call.
|
|
||||||
---
|
|
||||||
Executes a queue of Interceptors attached to the context. Context
|
|
||||||
must be a map, Interceptors are added with 'enqueue'.
|
|
||||||
An Interceptor Record has keys :enter, :leave, and :error.
|
|
||||||
The value of each key is a function; missing
|
|
||||||
keys or nil values are ignored. When executing a context, all
|
|
||||||
the `interceptor-key` functions are invoked in order. As this happens, the
|
|
||||||
Interceptors are pushed on to a stack."
|
|
||||||
([context interceptor-key]
|
|
||||||
(let [context (some-> context
|
|
||||||
map->Context
|
|
||||||
begin
|
|
||||||
(process-all interceptor-key)
|
|
||||||
terminate
|
|
||||||
process-any-errors
|
|
||||||
end)]
|
|
||||||
(if-let [ex (:error context)]
|
|
||||||
(throw ex)
|
|
||||||
context)))
|
|
||||||
([context interceptor-key interceptors]
|
|
||||||
(execute-only (enqueue context interceptors) interceptor-key)))
|
|
||||||
|
|
||||||
(defn execute
|
|
||||||
"Executes a queue of Interceptors attached to the context. Context
|
|
||||||
must be a map, Interceptors are added with 'enqueue'.
|
|
||||||
An Interceptor is a map or map-like object with the keys :enter,
|
|
||||||
:leave, and :error. The value of each key is a function; missing
|
|
||||||
keys or nil values are ignored. When executing a context, first all
|
|
||||||
the :enter functions are invoked in order. As this happens, the
|
|
||||||
Interceptors are pushed on to a stack.
|
|
||||||
When execution reaches the end of the queue, it begins popping
|
|
||||||
Interceptors off the stack and calling their :leave functions.
|
|
||||||
Therefore :leave functions are called in the opposite order from
|
|
||||||
:enter functions.
|
|
||||||
Both the :enter and :leave functions are called on a single
|
|
||||||
argument, the context map, and return an updated context.
|
|
||||||
If any Interceptor function throws an exception, execution stops and
|
|
||||||
begins popping Interceptors off the stack and calling their :error
|
|
||||||
functions. The :error function takes two arguments: the context and
|
|
||||||
an exception. It may either handle the exception, in which case the
|
|
||||||
execution continues with the next :leave function on the stack; or
|
|
||||||
re-throw the exception, passing control to the :error function on
|
|
||||||
the stack. If the exception reaches the end of the stack without
|
|
||||||
being handled, execute will throw it."
|
|
||||||
([context]
|
|
||||||
(let [context (some-> context
|
|
||||||
begin
|
|
||||||
enter-all
|
|
||||||
terminate
|
|
||||||
leave-all
|
|
||||||
end)]
|
|
||||||
(if-let [ex (:error context)]
|
|
||||||
(throw ex)
|
|
||||||
context)))
|
|
||||||
([context interceptors]
|
|
||||||
(execute (enqueue context interceptors))))
|
|
||||||
)
|
|
||||||
Loading…
Reference in a new issue