|
| 1 | +(ns compojure.api.coercion.schema |
| 2 | + (:require [schema.coerce :as sc] |
| 3 | + [schema.utils :as su] |
| 4 | + [ring.swagger.coerce :as coerce] |
| 5 | + [compojure.api.coercion.core :as cc] |
| 6 | + [clojure.walk :as walk] |
| 7 | + [schema.core :as s] |
| 8 | + [compojure.api.common :as common] |
| 9 | + ;; side effects |
| 10 | + compojure.api.coercion.register-schema) |
| 11 | + (:import (java.io File) |
| 12 | + (schema.core OptionalKey RequiredKey) |
| 13 | + (schema.utils ValidationError NamedError))) |
| 14 | + |
| 15 | +(def string-coercion-matcher coerce/query-schema-coercion-matcher) |
| 16 | +(def json-coercion-matcher coerce/json-schema-coercion-matcher) |
| 17 | + |
| 18 | +(defn stringify |
| 19 | + "Stringifies Schema records recursively." |
| 20 | + [error] |
| 21 | + (walk/prewalk |
| 22 | + (fn [x] |
| 23 | + (cond |
| 24 | + (class? x) (.getName ^Class x) |
| 25 | + (instance? OptionalKey x) (pr-str (list 'opt (:k x))) |
| 26 | + (instance? RequiredKey x) (pr-str (list 'req (:k x))) |
| 27 | + (and (satisfies? s/Schema x) (record? x)) (try (pr-str (s/explain x)) (catch Exception _ x)) |
| 28 | + (instance? ValidationError x) (str (su/validation-error-explain x)) |
| 29 | + (instance? NamedError x) (str (su/named-error-explain x)) |
| 30 | + :else x)) |
| 31 | + error)) |
| 32 | + |
| 33 | +(def memoized-coercer |
| 34 | + (common/fifo-memoize sc/coercer 1000)) |
| 35 | + |
| 36 | +;; don't use coercion for certain types |
| 37 | +(defmulti coerce-response? identity :default ::default) |
| 38 | +(defmethod coerce-response? ::default [_] true) |
| 39 | +(defmethod coerce-response? File [_] false) |
| 40 | + |
| 41 | +(defrecord SchemaCoercion [name options] |
| 42 | + cc/Coercion |
| 43 | + (get-name [_] name) |
| 44 | + |
| 45 | + (get-apidocs [_ _ data] data) |
| 46 | + |
| 47 | + (make-open [_ schema] |
| 48 | + (if (map? schema) |
| 49 | + (assoc schema s/Keyword s/Any) |
| 50 | + schema)) |
| 51 | + |
| 52 | + (encode-error [_ error] |
| 53 | + (-> error |
| 54 | + (update :schema pr-str) |
| 55 | + (update :errors stringify))) |
| 56 | + |
| 57 | + (coerce-request [_ schema value type format request] |
| 58 | + (let [type-options (options type)] |
| 59 | + (if-let [matcher (or (get (get type-options :formats) format) |
| 60 | + (get type-options :default))] |
| 61 | + (let [coerce (memoized-coercer schema matcher) |
| 62 | + coerced (coerce value)] |
| 63 | + (if (su/error? coerced) |
| 64 | + (let [errors (su/error-val coerced)] |
| 65 | + (cc/map->CoercionError |
| 66 | + {:schema schema |
| 67 | + :errors errors})) |
| 68 | + coerced)) |
| 69 | + value))) |
| 70 | + |
| 71 | + (accept-response? [_ model] |
| 72 | + (coerce-response? model)) |
| 73 | + |
| 74 | + (coerce-response [this schema value type format request] |
| 75 | + (cc/coerce-request this schema value type format request))) |
| 76 | + |
| 77 | +(def default-options |
| 78 | + {:body {:default (constantly nil) |
| 79 | + :formats {"application/json" json-coercion-matcher |
| 80 | + "application/msgpack" json-coercion-matcher |
| 81 | + "application/x-yaml" json-coercion-matcher}} |
| 82 | + :string {:default string-coercion-matcher} |
| 83 | + :response {:default (constantly nil)}}) |
| 84 | + |
| 85 | +(defn create-coercion [options] |
| 86 | + (->SchemaCoercion :schema options)) |
| 87 | + |
| 88 | +(def default-coercion (create-coercion default-options)) |
0 commit comments