♻️ Simplify internal implementation of sm/schema namespace

This commit is contained in:
Andrey Antukh 2024-09-10 17:50:01 +02:00 committed by Alonso Torres
parent b882b9e283
commit 9e94cf7b99
3 changed files with 41 additions and 91 deletions

View file

@ -282,9 +282,17 @@
[:map {:title "params"} [:map {:title "params"}
[:session-id ::sm/uuid]]) [:session-id ::sm/uuid]])
(def ^:private decode-params
(sm/decoder schema:params sm/json-transformer))
(def ^:private validate-params!
(sm/validate-fn schema:params))
(defn- http-handler (defn- http-handler
[cfg {:keys [params ::session/profile-id] :as request}] [cfg {:keys [params ::session/profile-id] :as request}]
(let [{:keys [session-id]} (sm/conform! schema:params params)] (let [{:keys [session-id]} (-> params
decode-params
validate-params!)]
(cond (cond
(not profile-id) (not profile-id)
(ex/raise :type :authentication (ex/raise :type :authentication

View file

@ -57,16 +57,17 @@
:misplaced-slot :misplaced-slot
:missing-slot}) :missing-slot})
(def ^:private (def ^:private schema:error
schema:error [:map {:title "ValidationError"}
(sm/define [:code {:optional false} [::sm/one-of error-codes]]
[:map {:title "ValidationError"} [:hint {:optional false} :string]
[:code {:optional false} [::sm/one-of error-codes]] [:shape {:optional true} :map] ; Cannot validate a shape because here it may be broken
[:hint {:optional false} :string] [:shape-id {:optional true} ::sm/uuid]
[:shape {:optional true} :map] ; Cannot validate a shape because here it may be broken [:file-id ::sm/uuid]
[:shape-id {:optional true} ::sm/uuid] [:page-id {:optional true} [:maybe ::sm/uuid]]])
[:file-id ::sm/uuid]
[:page-id {:optional true} [:maybe ::sm/uuid]]])) (def check-error!
(sm/check-fn schema:error))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ERROR HANDLING ;; ERROR HANDLING
@ -95,7 +96,7 @@
(dm/assert! (dm/assert!
"expected valid error" "expected valid error"
(sm/check! schema:error error)) (check-error! error))
(vswap! *errors* conj error))) (vswap! *errors* conj error)))

View file

