Use route-level FIFO coercion cache (100)

Coercion cache is now at route-level for better isolation. Cache is for 100 entries
(schema + matcher pairs), which should be more than enough for standard use.
But using anonymous, route-specific coercers might cause route-spefic cache to
fill up, which is reported via a log.

Author: ikitommi

src/compojure/api/meta.clj

@@ -13,7 +13,9 @@
             [schema.core :as s]
             [schema.coerce :as sc]
             [schema.utils :as su]
-            [schema-tools.core :as st]))
+            [schema-tools.core :as st]
+            [linked.core :as linked]
+            [compojure.api.impl.logging :as logging]))
 
 ;;
 ;; Meta Evil
@@ -27,6 +29,10 @@
   "lexically bound meta-data for handlers."
   '+compojure-api-meta+)
 
+(def +compojure-api-coercer+
+  "lexically bound (caching) coercer for handlers."
+  '+compojure-api-coercer+)
+
 (defmacro meta-container [meta & form]
   `(let [accumulated-meta# (get-local +compojure-api-meta+)
          ~'+compojure-api-meta+ (deep-merge accumulated-meta# ~meta)]
@@ -47,7 +53,38 @@
 ;; Schema
 ;;
 
-(def memoized-coercer (memoize sc/coercer))
+(defn memoized-coercer
+  "Returns a memoized version of a referentially transparent coercer fn. The
+  memoized version of the function keeps a cache of the mapping from arguments
+  to results and, when calls with the same arguments are repeated often, has
+  higher performance at the expense of higher memory use. FIFO with 100 entries.
+  If the cached if filled, there will be a WARNING logged at least once -> root cause
+  is most propably that the route is using anonymous coercer, which doesn't hit
+  the cache. It will produce slower performance, but works otherwise as expected."
+  [name]
+  (let [cache (atom {:mem (linked/map), :overflow false})
+        cache-size 100]
+    (fn [& args]
+      (or (-> @cache :mem (get args))
+          (let [coercer (apply sc/coercer args)]
+            (swap! cache (fn [cache]
+                           (let [mem (assoc (:mem cache) args coercer)]
+                             (if (>= (count mem) cache-size)
+                               (do
+                                 (when-not (:overflow cache)
+                                   ;; side-effecting within a swap! might cause multiple writes.
+                                   ;; it's ok'ish as we are just reporting something that should be
+                                   ;; fixes at development time
+                                   (logging/log! :warning (str "Coercion memoization cache for " name
+                                                               " maxing at " cache-size ". "
+                                                               "You might recreate the coercer "
+                                                               "matcher on each request, causing "
+                                                               "coercer re-compilation per request, "
+                                                               "effecting coercion performance.")))
+                                 {:mem (dissoc mem (-> mem first first))
+                                  :overflow true})
+                               (assoc cache :mem mem)))))
+            coercer)))))
 
 (defn strict [schema]
   (dissoc schema 'schema.core/Keyword))
@@ -57,12 +94,12 @@
     (fnk-impl/letk-input-schema-and-body-form
       nil (with-meta bind {:schema s/Any}) [] nil)))
 
-(defn body-coercer-middleware [handler responses]
+(defn body-coercer-middleware [handler coercer responses]
   (fn [request]
     (if-let [{:keys [status] :as response} (handler request)]
       (if-let [schema (:schema (responses status))]
         (if-let [matcher (:response (mw/get-coercion-matcher-provider request))]
-          (let [coerce (memoized-coercer (value-of schema) matcher)
+          (let [coerce (coercer (value-of schema) matcher)
                 body (coerce (:body response))]
             (if (su/error? body)
               (throw+ (assoc body :type ::ex/response-validation))
@@ -79,7 +116,7 @@
   (assert (not (#{:query :json} type)) (str type " is DEPRECATED since 0.22.0. Use :body or :string instead."))
   `(let [value# (keywordize-keys (~key ~+compojure-api-request+))]
      (if-let [matcher# (~type (mw/get-coercion-matcher-provider ~+compojure-api-request+))]
-       (let [coerce# (memoized-coercer ~schema matcher#)
+       (let [coerce# (~+compojure-api-coercer+ ~schema matcher#)
              result# (coerce# value#)]
          (if (su/error? result#)
            (throw+ (assoc result# :type ::ex/request-validation))
@@ -115,9 +152,9 @@
 ;;
 
 (defmulti restructure-param
-  "Restructures a key value pair in smart routes. By default the key
-   is consumed form the :parameters map in acc. k = given key, v = value."
-  (fn [k v acc] k))
+          "Restructures a key value pair in smart routes. By default the key
+           is consumed form the :parameters map in acc. k = given key, v = value."
+          (fn [k v acc] k))
 
 ;;
 ;; Pass-through swagger metadata
@@ -321,6 +358,7 @@
 (defn restructure [method [path arg & args] & [{:keys [body-wrap]}]]
   (let [body-wrap (or body-wrap 'do)
         method-symbol (symbol (str (-> method meta :ns) "/" (-> method meta :name)))
+        coercer-name (str (keyword (.toLowerCase (name method-symbol))) " " path)
         [parameters body] (extract-parameters args)
         [lets letks responses middlewares] [[] [] nil nil]
         [lets arg-with-request arg] (destructure-compojure-api-request lets arg)
@@ -343,5 +381,6 @@
         body (if (seq middlewares) `(route-middlewares ~middlewares ~body ~arg) body)
         body (if (seq parameters) `(meta-container ~parameters ~body) body)
         body `(~method-symbol ~path ~arg-with-request ~body)
-        body (if responses `(body-coercer-middleware ~body ~responses) body)]
+        body (if responses `(body-coercer-middleware ~body ~+compojure-api-coercer+ ~responses) body)
+        body `(let [~+compojure-api-coercer+ (memoized-coercer ~coercer-name)] ~body)]
     body))

test/compojure/api/coercion_test.clj

@@ -111,4 +111,34 @@
       (fact "no coercion"
         (let [[status body] (get* app "/no-coercion" {:i 10})]
           status => 200
-          body => {:i "10"})))))
+          body => {:i "10"}))))
+
+  (fact "anonymous matchers, with 100+ calls to same endpoint"
+
+    (fact "at api-level, matcher is reused and the coercion matcher cache is not filled"
+      (let [app (api
+                  {:coercion (assoc mw/default-coercion-matchers :string (constantly nil))}
+                  (GET* "/anonymous" []
+                    :query-params [i :- s/Str]
+                    (ok {:i i})))]
+
+        (dotimes [_ 200]
+          (let [[status body] (get* app "/anonymous" {:i "10"})]
+            status => 200
+            body => {:i "10"})) => nil
+        (provided
+          (compojure.api.impl.logging/log! & anything) => irrelevant :times 0)))
+
+    (fact "at route-level, matcher is NOT reused and the the coercion matcher cache is filled"
+      (let [app (api
+                  (GET* "/anonymous" []
+                    :coercion (constantly (assoc mw/default-coercion-matchers :string (constantly nil)))
+                    :query-params [i :- s/Str]
+                    (ok {:i i})))]
+
+        (dotimes [_ 200]
+          (let [[status body] (get* app "/anonymous" {:i "10"})]
+            status => 200
+            body => {:i "10"})) => nil
+        (provided
+          (compojure.api.impl.logging/log! & anything) => irrelevant :times 1)))))