|
| 1 | +;; 1.1.x |
| 2 | +(ns compojure.api.coerce |
| 3 | + (:require [schema.coerce :as sc] |
| 4 | + [compojure.api.middleware :as mw] |
| 5 | + [compojure.api.exception :as ex] |
| 6 | + [clojure.walk :as walk] |
| 7 | + [schema.utils :as su] |
| 8 | + [linked.core :as linked])) |
| 9 | + |
| 10 | +(defn memoized-coercer |
| 11 | + "Returns a memoized version of a referentially transparent coercer fn. The |
| 12 | + memoized version of the function keeps a cache of the mapping from arguments |
| 13 | + to results and, when calls with the same arguments are repeated often, has |
| 14 | + higher performance at the expense of higher memory use. FIFO with 10000 entries. |
| 15 | + Cache will be filled if anonymous coercers are used (does not match the cache)" |
| 16 | + [] |
| 17 | + (let [cache (atom (linked/map)) |
| 18 | + cache-size 10000] |
| 19 | + (fn [& args] |
| 20 | + (or (@cache args) |
| 21 | + (let [coercer (apply sc/coercer args)] |
| 22 | + (swap! cache (fn [mem] |
| 23 | + (let [mem (assoc mem args coercer)] |
| 24 | + (if (>= (count mem) cache-size) |
| 25 | + (dissoc mem (-> mem first first)) |
| 26 | + mem)))) |
| 27 | + coercer))))) |
| 28 | + |
| 29 | +(defn cached-coercer [request] |
| 30 | + (or (-> request mw/get-options :coercer) sc/coercer)) |
| 31 | + |
| 32 | +(defn coerce-response! [request {:keys [status] :as response} responses] |
| 33 | + (-> (when-let [schema (or (:schema (get responses status)) |
| 34 | + (:schema (get responses :default)))] |
| 35 | + (when-let [matchers (mw/coercion-matchers request)] |
| 36 | + (when-let [matcher (matchers :response)] |
| 37 | + (let [coercer (cached-coercer request) |
| 38 | + coerce (coercer schema matcher) |
| 39 | + body (coerce (:body response))] |
| 40 | + (if (su/error? body) |
| 41 | + (throw (ex-info |
| 42 | + (str "Response validation failed: " (su/error-val body)) |
| 43 | + (assoc body :type ::ex/response-validation |
| 44 | + :response response))) |
| 45 | + (assoc response |
| 46 | + :compojure.api.meta/serializable? true |
| 47 | + :body body)))))) |
| 48 | + (or response))) |
| 49 | + |
| 50 | +(defn body-coercer-middleware [handler responses] |
| 51 | + (fn [request] |
| 52 | + (coerce-response! request (handler request) responses))) |
| 53 | + |
| 54 | +(defn coerce! [schema key type request] |
| 55 | + (let [value (walk/keywordize-keys (key request))] |
| 56 | + (if-let [matchers (mw/coercion-matchers request)] |
| 57 | + (if-let [matcher (matchers type)] |
| 58 | + (let [coercer (cached-coercer request) |
| 59 | + coerce (coercer schema matcher) |
| 60 | + result (coerce value)] |
| 61 | + (if (su/error? result) |
| 62 | + (throw (ex-info |
| 63 | + (str "Request validation failed: " (su/error-val result)) |
| 64 | + (assoc result :type ::ex/request-validation))) |
| 65 | + result)) |
| 66 | + value) |
| 67 | + value))) |
0 commit comments