🚧 WIP Step 15, Use transit to simplify validation

frontend/test/benches/render_wasm/browser.cljs

@@ -355,7 +355,7 @@
       unrenderable-value)))
 
 (defn- finite-cause-number?
-  "True for numbers the bridge can carry. Mirrors `serializable?`: NaN and
+  "True for numbers kept as numbers in failure causes. NaN and
   infinities travel as truncated strings, never as numbers."
   [value]
   (and (number? value)

frontend/test/benches/render_wasm/cases.cljs

@@ -97,7 +97,7 @@
 
 (defn- describe-case
   "Projects a validated case to its collected descriptor: scene
-  version/description/seed attached, internal keys stripped, plain data
+  version/description/seed attached, internal keys stripped, transit wire
   checked."
   [master-seed registered scene-entry]
   (let [projected (-> (core/project-case registered)

frontend/test/benches/render_wasm/scenes/core.cljs

@@ -21,6 +21,7 @@
   returns plain data"
   (:require
    [app.common.schema :as sm]
+   [app.common.transit :as t]
    [clojure.string :as str]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -84,9 +85,8 @@
 
 (def schema:view
   "Camera placement plus optional viewport override. All numbers are finite:
-  unbounded `number?` accepts Infinity, which JSON cannot carry and the
-  renderer cannot use. Bounds come from `::sm/safe-number`, whose min/max
-  also rejects NaN and infinities."
+  unbounded `number?` accepts Infinity, which the renderer cannot use. Bounds
+  come from `::sm/safe-number`, whose min/max also rejects NaN and infinities."
   [:map {:closed true}
    [:scale ::sm/positive-safe-number]
    [:x ::sm/safe-number]
@@ -381,66 +381,22 @@
         seed))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Projection
+;; Descriptor wire
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- finite-number?
-  "True for numbers JSON preserves: rejects NaN and infinities, which
-  `number?` accepts but `JSON.stringify` turns into null."
+(defn transit-round-trips?
+  "True when `value` survives the descriptor wire: transit encode then decode
+  yields an equal value. Namespaced keywords, mixed string/keyword keys and
+  other tagged values survive. Unhandled values (functions, records, most
+  host objects) make the writer throw and fail; NaN fails the equality check.
+
+  ±Infinity survives the wire and is accepted. It can enter through open
+  :params/:operation/:preparation maps or future measurement fields; ticket
+  09 gives non-finite measurements explicit invalid-reason forms."
   [value]
-  (and (number? value)
-       (js/isFinite value)))
-
-(defn serializable?
-  "True when `value` is plain data the runner can hand to the browser and
-  store in results.
-
-  True for nil, booleans, finite numbers, strings, keywords, and vectors, and
-  maps with strings or keyword keys.
-
-  NaN, infinities and non-string map keys fail: JSON does not carry them
-  losslessly.
-
-  Records fail: a record reaches the runner as a host object, not plain data.
-
-  Functions, atoms and host objects fail.
-
-  Keywords are encoded with `encode-id`: the planned `app.common.json` converter
-  renders keyword values by unqualified name, so `:rects/load` would arrive as
-  `\"load\"`."
-  [value]
-  (cond
-    (or (nil? value) (boolean? value) (finite-number? value)
-        (string? value) (keyword? value))
-    true
-
-    (and (map? value) (not (record? value)))
-    (every? (fn [[k v]]
-              (and (or (string? k) (keyword? k))
-                   (serializable? v)))
-            value)
-
-    (vector? value)
-    (every? serializable? value)
-
-    :else
-    false))
-
-(defn encode-id
-  "Lossless JSON-wire encoding of a keyword identity: `:rects/load` becomes
-  `\"rects/load\"`, `:fresh` becomes `\"fresh\"`. `decode-id` inverts it.
-  The runner (ticket 11) applies this pair at the JSON boundary; nothing
-  else may turn identities into bare `name` strings."
-  [id]
-  (when-not (keyword? id)
-    (throw (ex-info (str "wire identities are keywords, got: " (pr-str id))
-                    {:type ::invalid-case :id id})))
-  (subs (str id) 1))
-
-(defn decode-id
-  "Inverts `encode-id`: `\"rects/load\"` becomes `:rects/load`."
-  [s]
-  (keyword s))
+  (try
+    (= value (-> value t/encode-str t/decode-str))
+    (catch :default _ false)))
 
 (defn project-case
   "Plain-data projection of a registered case: internal keys (`:ns`, `:run!`,
@@ -456,16 +412,17 @@
 (defn check-collected-case!
   "Validates a collected case descriptor and returns it unchanged.
 
-  Rejects anything that is not plain data: browser-side run functions must never
-  reach the runner."
+  Rejects anything that fails the schema and anything that does not survive
+  the transit descriptor wire: browser-side run functions must never reach
+  the runner."
   [projected]
   (when-not (sm/validate schema:collected-case projected)
     (throw (ex-info (str "invalid collected case: " (:id projected))
                     {:type ::invalid-case
                      :id (:id projected)
                      ::sm/explain (sm/explain schema:collected-case projected)})))
-  (when-not (serializable? projected)
-    (throw (ex-info (str "collected case is not plain data: " (:id projected))
+  (when-not (transit-round-trips? projected)
+    (throw (ex-info (str "collected case does not survive the transit wire: " (:id projected))
                     {:type ::non-serializable-case
                      :id (:id projected)})))
   projected)

frontend/test/benches/render_wasm/scenes/rects.cljs

@@ -43,8 +43,8 @@
    :max-size 100})
 
 (def ^:private schema:params
-  "Workload parameters. Sizes are finite (`pos?` accepts Infinity, which JSON
-  cannot carry and the generator cannot honor); `:min-size` above `:max-size`
+  "Workload parameters. Sizes are finite (`pos?` accepts Infinity, which the
+  generator cannot honor); `:min-size` above `:max-size`
   is rejected so parameter sweeps cannot silently measure a reversed range."
   [:and
    [:map {:closed true}

frontend/test/frontend_tests/benches/contracts_test.cljs

@@ -7,6 +7,7 @@
 (ns frontend-tests.benches.contracts-test
   (:require
    [app.common.schema :as sm]
+   [app.common.transit :as transit]
    [benches.render-wasm.cases :as cases]
    [benches.render-wasm.scenes.core :as core :include-macros true]
    [cljs.test :as t :include-macros true]))
@@ -83,11 +84,11 @@
   (let [collected (rect-cases)]
     (t/is (= [:rects/load :rects/pan :rects/zoom] (mapv :id collected)))))
 
-(t/deftest collected-cases-are-plain-data
+(t/deftest collected-cases-survive-the-wire
   (doseq [case-desc (rect-cases)]
     (t/is (not (contains? case-desc :run!)) (str (:id case-desc)))
     (t/is (not (contains? case-desc :ns)) (str (:id case-desc)))
-    (t/is (core/serializable? case-desc) (str (:id case-desc)))))
+    (t/is (core/transit-round-trips? case-desc) (str (:id case-desc)))))
 
 (t/deftest rects-cases-carry-declared-view-context-and-completion
   (let [collected (rect-cases)]
@@ -169,20 +170,29 @@
                  (assoc good :viewport {:width js/NaN})]]
       (t/is (false? (sm/validate core/schema:view bad)) (pr-str bad)))))
 
-(t/deftest serializable-rejects-json-lossy-values
-  (t/is (true? (core/serializable? {:id :rects/load :seed 42 :tags ["a" 1]})))
-  (t/is (false? (core/serializable? {:v js/NaN})))
-  (t/is (false? (core/serializable? {:v js/Infinity})))
-  (t/is (false? (core/serializable? {:v js/-Infinity})))
-  (t/is (false? (core/serializable? {[1 2] "k"})))
-  (t/is (false? (core/serializable? {{:a 1} "k"}))))
+(t/deftest transit-rejects-unencodable-values
+  (t/is (false? (core/transit-round-trips? {:v (fn [] 1)})))
+  (t/is (false? (core/transit-round-trips? {:point (->Point 1 2)})))
+  (t/is (false? (core/transit-round-trips? {:v js/NaN}))))
 
-(t/deftest wire-ids-round-trip-through-json
-  (doseq [id [:rects/load :rects :fresh :render-full]]
-    (let [encoded (core/encode-id id)
-          wire    (.stringify js/JSON #js {:id encoded})
-          through (unchecked-get (.parse js/JSON wire) "id")]
-      (t/is (= id (core/decode-id through)) (str id)))))
+(t/deftest transit-wire-preserves-json-lossy-shapes
+  (doseq [value [{:foo 1 "foo" 2}
+                 {:a/b 1 :c/b 2}
+                 {:id :rects/load :scene :rects}
+                 {:tags [:fresh :rects/load]}
+                 {:v js/Infinity}
+                 {:v js/-Infinity}]]
+    (t/is (= value (-> value transit/encode-str transit/decode-str))
+          (pr-str value))))
+
+(t/deftest unencodable-collected-values-are-rejected
+  (let [good (first (rect-cases))]
+    (doseq [bad [(assoc good :operation {:run (fn [] 1)})
+                 (assoc good :operation {:point (->Point 1 2)})
+                 (assoc-in good [:params :count] js/NaN)]]
+      (t/is (= ::core/non-serializable-case
+               (:type (failure-data #(core/check-collected-case! bad))))
+            (pr-str bad)))))
 
 (t/deftest duplicate-scene-id-from-another-namespace-is-rejected
   (t/is (= ::core/duplicate-scene
@@ -341,10 +351,10 @@
       (core/unregister-case! :contracts-incomplete/case)
       (core/unregister-scene! :contracts-incomplete))))
 
-(t/deftest records-are-not-plain-data
+(t/deftest records-do-not-survive-the-wire
   (let [point (->Point 1 2)]
-    (t/is (false? (core/serializable? point)))
-    (t/is (false? (core/serializable? {:point point})))))
+    (t/is (false? (core/transit-round-trips? point)))
+    (t/is (false? (core/transit-round-trips? {:point point})))))
 
 (t/deftest case-replacement-preserves-order-and-unregister-removes
   (try
@@ -396,7 +406,7 @@
     (t/is (= [:contracts-scene/case] (mapv :id collected)))
     (t/is (not (contains? (first collected) :run!)))
     (t/is (not (contains? (first collected) :body-source)))
-    (t/is (core/serializable? (first collected))))
+    (t/is (core/transit-round-trips? (first collected))))
   (t/is (empty? @body-calls))
   (let [entry (core/registered-case :contracts-scene/case)]
     (t/is (= "frontend-tests.benches.contracts-test" (:ns entry)))

frontend/test/frontend_tests/benches/lifecycle_test.cljs

@@ -190,7 +190,12 @@
         context  #js {:getExtension (fn [name]
                                       (when (= name "WEBGL_lose_context")
                                         lose-ext))
-                      :getContextAttributes (fn [] nil)
+                      :getContextAttributes (fn []
+                                              #js {"antialias" false
+                                                   "depth" true
+                                                   "stencil" false
+                                                   "alpha" false
+                                                   "preserveDrawingBuffer" false})
                       :drawingBufferWidth 1234
                       :drawingBufferHeight 5678}]
     #js {:id id
@@ -198,7 +203,6 @@
          :height 0
          :style #js {}
          :getContext (fn [_ _] context)
-         :getContextAttributes (fn [] nil)
          :addEventListener (fn [_ _] nil)
          :remove (fn [] (record! ["remove" id]) nil)}))
 
@@ -346,7 +350,11 @@
                          (t/is (= 1234 (:drawingBufferWidth graphics))
                                "drawing buffer width comes from the context")
                          (t/is (= 5678 (:drawingBufferHeight graphics))
-                               "drawing buffer height comes from the context"))
+                               "drawing buffer height comes from the context")
+                         (t/is (false? (:antialias graphics))
+                               "context attributes pass through")
+                         (t/is (true? (:depth graphics))
+                               "context attributes pass through"))
                        (let [calls (read-calls)]
                          (t/is (= 1 (effect-count calls "create")) "one canvas per load")
                          (t/is (zero? (effect-count calls "remove")) "success keeps the owner live"))