@ -29,11 +29,6 @@
[malli.util :as mu])) [malli.util :as mu]))
(defprotocol ILazySchema (defprotocol ILazySchema
(-get-schema [_])
(-get-validator [_])
(-get-explainer [_])
(-get-decoder [_])
(-get-encoder [_])
(-validate [_ o]) (-validate [_ o])
(-explain [_ o]) (-explain [_ o])
(-decode [_ o])) (-decode [_ o]))
@ -53,27 +48,21 @@
[s] [s]
(m/type-properties s)) (m/type-properties s))
(defn lazy-schema? (defn- lazy-schema?
[s] [s]
(satisfies? ILazySchema s)) (satisfies? ILazySchema s))
(defn schema (defn schema
[s] [s]
(if (lazy-schema? s) (m/schema s default-options))
(-get-schema s)
(m/schema s default-options)))
(defn validate (defn validate
[s value] [s value]
(if (lazy-schema? s) (m/validate s value default-options))
(-validate s value)
(m/validate s value default-options)))
(defn explain (defn explain
[s value] [s value]
(if (lazy-schema? s) (m/explain s value default-options))
(-explain s value)
(m/explain s value default-options)))
(defn simplify (defn simplify
"Given an explain data structure, return a simplified version of it" "Given an explain data structure, return a simplified version of it"
@ -171,29 +160,19 @@
(defn validator (defn validator
[s] [s]
(if (lazy-schema? s) (-> s schema m/validator))
(-get-validator s)
(-> s schema m/validator)))
(defn explainer (defn explainer
[s] [s]
(if (lazy-schema? s) (-> s schema m/explainer))
(-get-explainer s)
(-> s schema m/explainer)))
(defn encoder (defn encoder
([s]
(assert (lazy-schema? s) "expected lazy schema")
(-get-decoder s))
([s transformer] ([s transformer]
(m/encoder s default-options transformer)) (m/encoder s default-options transformer))
([s options transformer] ([s options transformer]
(m/encoder s options transformer))) (m/encoder s options transformer)))
(defn decoder (defn decoder
([s]
(assert (lazy-schema? s) "expected lazy schema")
(-get-decoder s))
([s transformer] ([s transformer]
(m/decoder s default-options transformer)) (m/decoder s default-options transformer))
([s options transformer] ([s options transformer]
@ -259,7 +238,7 @@
([s] (lookup sr/default-registry s)) ([s] (lookup sr/default-registry s))
([registry s] (schema (mr/schema registry s)))) ([registry s] (schema (mr/schema registry s))))
(defn fast-check! (defn- fast-check!
"A fast path for checking process, assumes the ILazySchema protocol "A fast path for checking process, assumes the ILazySchema protocol
implemented on the provided `s` schema. Sould not be used directly." implemented on the provided `s` schema. Sould not be used directly."
[s value] [s value]
@ -272,12 +251,12 @@
::explain explain})))) ::explain explain}))))
true) true)
(declare define) (declare ^:private lazy-schema)
(defn check-fn (defn check-fn
"Create a predefined check function" "Create a predefined check function"
[s] [s]
(let [schema (if (lazy-schema? s) s (define s))] (let [schema (if (lazy-schema? s) s (lazy-schema s))]
(partial fast-check! schema))) (partial fast-check! schema)))
(defn check! (defn check!
@ -285,19 +264,10 @@
schema over provided data. Raises an assertion exception, should be schema over provided data. Raises an assertion exception, should be
used together with `dm/assert!` or `dm/verify!`." used together with `dm/assert!` or `dm/verify!`."
[s value] [s value]
(if (lazy-schema? s) (let [s (if (lazy-schema? s) s (lazy-schema s))]
(fast-check! s value) (fast-check! s value)))
(do
(when-not ^boolean (m/validate s value default-options)
(let [hint (d/nilv dm/*assert-context* "check error")
explain (explain s value)]
(throw (ex-info hint {:type :assertion
:code :data-validation
:hint hint
::explain explain}))))
true)))
(defn fast-validate! (defn- fast-validate!
"A fast path for validation process, assumes the ILazySchema protocol "A fast path for validation process, assumes the ILazySchema protocol
implemented on the provided `s` schema. Sould not be used directly." implemented on the provided `s` schema. Sould not be used directly."
([s value] (fast-validate! s value nil)) ([s value] (fast-validate! s value nil))
@ -309,52 +279,33 @@
::explain explain} ::explain explain}
options) options)
hint (get options :hint "schema validation error")] hint (get options :hint "schema validation error")]
(throw (ex-info hint options)))))) (throw (ex-info hint options))))
value))
(defn validate-fn (defn validate-fn
"Create a predefined validate function that raises an expception" "Create a predefined validate function that raises an expception"
[s] [s]
(let [schema (if (lazy-schema? s) s (define s))] (let [schema (if (lazy-schema? s) s (lazy-schema s))]
(partial fast-validate! schema))) (partial fast-validate! schema)))
(defn validate! (defn validate!
"A generic validation function for predefined schemas." "A generic validation function for predefined schemas."
([s value] (validate! s value nil)) ([s value] (validate! s value nil))
([s value options] ([s value options]
(if (lazy-schema? s) (let [s (if (lazy-schema? s) s (lazy-schema s))]
(fast-validate! s value options) (fast-validate! s value options))))
(when-not ^boolean (m/validate s value default-options)
(let [explain (explain s value)
options (into {:type :validation
:code :data-validation
::explain explain}
options)
hint (get options :hint "schema validation error")]
(throw (ex-info hint options)))))))
;; FIXME: revisit
(defn conform!
[schema value]
(assert (lazy-schema? schema) "expected `schema` to satisfy ILazySchema protocol")
(let [params (-decode schema value)]
(fast-validate! schema params nil)
params))
(defn register! [type s] (defn register! [type s]
(let [s (if (map? s) (m/-simple-schema s) s)] (let [s (if (map? s) (m/-simple-schema s) s)]
(swap! sr/registry assoc type s) (swap! sr/registry assoc type s)
nil)) nil))
(defn define (defn- lazy-schema
"Create ans instance of ILazySchema" "Create ans instance of ILazySchema"
[s & {:keys [transformer] :or {transformer json-transformer} :as options}] [s]
(let [schema (delay (schema s)) (let [schema (delay (schema s))
validator (delay (m/validator @schema)) validator (delay (m/validator @schema))
explainer (delay (m/explainer @schema)) explainer (delay (m/explainer @schema))]
options (c/merge default-options (dissoc options :transformer))
decoder (delay (m/decoder @schema options transformer))
encoder (delay (m/encoder @schema options transformer))]
(reify (reify
m/AST m/AST
@ -397,16 +348,6 @@
(m/-form @schema)) (m/-form @schema))
ILazySchema ILazySchema
(-get-schema [_]
@schema)
(-get-validator [_]
@validator)
(-get-explainer [_]
@explainer)
(-get-encoder [_]
@encoder)
(-get-decoder [_]
@decoder)
(-validate [_ o] (-validate [_ o]
(@validator o)) (@validator o))
(-explain [_ o] (-explain [_ o]