🚧 WIP Step 13, Track failure causes

AI-assisted-by: muse-spark, GLM-5.3

frontend/test/benches/render_wasm/browser.cljs

@@ -315,19 +315,137 @@
   (when-not (= epoch @owner-epoch*)
     (throw (ex-info "superseded" {::stale true :phase phase}))))
 
+(def ^:private max-cause-depth
+  "How many cause levels the failure cause keeps: the phase wrapper, the
+  WASM-error mapping and the original failure."
+  3)
+
+(def ^:private max-cause-chars
+  "Hard cap for any string in the failure cause, so a hostile value never
+  bloats the bridge payload."
+  500)
+
+(def ^:private unrenderable-value
+  "Fallback for a cause value `pr-str` cannot render."
+  "unrenderable value")
+
+(def ^:private unrenderable-cause-text
+  "Fallback message when a cause level cannot be rendered."
+  "unrenderable cause")
+
+(defn- truncate-cause-str
+  "Truncates `s` to `max-cause-chars` without splitting a surrogate pair.
+  Never throws."
+  [s]
+  (try
+    (let [text (str s)]
+      (if (<= (count text) max-cause-chars)
+        text
+        (let [cut  (subs text 0 max-cause-chars)
+              last (.charCodeAt cut (dec max-cause-chars))]
+          (if (and (>= last 0xD800)
+                   (<= last 0xDBFF)
+                   (let [nxt (.charCodeAt text max-cause-chars)]
+                     (and (>= nxt 0xDC00) (<= nxt 0xDFFF))))
+            (subs cut 0 (dec max-cause-chars))
+            cut))))
+    (catch :default _
+      unrenderable-value)))
+
+(defn- finite-cause-number?
+  "True for numbers the bridge can carry. Mirrors `serializable?`: NaN and
+  infinities travel as truncated strings, never as numbers."
+  [value]
+  (and (number? value)
+       (js/isFinite value)))
+
+(defn- sanitize-cause-value
+  "Keeps plain-data leaves as-is, stringifies anything else with `pr-str`
+  truncation. Never throws."
+  [value]
+  (try
+    (cond
+      (or (nil? value) (boolean? value) (keyword? value))
+      value
+
+      (string? value)
+      (truncate-cause-str value)
+
+      (finite-cause-number? value)
+      value
+
+      :else
+      (truncate-cause-str (pr-str value)))
+    (catch :default _
+      unrenderable-value)))
+
+(defn- describe-cause-level
+  "Plain-data projection of one `ex-cause` link. Keeps `:message` plus the
+  allowlisted WASM details, sanitized. Never throws."
+  [cause]
+  (try
+    (let [message (try (ex-message cause) (catch :default _ nil))
+          data    (try (ex-data cause) (catch :default _ nil))
+          text    (cond
+                    (string? message) message
+                    (string? cause)   cause
+                    (nil? cause)      "unknown failure"
+                    :else             (pr-str cause))
+          out     {:message (sanitize-cause-value text)}]
+      (if (map? data)
+        (reduce (fn [m k]
+                  (if (contains? data k)
+                    (assoc m k (sanitize-cause-value (get data k)))
+                    m))
+                out
+                [:fn :code :type :hint])
+        out))
+    (catch :default _
+      {:message unrenderable-cause-text})))
+
+(defn- describe-cause
+  "Walks at most `max-cause-depth` cause levels, projecting each with
+  `describe-cause-level`. Always returns plain data, never throws."
+  [cause]
+  (try
+    (loop [current cause
+           depth   0
+           acc     []]
+      (if (or (nil? current) (>= depth max-cause-depth))
+        (if (seq acc)
+          acc
+          [{:message "unknown failure"}])
+        (let [level (describe-cause-level current)
+              next  (try (ex-cause current) (catch :default _ nil))]
+          (recur next (inc depth) (conj acc level)))))
+    (catch :default _
+      [{:message unrenderable-cause-text}])))
+
 (defn- terminal-failure
   "Maps a chain rejection to the bridge value. Stale work resolves to the
   stale marker without touching the newer owner; any other failure releases
   the owner when it still owns the realm and resolves to a failure map, so
-  the bridge promise never rejects."
+  the bridge promise never rejects. The top message stays phase-labeled for
+  accounting; the original failure lives under `:cause` as plain data. Only
+  the top-level cause decides staleness."
   [epoch cause fallback-phase]
   (if (stale? cause)
     #js {"status" "stale"}
-    (let [phase (or (:phase (ex-data cause))
-                    fallback-phase
-                    "aborted")]
+    (let [phase   (try (or (:phase (ex-data cause))
+                           fallback-phase
+                           "aborted")
+                       (catch :default _
+                         (or fallback-phase "aborted")))
+          message (try (or (ex-message cause) "unknown failure")
+                       (catch :default _
+                         "unknown failure"))
+          detail  (try (describe-cause cause)
+                       (catch :default _
+                         [{:message unrenderable-cause-text}]))]
       (dispose-if-current! epoch)
-      (fail-data {:phase phase :message (or (ex-message cause) "unknown failure")}))))
+      (fail-data {:phase   phase
+                  :message message
+                  :cause   detail}))))
 
 (defn- build-canvas!
   "Creates the bench canvas with a `width*dpr` backing buffer and an explicit

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

@@ -135,6 +135,15 @@
         (fail! "object is not reachable from the root"
                {:id id})))))
 