@@ -372,7 +380,7 @@
   vector, wire contract, failing fn name, fake message and WASM code."
   [cause fn-name message-pattern]
   (t/is (vector? cause) "cause is plain-data vector")
-  (t/is (core/serializable? cause) "cause satisfies wire contract")
+  (t/is (core/transit-round-trips? cause) "cause satisfies wire contract")
   (t/is (some #(= fn-name (:fn %)) cause) "cause names the failing WASM fn")
   (t/is (some #(and (string? (:message %))
                     (re-find message-pattern (:message %)))
@@ -445,7 +453,7 @@
     (t/is (= "aborted" (:phase m)))
     (t/is (= "boom" (:message m)) "top message stays as-is")
     (t/is (vector? cause) "cause is plain-data vector")
-    (t/is (core/serializable? cause) "hostile values become strings")
+    (t/is (core/transit-round-trips? cause) "hostile values become strings")
     (t/is (every? (fn [entry]
                     (every? (fn [[_ v]]
                               (or (not (string? v)) (<= (count v) 500)))
@@ -474,7 +482,7 @@
           cause     (:cause m)
           outer     (first cause)]
       (t/is (= "failed" (:status m)))
-      (t/is (core/serializable? cause) "throwing value still plain data")
+      (t/is (core/transit-round-trips? cause) "throwing value still crosses the wire")
       (t/is (= "unrenderable value" (:fn outer))
             "stringification failure falls back")))
   (t/testing "causes pr-str cannot render fall back to plain strings"
@@ -489,7 +497,7 @@
           m         (js->clj result :keywordize-keys true)
           cause     (:cause m)]
       (t/is (= "failed" (:status m)))
-      (t/is (core/serializable? cause) "throwing cause still plain data")
+      (t/is (core/transit-round-trips? cause) "throwing cause still crosses the wire")
       (t/is (= "unrenderable cause" (:message (first cause)))
             "level fallback holds"))))