From 002b1679c32bee00561254b0968f589b72e694c3 Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Tue, 8 Oct 2024 10:42:31 +0200
Subject: [PATCH] :recycle: Clean assertion and schema chechking API

---
 backend/src/app/http/websocket.clj            | 21 ++----
 backend/src/app/setup/templates.clj           | 25 +++----
 backend/src/app/srepl/main.clj                | 23 ++++---
 common/src/app/common/data/macros.cljc        | 65 ++++++------------
 common/src/app/common/files/changes.cljc      |  9 +--
 common/src/app/common/schema.cljc             | 67 +++++++------------
 common/src/app/common/svg/shapes_builder.cljc | 33 ++++-----
 common/src/app/common/types/color.cljc        |  2 +-
 common/src/app/common/types/shape.cljc        |  3 +-
 frontend/src/app/main/data/workspace.cljs     | 10 +--
 .../src/app/main/data/workspace/colors.cljs   | 14 ++--
 .../app/main/data/workspace/libraries.cljs    | 53 +++++++++++----
 .../src/app/main/data/workspace/shapes.cljs   |  4 +-
 13 files changed, 161 insertions(+), 168 deletions(-)

diff --git a/backend/src/app/http/websocket.clj b/backend/src/app/http/websocket.clj
index 5ad50b2fe..bac7eecf6 100644
--- a/backend/src/app/http/websocket.clj
+++ b/backend/src/app/http/websocket.clj
@@ -278,25 +278,18 @@
             :inc 1)
   message)
 