+;; Captured-page policy (tickets 02/26; implementation pending): extraction
+;; maps canonical component/detach-shape over every selected-page shape,
+;; without resolving component libraries, then rejects remaining unsupported
+;; references/resources before validation. Warn and record when detachment
+;; changes shapes; do not carry document context or use editor detach flows.
+;; Thus the empty file/libraries below describe a standalone snapshot, not
+;; support for arbitrary component-bearing pages. Move reusable checks to
+;; shared .cljc code for JVM extraction and CLJS loading; do not copy them.
+
 (defn- check-referential-integrity!
   "Run the production referential validation over the reachable graph.
 

frontend/test/frontend_tests/benches/lifecycle_test.cljs

@@ -357,6 +357,23 @@
                        (cleanup)
                        (done)))))))
 
+(defn- assert-wasm-cause
+  "Shared cause assertions for WASM failures through `load-rects`: plain-data
+  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 (some #(= fn-name (:fn %)) cause) "cause names the failing WASM fn")
+  (t/is (some #(and (string? (:message %))
+                    (re-find message-pattern (:message %)))
+              cause)
+        "fake message preserved")
+  (t/is (some #(let [code (:code %)]
+                 (and (some? code)
+                      (re-find #"wasm-critical" (str code))))
+              cause)
+        "WASM code preserved"))
+
 (t/deftest set-browser-failure-releases-registered-context
   (t/async done
     (with-entry-env
@@ -368,6 +385,11 @@
                      (fn [m]
                        (t/is (= "failed" (:status m)))
                        (t/is (= "graphics-init" (:phase m)))
+                       (t/is (= "graphics init failed" (:message m))
+                             "top message stays phase-labeled")
+                       (assert-wasm-cause (:cause m)
+                                          "_set_browser"
+                                          #"fake _set_browser failure")
                        (let [calls (read-calls)]
                          (t/is (= 1 (effect-count calls "register")))
                          (t/is (= 1 (effect-count calls "clean")) "renderer state is released")
@@ -378,6 +400,103 @@
                        (cleanup)
                        (done)))))))
 
+(t/deftest upload-failure-keeps-wasm-cause
+  (t/async done
+    (with-entry-env
+      (fn [cleanup]
+        (unchecked-set js/globalThis "__benchThrowIn" "_set_view")
+        (load-result #js {"seed" 7
+                          "module-url" (factory-url)
+                          "wasm-url" "./fake.wasm"}
+                     (fn [m]
+                       (t/is (= "failed" (:status m)))
+                       (t/is (= "upload" (:phase m)))
+                       (t/is (= "upload failed" (:message m))
+                             "top message stays phase-labeled")
+                       (assert-wasm-cause (:cause m)
+                                          "_set_view"
+                                          #"fake _set_view failure")
+                       (cleanup)
+                       (done)))))))
+
+(t/deftest hostile-cause-renders-plain-data
+  (let [terminate @#'browser/terminal-failure
+        current   @@#'browser/owner-epoch*
+        hostile   (ex-info "boom"
+                           {:fn   (fn [] 1)
+                            :code #js {:evil 1}
+                            :type :wasm-error
+                            :hint (apply str (repeat 1000 "x"))}
+                           (js/Error. "inner boom"))
+        result    (terminate current hostile "aborted")
+        m         (js->clj result :keywordize-keys true)
+        cause     (:cause m)]
+    (t/is (= "failed" (:status m)))
+    (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 (every? (fn [entry]
+                    (every? (fn [[_ v]]
+                              (or (not (string? v)) (<= (count v) 500)))
+                            entry))
+                  cause)
+          "strings truncated to the hard cap")
+    (let [outer (first cause)]
+      (t/is (string? (:fn outer)) "function value stringified")
+      (t/is (string? (:code outer)) "host object value stringified")
+      (t/is (= 500 (count (:hint outer))) "long hint truncated"))
+    (t/is (some #(and (string? (:message %))
+                      (re-find #"inner boom" (:message %)))
+                cause)
+          "inner message preserved"))
+  (t/testing "values pr-str cannot render fall back to plain strings"
+    (let [evil      (js-obj)
+          _         (js/Object.defineProperty
+                     evil "evil"
+                     #js {:enumerable true
+                          :get (fn [] (throw (js/Error. "evil")))})
+          terminate @#'browser/terminal-failure
+          current   @@#'browser/owner-epoch*
+          hostile   (ex-info "evil boom" {:fn evil} (js/Error. "inner"))
+          result    (terminate current hostile "aborted")
+          m         (js->clj result :keywordize-keys true)
+          cause     (:cause m)
+          outer     (first cause)]
+      (t/is (= "failed" (:status m)))
+      (t/is (core/serializable? cause) "throwing value still plain data")
+      (t/is (= "unrenderable value" (:fn outer))
+            "stringification failure falls back")))
+  (t/testing "causes pr-str cannot render fall back to plain strings"
+    (let [evil      (js-obj)
+          _         (js/Object.defineProperty
+                     evil "evil"
+                     #js {:enumerable true
+                          :get (fn [] (throw (js/Error. "evil")))})
+          terminate @#'browser/terminal-failure
+          current   @@#'browser/owner-epoch*
+          result    (terminate current evil "aborted")
+          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 (= "unrenderable cause" (:message (first cause)))
+            "level fallback holds"))))
+
+(t/deftest nested-stale-marker-does-not-resolve-stale
+  (let [terminate @#'browser/terminal-failure
+        current   @@#'browser/owner-epoch*
+        nested    (ex-info "upload failed"
+                           {:phase "upload"}
+                           (ex-info "superseded"
+                                    {:benches.render-wasm.browser/stale true
+                                     :phase "upload"}))
+        result    (terminate current nested "aborted")
+        m         (js->clj result :keywordize-keys true)]
+    (t/is (= "failed" (:status m)) "only the top level decides staleness")
+    (t/is (= "upload" (:phase m)))
+    (t/is (vector? (:cause m)) "cause still rendered")))
+
 (t/deftest overlapping-load-keeps-the-newer-owner
   (t/async done
     (with-entry-env