From 81dc76bb146f62f6019ae01e1b63efac6db3550d Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Mon, 27 Nov 2023 16:09:18 +0100 Subject: [PATCH] :zap: Add performance improvements on schema validation system --- common/src/app/common/schema.cljc | 114 ++++++++++++++++++++---------- 1 file changed, 75 insertions(+), 39 deletions(-) diff --git a/common/src/app/common/schema.cljc b/common/src/app/common/schema.cljc index f1a86f7c2..8fc44587f 100644 --- a/common/src/app/common/schema.cljc +++ b/common/src/app/common/schema.cljc @@ -16,7 +16,7 @@ [app.common.schema.registry :as sr] [app.common.uri :as u] [app.common.uuid :as uuid] - [clojure.test.check.generators :as tgen] + [clojure.core :as c] [cuerdas.core :as str] [malli.core :as m] [malli.dev.pretty :as mdp] @@ -26,7 +26,12 @@ [malli.transform :as mt] [malli.util :as mu])) -(defprotocol ISchemaOps +(defprotocol ILazySchema + (-get-schema [_]) + (-get-validator [_]) + (-get-explainer [_]) + (-get-decoder [_]) + (-get-encoder [_]) (-validate [_ o]) (-explain [_ o]) (-decode [_ o])) @@ -34,21 +39,31 @@ (def default-options {:registry sr/default-registry}) -(defn explain - [s value] - (m/explain s value default-options)) - (defn schema? [o] (m/schema? o)) +(defn lazy-schema? + [s] + (satisfies? ILazySchema s)) + (defn schema [s] - (m/schema s default-options)) + (if (lazy-schema? s) + (-get-schema s) + (m/schema s default-options))) (defn validate [s value] - (m/validate s value default-options)) + (if (lazy-schema? s) + (-validate s value) + (m/validate s value default-options))) + +(defn explain + [s value] + (if (lazy-schema? s) + (-explain s value) + (m/explain s value default-options))) (defn humanize [exp] @@ -113,11 +128,15 @@ (defn validator [s] - (-> s schema m/validator)) + (if (lazy-schema? s) + (-get-validator s) + (-> s schema m/validator))) (defn explainer [s] - (-> s schema m/explainer)) + (if (lazy-schema? s) + (-get-explainer s) + (-> s schema m/explainer))) (defn encode ([s val transformer] @@ -131,9 +150,23 @@ ([s val options transformer] (m/decode s val options transformer))) -(defn decoder +(defn encoder + ([s] + (if (lazy-schema? s) + (-get-decoder s) + (encoder s default-options default-transformer))) ([s transformer] - (m/decoder s default-options transformer)) + (m/encoder s default-options transformer)) + ([s options transformer] + (m/encoder s options transformer))) + +(defn decoder + ([s] + (if (lazy-schema? s) + (-get-decoder s) + (decoder s default-options default-transformer))) + ([s transformer] + (m/decoder s default-options transformer)) ([s options transformer] (m/decoder s options transformer))) @@ -201,10 +234,8 @@ ([s] (lookup sr/default-registry s)) ([registry s] (schema (mr/schema registry s)))) -(declare define) - (defn fast-check! - "A fast path for checking process, assumes the ISchemaOps protocol + "A fast path for checking process, assumes the ILazySchema protocol implemented on the provided `s` schema. Sould not be used directly." [s value] (when-not ^boolean (-validate s value) @@ -216,10 +247,12 @@ ::explain explain})))) true) +(declare define) + (defn check-fn "Create a predefined check function" [s] - (let [schema (if (satisfies? ISchemaOps s) s (define s))] + (let [schema (if (lazy-schema? s) s (define s))] (partial fast-check! schema))) (defn check! @@ -227,7 +260,7 @@ schema over provided data. Raises an assertion exception, should be used together with `dm/assert!` or `dm/verify!`." [s value] - (if (satisfies? ISchemaOps s) + (if (lazy-schema? s) (fast-check! s value) (do (when-not ^boolean (m/validate s value default-options) @@ -241,7 +274,7 @@ (defn fast-validate! - "A fast path for validation process, assumes the ISchemaOps protocol + "A fast path for validation process, assumes the ILazySchema protocol implemented on the provided `s` schema. Sould not be used directly." ([s value] (fast-validate! s value nil)) ([s value options] @@ -257,14 +290,14 @@ (defn validate-fn "Create a predefined validate function" [s] - (let [schema (if (satisfies? ISchemaOps s) s (define s))] + (let [schema (if (lazy-schema? s) s (define s))] (partial fast-validate! schema))) (defn validate! "A generic validation function for predefined schemas." ([s value] (validate! s value nil)) ([s value options] - (if (satisfies? ISchemaOps s) + (if (lazy-schema? s) (fast-validate! s value options) (when-not ^boolean (m/validate s value default-options) (let [explain (explain s value) @@ -277,7 +310,7 @@ (defn conform! [schema value] - (assert (satisfies? ISchemaOps schema) "expected `schema` to satisfy ISchemaOps protocol") + (assert (lazy-schema? schema) "expected `schema` to satisfy ILazySchema protocol") (let [params (-decode schema value)] (fast-validate! schema params nil) params)) @@ -295,11 +328,16 @@ nil) (defn define - [s] - (let [schema (delay (schema s)) - validator (delay (validator @schema)) - explainer (delay (explainer @schema)) - decoder (delay (decoder @schema default-transformer))] + "Create ans instance of ILazySchema" + [s & {:keys [transformer] :as options}] + (let [schema (delay (schema s)) + validator (delay (m/validator @schema)) + explainer (delay (m/explainer @schema)) + + options (c/merge default-options (dissoc options :transformer)) + transformer (or transformer default-transformer) + decoder (delay (m/decoder @schema options transformer)) + encoder (delay (m/encoder @schema options transformer))] (reify m/AST @@ -341,7 +379,17 @@ (-form [_] (m/-form @schema)) - ISchemaOps + ILazySchema + (-get-schema [_] + @schema) + (-get-validator [_] + @validator) + (-get-explainer [_] + @explainer) + (-get-encoder [_] + @encoder) + (-get-decoder [_] + @decoder) (-validate [_ o] (@validator o)) (-explain [_ o] @@ -349,18 +397,6 @@ (-decode [_ o] (@decoder o))))) -;; --- GENERATORS - -;; FIXME: replace with sg/subseq -(defn gen-set-from-choices - [choices] - (->> tgen/nat - (tgen/fmap (fn [i] - (into #{} - (map (fn [_] (rand-nth choices))) - (range i)))))) - - ;; --- BUILTIN SCHEMAS (define! :merge (mu/-merge))