-(def ^:private schema:params
-  [:map {:title "params"}
-   [: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
   [cfg {:keys [params ::session/profile-id] :as request}]
-  (let [{:keys [session-id]} (-> params
-                                 decode-params
-                                 validate-params!)]
+  (let [session-id (some-> params :session-id sm/parse-uuid)]
+    (when-not (uuid? session-id)
+      (ex/raise :type :validation
+                :code :missing-session-id
+                :hint "missing or invalid session-id found"))
+
     (cond
       (not profile-id)
       (ex/raise :type :authentication
-                :hint "Authentication required.")
+                :hint "authentication required")
 
       ;; WORKAROUND: we use the adapter specific predicate for
       ;; performance reasons; for now, the ring default impl for
diff --git a/backend/src/app/setup/templates.clj b/backend/src/app/setup/templates.clj
index 7082f4d81..4d3de1032 100644
--- a/backend/src/app/setup/templates.clj
+++ b/backend/src/app/setup/templates.clj
@@ -10,6 +10,7 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.schema :as sm]
    [app.http.client :as http]
@@ -19,26 +20,26 @@
    [datoteka.fs :as fs]
    [integrant.core :as ig]))
 
-(def ^:private
-  schema:template
+(def ^:private schema:template
   [:map {:title "Template"}
    [:id ::sm/word-string]
    [:name ::sm/word-string]
    [:file-uri ::sm/word-string]])
 
-(def ^:private
-  schema:templates
+(def ^:private schema:templates
   [:vector schema:template])
 
+(def check-templates!
+  (sm/check-fn schema:templates
+               :code :invalid-templates
+               :hint "invalid templates"))
+
 (defmethod ig/init-key ::setup/templates
   [_ _]
   (let [templates (-> "app/onboarding.edn" io/resource slurp edn/read-string)
+        templates (check-templates! templates)
         dest      (fs/join fs/*cwd* "builtin-templates")]
 
-    (dm/verify!
-     "expected a valid templates file"
-     (sm/check! schema:templates templates))
-
     (doseq [{:keys [id path] :as template} templates]
       (let [path (or path (fs/join dest id))]
         (if (fs/exists? path)
@@ -58,9 +59,9 @@
         (let [resp (http/req! cfg
                               {:method :get :uri (:file-uri template)}
                               {:response-type :input-stream :sync? true})]
-
-          (dm/verify!
-           "unexpected response found on fetching template"
-           (= 200 (:status resp)))
+          (when-not (= 200 (:status resp))
+            (ex/raise :type :internal
+                      :code :unexpected-status-code
+                      :hint (str "unable to download template, recevied status " (:status resp))))
 
           (io/input-stream (:body resp)))))))
diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj
index 2085205cb..97294927d 100644
--- a/backend/src/app/srepl/main.clj
+++ b/backend/src/app/srepl/main.clj
@@ -155,9 +155,10 @@
 
 (defn enable-team-feature!
   [team-id feature]
-  (dm/verify!
-   "feature should be supported"
-   (contains? cfeat/supported-features feature))
+  (when-not (contains? cfeat/supported-features feature)
+    (ex/raise :type :assertion
+              :code :feature-not-supported
+              :hint (str "feature '" feature "' not supported")))
 
   (let [team-id (h/parse-uuid team-id)]
     (db/tx-run! main/system
@@ -173,9 +174,11 @@
 
 (defn disable-team-feature!
   [team-id feature]
-  (dm/verify!
-   "feature should be supported"
-   (contains? cfeat/supported-features feature))
+
+  (when-not (contains? cfeat/supported-features feature)
+    (ex/raise :type :assertion
+              :code :feature-not-supported
+              :hint (str "feature '" feature "' not supported")))
 
   (let [team-id (h/parse-uuid team-id)]
     (db/tx-run! main/system
@@ -203,9 +206,11 @@
   [{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
                                         :or {code :generic level :info}
                                         :as params}]
-  (dm/verify!
-   ["invalid level %" level]
-   (contains? #{:success :error :info :warning} level))
+
+  (when-not (contains? #{:success :error :info :warning} level)
+    (ex/raise :type :assertion
+              :code :incorrect-level
+              :hint (str "level '" level "' not supported")))
 
   (letfn [(send [dest]
             (l/inf :hint "sending notification" :dest (str dest))
diff --git a/common/src/app/common/data/macros.cljc b/common/src/app/common/data/macros.cljc
index 7740ef362..31a89e61c 100644
--- a/common/src/app/common/data/macros.cljc
+++ b/common/src/app/common/data/macros.cljc
@@ -108,14 +108,6 @@
           `(do ~@body)
           (reverse (partition 2 bindings))))
 
-(defmacro check
-  "Applies a predicate to the value, if result is true, return the
-  value if not, returns nil."
-  [pred-fn value]
-  `(if (~pred-fn ~value)
-     ~value
-     nil))
-
 (defmacro get-prop
   "A macro based, optimized variant of `get` that access the property
   directly on CLJS, on CLJ works as get."
@@ -124,47 +116,32 @@
     (list 'js* (c/str "(~{}?." (str/snake prop) "?? ~{})") obj (list 'cljs.core/get obj prop))
     (list `c/get obj prop)))
 
-(def ^:dynamic *assert-context* nil)
+(defn runtime-assert
+  [hint f]
+  (try
+    (when-not (f)
+      (throw (ex-info hint {:type :assertion
+                            :code :expr-validation
+                            :hint hint})))
+    (catch #?(:clj Throwable :cljs :default) cause
+      (let [data (-> (ex-data cause)
+                     (assoc :type :assertion)
+                     (assoc :code :expr-validation)
+                     (assoc :hint hint))]
+        (throw (ex-info hint data cause))))))
 
 (defmacro assert!
   ([expr]
    `(assert! nil ~expr))
   ([hint expr]
-   (let [hint (cond
-                (vector? hint)
-                `(str/ffmt ~@hint)
+   (let [hint  (cond
+                 (vector? hint)
+                 `(str/ffmt ~@hint)
 
-                (some? hint)
-                hint
+                 (some? hint)
+                 hint
 
-                :else
-                (str "expr assert: " (pr-str expr)))]
+                 :else
+                 (str "expr assert: " (pr-str expr)))]
      (when *assert*
-       `(binding [*assert-context* ~hint]
-          (when-not ~expr
-            (let [hint#   ~hint
-                  params# {:type :assertion
-                           :code :expr-validation
-                           :hint hint#}]
-              (throw (ex-info hint# params#)))))))))
-
-(defmacro verify!
-  ([expr]
-   `(verify! nil ~expr))
-  ([hint expr]
-   (let [hint (cond
-                (vector? hint)
-                `(str/ffmt ~@hint)
-
-                (some? hint)
-                hint
-
-                :else
-                (str "expr assert: " (pr-str expr)))]
-     `(binding [*assert-context* ~hint]
-        (when-not ~expr
-          (let [hint#   ~hint
-                params# {:type :assertion
-                         :code :expr-validation
-                         :hint hint#}]
-            (throw (ex-info hint# params#))))))))
+       `(runtime-assert ~hint (fn [] ~expr))))))
diff --git a/common/src/app/common/files/changes.cljc b/common/src/app/common/files/changes.cljc
index c013433de..33a273121 100644
--- a/common/src/app/common/files/changes.cljc
+++ b/common/src/app/common/files/changes.cljc
@@ -414,10 +414,11 @@
               ;; If object has changed or is new verify is correct
               (when (and (some? shape-new)
                          (not= shape-old shape-new))
-                (dm/verify!
-                 "expected valid shape"
-                 (and (cts/valid-shape? shape-new)
-                      (cts/shape? shape-new))))))]
+                (when-not (and (cts/valid-shape? shape-new)
+                               (cts/shape? shape-new))
+                  (ex/raise :type :assertion
+                            :code :data-validation
+                            :hint "invalid shape found after applying changes")))))]
 
     (->> (into #{} (map :page-id) items)
          (mapcat (fn [page-id]
diff --git a/common/src/app/common/schema.cljc b/common/src/app/common/schema.cljc
index 1f40063d3..c0c933266 100644
--- a/common/src/app/common/schema.cljc
+++ b/common/src/app/common/schema.cljc
@@ -9,7 +9,6 @@
   #?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
   (:require
    [app.common.data :as d]
-   [app.common.data.macros :as dm]
    [app.common.pprint :as pp]
    [app.common.schema.generators :as sg]
    [app.common.schema.openapi :as-alias oapi]
@@ -243,59 +242,35 @@
 (defn- fast-check!
   "A fast path for checking process, assumes the ILazySchema protocol
   implemented on the provided `s` schema. Sould not be used directly."
-  [s value]
+  [s type code hint value]
   (when-not ^boolean (-validate s value)
-    (let [hint    (d/nilv dm/*assert-context* "check error")
-          explain (-explain s value)]
-      (throw (ex-info hint {:type :assertion
-                            :code :data-validation
+    (let [explain (-explain s value)]
+      (throw (ex-info hint {:type type
+                            :code code
                             :hint hint
                             ::explain explain}))))
-  true)
+  value)
 
 (declare ^:private lazy-schema)
 
 (defn check-fn
   "Create a predefined check function"
-  [s]
-  (let [schema (if (lazy-schema? s) s (lazy-schema s))]
-    (partial fast-check! schema)))
+  [s & {:keys [hint type code]}]
+  (let [schema (if (lazy-schema? s) s (lazy-schema s))
+        hint   (or ^boolean hint "check error")
+        type   (or ^boolean type :assertion)
+        code   (or ^boolean code :data-validation)]
+    (partial fast-check! schema type code hint)))
 
 (defn check!
   "A helper intended to be used on assertions for validate/check the
-  schema over provided data. Raises an assertion exception, should be
-  used together with `dm/assert!` or `dm/verify!`."
-  [s value]
-  (let [s (if (lazy-schema? s) s (lazy-schema s))]
-    (fast-check! s value)))
-
-(defn- fast-validate!
-  "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]
-   (when-not ^boolean (-validate s value)
-     (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))))
-   value))
-
-(defn validate-fn
-  "Create a predefined validate function that raises an expception"
-  [s]
-  (let [schema (if (lazy-schema? s) s (lazy-schema s))]
-    (partial fast-validate! schema)))
-
-(defn validate!
-  "A generic validation function for predefined schemas."
-  ([s value] (validate! s value nil))
-  ([s value options]
-   (let [s (if (lazy-schema? s) s (lazy-schema s))]
-     (fast-validate! s value options))))
+  schema over provided data. Raises an assertion exception."
+  [s value & {:keys [hint type code]}]
+  (let [s      (if (lazy-schema? s) s (lazy-schema s))
+        hint   (or ^boolean hint "check error")
+        type   (or ^boolean type :assertion)
+        code   (or ^boolean code :data-validation)]
+    (fast-check! s type code hint value)))
 
 (defn register! [type s]
   (let [s (if (map? s) (m/-simple-schema s) s)]
@@ -1005,6 +980,12 @@
 (def check-email!
   (check-fn ::email))
 
+(def check-uuid!
+  (check-fn ::uuid :hint "expected valid uuid instance"))
+
+(def check-string!
+  (check-fn :string :hint "expected string"))
+
 (def check-coll-of-uuid!
   (check-fn ::coll-of-uuid))
 
diff --git a/common/src/app/common/svg/shapes_builder.cljc b/common/src/app/common/svg/shapes_builder.cljc
index 41f25e1e2..97d738a3b 100644
--- a/common/src/app/common/svg/shapes_builder.cljc
+++ b/common/src/app/common/svg/shapes_builder.cljc
@@ -10,6 +10,7 @@
    [app.common.colors :as clr]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
+   [app.common.exceptions :as ex]
    [app.common.files.helpers :as cfh]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.point :as gpt]
@@ -29,12 +30,12 @@
   {:x 0 :y 0 :width 1 :height 1})
 
 (defn- assert-valid-num [attr num]
-  (dm/verify!
-   ["%1 attribute has invalid value: %2" (d/name attr) num]
-   (and (d/num? num)
-        (<= num max-safe-int)
-        (>= num min-safe-int)))
-
+  (when-not (and (d/num? num)
+                 (<= num max-safe-int)
+                 (>= num min-safe-int))
+    (ex/raise :type :assertion
+              :code :data-validation
+              :hint (str "invalid numeric value for `" attr "`: " num)))
   (cond
     (and (> num 0) (< num 1))    1
     (and (< num 0) (> num -1))  -1
@@ -43,19 +44,21 @@
 (defn- assert-valid-pos-num
   [attr num]
 
-  (dm/verify!
-   ["%1 attribute should be positive" (d/name attr)]
-   (pos? num))
-
+  (when-not (pos? num)
+    (ex/raise :type :assertion
+              :code :data-validation
+              :hint (str "invalid numeric value for `" attr "`: " num " (should be positive)")))
   num)
 
 (defn- assert-valid-blend-mode
   [mode]
-  (let [clean-value (-> mode str/trim str/lower keyword)]
-    (dm/verify!
-     ["%1 is not a valid blend mode" clean-value]
-     (contains? cts/blend-modes clean-value))
-    clean-value))
+  (let [value (-> mode str/trim str/lower keyword)]
+
+    (when-not (contains? cts/blend-modes value)
+      (ex/raise :type :assertion
+                :code :data-validation
+                :hint (str "unexpected blend mode: " value)))
+    value))
 
 (defn- svg-dimensions
   [{:keys [attrs] :as data}]
diff --git a/common/src/app/common/types/color.cljc b/common/src/app/common/types/color.cljc
index ed4def689..fd20b0330 100644
--- a/common/src/app/common/types/color.cljc
+++ b/common/src/app/common/types/color.cljc
@@ -116,7 +116,7 @@
 (sm/register! ::color-attrs schema:color-attrs)
 
 (def check-color!
-  (sm/check-fn schema:color))
+  (sm/check-fn schema:color :hint "expected valid color struct"))
 
 (def check-recent-color!
   (sm/check-fn schema:recent-color))
diff --git a/common/src/app/common/types/shape.cljc b/common/src/app/common/types/shape.cljc
index ebaca95f6..4ede3a641 100644
--- a/common/src/app/common/types/shape.cljc
+++ b/common/src/app/common/types/shape.cljc
@@ -355,7 +355,8 @@
   (sm/check-fn schema:shape-attrs))
 
 (def check-shape!
-  (sm/check-fn schema:shape))
+  (sm/check-fn schema:shape
+               :hint "expected valid shape"))
 
 (def valid-shape?
   (sm/lazy-validator schema:shape))
diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs
index 7978b0138..5afe5eeeb 100644
--- a/frontend/src/app/main/data/workspace.cljs
+++ b/frontend/src/app/main/data/workspace.cljs
@@ -1725,8 +1725,8 @@
    [:images [:set :map]]
    [:position {:optional true} ::gpt/point]])
 
-(def validate-paste-data!
-  (sm/validate-fn schema:paste-data))
+(def paste-data-valid?
+  (sm/lazy-validator schema:paste-data))
 
 (defn- paste-transit
   [{:keys [images] :as pdata}]
@@ -1751,8 +1751,10 @@
         (let [file-id (:current-file-id state)
               features (features/get-team-enabled-features state)]
 
-          (validate-paste-data! pdata {:hint "invalid paste data"
-                                       :code :invalid-paste-data})
+          (when-not (paste-data-valid? pdata)
+            (ex/raise :type :validation
+                      :code :invalid-paste-data
+                      :hibt "invalid paste data found"))
 
           (cfeat/check-paste-features! features (:features pdata))
           (if (= file-id (:file-id pdata))
diff --git a/frontend/src/app/main/data/workspace/colors.cljs b/frontend/src/app/main/data/workspace/colors.cljs
index 06e469e5f..da8053ab9 100644
--- a/frontend/src/app/main/data/workspace/colors.cljs
+++ b/frontend/src/app/main/data/workspace/colors.cljs
@@ -465,16 +465,16 @@
 (defn change-color-in-selected
   [operations new-color old-color]
 
-  (dm/verify!
-   "expected valid change color operations"
+  (dm/assert!
+   "expected valid color operations"
    (check-change-color-operations! operations))
 
-  (dm/verify!
-   "expected a valid color struct for new-color param"
+  (dm/assert!
+   "expected valid color structure"
    (ctc/check-color! new-color))
 
-  (dm/verify!
-   "expected a valid color struct for old-color param"
+  (dm/assert!
+   "expected valid color structure"
    (ctc/check-color! old-color))
 
   (ptk/reify ::change-color-in-selected
@@ -498,7 +498,7 @@
   [color stroke?]
 
   (dm/assert!
-   "should be a valid color"
+   "expected valid color structure"
    (ctc/check-color! color))
 
   (ptk/reify ::apply-color-from-palette
diff --git a/frontend/src/app/main/data/workspace/libraries.cljs b/frontend/src/app/main/data/workspace/libraries.cljs
index 7e6d0f79f..9cdca5929 100644
--- a/frontend/src/app/main/data/workspace/libraries.cljs
+++ b/frontend/src/app/main/data/workspace/libraries.cljs
@@ -193,9 +193,17 @@
 
 (defn rename-color
   [file-id id new-name]
-  (dm/verify! (uuid? file-id))
-  (dm/verify! (uuid? id))
-  (dm/verify! (string? new-name))
+  (dm/assert!
+   "expected valid uuid for `id`"
+   (uuid? id))
+
+  (dm/assert!
+   "expected valid uuid for `file-id`"
+   (uuid? file-id))
+
+  (dm/assert!
+   "expected valid string for `new-name`"
+   (string? new-name))
 
   (ptk/reify ::rename-color
     ptk/WatchEvent
@@ -243,8 +251,15 @@
 
 (defn rename-media
   [id new-name]
-  (dm/verify! (uuid? id))
-  (dm/verify! (string? new-name))
+
+  (dm/assert!
+   "expected valid uuid for `id`"
+   (uuid? id))
+
+  (dm/assert!
+   "expected valid string for `new-name`"
+   (string? new-name))
+
   (ptk/reify ::rename-media
     ptk/WatchEvent
     (watch [it state _]
@@ -261,8 +276,11 @@
             (rx/of (dch/commit-changes changes))))))))
 
 (defn delete-media
-  [{:keys [id] :as params}]
-  (dm/assert! (uuid? id))
+  [{:keys [id]}]
+  (dm/assert!
+   "expected valid uuid for `id`"
+   (uuid? id))
+
   (ptk/reify ::delete-media
     ev/Event
     (-data [_] {:id id})
@@ -435,8 +453,14 @@
 (defn rename-component
   "Rename the component with the given id, in the current file library."
   [id new-name]
-  (dm/verify! (uuid? id))
-  (dm/verify! (string? new-name))
+  (dm/assert!
+   "expected an uuid instance"
+   (uuid? id))
+
+  (dm/assert!
+   "expected string for new-name"
+   (string? new-name))
+
   (ptk/reify ::rename-component
     ptk/WatchEvent
     (watch [it state _]
@@ -487,8 +511,11 @@
 
 (defn delete-component
   "Delete the component with the given id, from the current file library."
-  [{:keys [id] :as params}]
-  (dm/assert! (uuid? id))
+  [{:keys [id]}]
+  (dm/assert!
+   "expected valid uuid for `id`"
+   (uuid? id))
+
   (ptk/reify ::delete-component
     ptk/WatchEvent
     (watch [it state _]
@@ -1129,7 +1156,9 @@
 (defn touch-component
   "Update the modified-at attribute of the component to now"
   [id]
-  (dm/verify! (uuid? id))
+  (dm/assert!
+   "expected valid uuid for `id`"
+   (uuid? id))
   (ptk/reify ::touch-component
     cljs.core/IDeref
     (-deref [_] [id])
diff --git a/frontend/src/app/main/data/workspace/shapes.cljs b/frontend/src/app/main/data/workspace/shapes.cljs
index fecb3f8e0..734d0488c 100644
--- a/frontend/src/app/main/data/workspace/shapes.cljs
+++ b/frontend/src/app/main/data/workspace/shapes.cljs
@@ -98,8 +98,8 @@
    (add-shape shape {}))
   ([shape {:keys [no-select? no-update-layout?]}]
 
-   (dm/verify!
-    "expected a valid shape"
+   (dm/assert!
+    "expected valid shape"
     (cts/check-shape! shape))
 
    (ptk/reify ::add-shape