Middleware & Interceptor perf tests

dev-resources/logback.xml

@@ -0,0 +1,18 @@
+<configuration scan="true" scanPeriod="10 seconds">
+  <appender name="STDOUT" class="ch.qos.logback.core.ConsoleAppender">
+    <encoder>
+      <pattern>%-5level %logger{36} - %msg%n</pattern>
+    </encoder>
+    <filter class="ch.qos.logback.classic.filter.ThresholdFilter">
+      <level>INFO</level>
+    </filter>
+  </appender>
+
+
+  <root level="INFO">
+    <appender-ref ref="STDOUT" />
+  </root>
+
+  <logger name="user" level="ALL" />
+
+</configuration>

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

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 [<! 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))))