diff --git a/dev-resources/logback.xml b/dev-resources/logback.xml new file mode 100644 index 00000000..dd87ec5e --- /dev/null +++ b/dev-resources/logback.xml @@ -0,0 +1,18 @@ + + + + %-5level %logger{36} - %msg%n + + + INFO + + + + + + + + + + + \ No newline at end of file diff --git a/perf-test/clj/reitit/middleware_interceptor_perf.clj b/perf-test/clj/reitit/middleware_interceptor_perf.clj new file mode 100644 index 00000000..d769ec61 --- /dev/null +++ b/perf-test/clj/reitit/middleware_interceptor_perf.clj @@ -0,0 +1,250 @@ +(ns reitit.middleware-interceptor-perf + (:require [criterium.core :as cc] + [reitit.perf-utils :refer :all] + [reitit.middleware :as middleware] + [reitit.interceptor :as interceptor] + + reitit.chain + io.pedestal.interceptor + io.pedestal.interceptor.chain)) + +;; +;; start repl with `lein perf repl` +;; perf measured with the following setup: +;; +;; Model Name: MacBook Pro +;; Model Identifier: MacBookPro113 +;; Processor Name: Intel Core i7 +;; Processor Speed: 2,5 GHz +;; Number of Processors: 1 +;; Total Number of Cores: 4 +;; L2 Cache (per Core): 256 KB +;; L3 Cache: 6 MB +;; Memory: 16 GB +;; + +;; +;; middleware +;; + +(set! *warn-on-reflection* true) + +(defrecord RequestOrContext [values queue stack]) + +(def +items+ 100) + +(defn expected! [x] + (assert (= (range +items+) (:values x)))) + +(defn middleware [handler value] + (fn [request] + (let [values (or (:values request) [])] + (handler (assoc request :values (conj values value)))))) + +(defn middleware-test [] + (let [mw (map (fn [value] [middleware value]) (range +items+)) + app (middleware/chain mw identity) + map-request {} + record-request (map->RequestOrContext map-request)] + + ;; 10.8 µs + (title "middleware - map") + (expected! (app map-request)) + (cc/quick-bench + (app map-request)) + + ;; 4.7 µs + (title "middleware - record") + (expected! (app record-request)) + (cc/quick-bench + (app record-request)) + + (title "middleware - dynamic") + (expected! ((middleware/chain mw identity) record-request)) + (cc/quick-bench + ((middleware/chain mw identity) record-request)))) + +;; +;; Reduce +;; + +(defn test-reduce [] + (let [ints (vec (range +items+)) + size (count ints)] + + ;; 64µs + (cc/quick-bench + (reduce #(+ ^int %1 ^int %2) ints)) + + ;; 123µs + (cc/quick-bench + (loop [sum 0, i 0] + (if (= i size) + sum + (recur (+ sum ^int (nth ints i)) (inc i))))) + + ;; 34µs + (cc/quick-bench + (let [iter (clojure.lang.RT/iter ints)] + (loop [sum 0] + (if (.hasNext iter) + (recur (+ sum ^int (.next iter))) + sum)))))) + +;; +;; Interceptor +;; + +(defn interceptor [value] + (fn [context] + (let [values (or (:values context) [])] + (assoc context :values (conj values value))))) + +;; +;; Pedestal +;; + +(defn pedestal-chain-text [] + (let [is (map io.pedestal.interceptor/interceptor + (map (fn [value] + {:enter (interceptor value)}) (range +items+))) + ctx (io.pedestal.interceptor.chain/enqueue nil is)] + + ;; 78 µs + (title "pedestal") + (cc/quick-bench + (io.pedestal.interceptor.chain/execute ctx)))) + +(defn pedestal-tuned-chain-text [] + (let [is (map io.pedestal.interceptor/interceptor + (map (fn [value] + {:enter (interceptor value)}) (range +items+))) + ctx (reitit.chain/map->Context (reitit.chain/enqueue nil is))] + + ;; 67 µs + (title "pedestal - tuned") + (cc/quick-bench + (reitit.chain/execute ctx)))) + +;; +;; Naive chain +;; + +(defn execute [ctx f] (f ctx)) + +(defn executor-reduce [interceptors] + (fn [ctx] + (as-> ctx $ + (reduce execute $ (keep :enter interceptors)) + (reduce execute $ (reverse (keep :leave interceptors)))))) + +(defn interceptor-test [] + (let [interceptors (map (fn [value] [interceptor value]) (range +items+)) + app (executor-reduce (interceptor/chain interceptors identity)) + map-request {} + record-request (map->RequestOrContext map-request)] + + ;; 13.5 µs (Map) + (title "interceptors - map") + (expected! (app map-request)) + (cc/quick-bench + (app map-request)) + + ;; 7.2 µs (Record) + (title "interceptors - record") + (expected! (app record-request)) + (cc/quick-bench + (app record-request)))) + +;; +;; different reducers +;; + +(defn enqueue [ctx interceptors] + (let [queue (or (:queue ctx) clojure.lang.PersistentQueue/EMPTY)] + (assoc ctx :queue (into queue interceptors)))) + +(defn queue [ctx interceptors] + (let [queue (or (:queue ctx) clojure.lang.PersistentQueue/EMPTY)] + (into queue interceptors))) + +(defn leavel-all-queue [ctx stack] + (let [it (clojure.lang.RT/iter stack)] + (loop [ctx ctx] + (if (.hasNext it) + (if-let [leave (-> it .next :leave)] + (recur (leave ctx)) + (recur ctx)) + ctx)))) + +(defn executor-queue [interceptors] + (fn [ctx] + (loop [queue (queue ctx interceptors) + stack nil + ctx ctx] + (if-let [interceptor (peek queue)] + (let [queue (pop queue) + stack (conj stack interceptor) + f (or (:enter interceptor) identity)] + (recur queue stack (f ctx))) + (leavel-all-queue ctx stack))))) + +(defn leave-all-ctx-queue [ctx stack] + (let [it (clojure.lang.RT/iter stack)] + (loop [ctx ctx] + (if (.hasNext it) + (if-let [leave (-> it .next :leave)] + (recur (leave ctx)) + (recur ctx)) + ctx)))) + +(defn executor-ctx-queue [interceptors] + (fn [ctx] + (loop [ctx (assoc ctx :queue (queue ctx interceptors))] + (let [queue ^clojure.lang.PersistentQueue (:queue ctx) + stack (:stack ctx)] + (if-let [interceptor (peek queue)] + (let [queue (pop queue) + stack (conj stack interceptor) + f (or (:enter interceptor) identity)] + (recur (-> ctx (assoc :queue queue) (assoc :stac stack) f))) + (leave-all-ctx-queue ctx stack)))))) + +(defn interceptor-chain-test [] + (let [interceptors (map (fn [value] [interceptor value]) (range +items+)) + app-reduce (executor-reduce (interceptor/chain interceptors identity)) + app-queue (executor-queue (interceptor/chain interceptors identity)) + app-ctx-queue (executor-ctx-queue (interceptor/chain interceptors identity)) + request {}] + + ;; 14.2 µs + (title "interceptors - reduce") + (expected! (app-reduce request)) + (cc/quick-bench + (app-reduce request)) + + ;; 19.4 µs + (title "interceptors - queue") + (expected! (app-queue request)) + (cc/quick-bench + (app-queue request)) + + ;; 30.9 µs + (title "interceptors - ctx-queue") + (expected! (app-ctx-queue request)) + (cc/quick-bench + (app-ctx-queue request)))) + +(comment + (interceptor-test) + (middleware-test) + (pedestal-chain-text) + (pedestal-tuned-chain-text) + (interceptor-chain-test)) + +; Middleware (static chain) => 5µs +; Middleware (dynamic chain) => 60µs + +; Interceptor (static queue) => 20µs +; Interceptor (context queues) => 30µs +; Pedestal (context queues) => 79µs diff --git a/test/cljc/reitit/chain.clj b/test/cljc/reitit/chain.clj new file mode 100644 index 00000000..cff3242c --- /dev/null +++ b/test/cljc/reitit/chain.clj @@ -0,0 +1,380 @@ +; 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. + +(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 [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 + (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))))