github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 05:50:35 +00:00
Code Issues Packages Projects Releases Wiki Activity

🚧 WIP Step 16.4 Refactor failures, remove legacy validation, cleanup

Browse Source
This commit is contained in:
Miguel de Benito Delgado 2026-09-30 13:00:47 +02:00
parent a76f225ba2
commit 5ca9e06fa7
6 changed files with 203 additions and 177 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

184
frontend/test/benches/render_wasm/browser.cljs
View File

@ -28,6 +28,7 @@
[app.render-wasm.api.enums]
[app.render-wasm.api.webgl :as webgl]
[benches.render-wasm.cases]
[benches.render-wasm.failures :as fail]
[benches.render-wasm.protocol :as protocol]
[benches.render-wasm.scenes.common :as scenes]
[benches.render-wasm.scenes.core :as core]
@ -127,9 +128,6 @@
(defonce ^:private canvas*
(atom nil))
(defn- fail-data
[m]
(assoc m :status "failed"))
(defn- mark-live!
[]
@ -218,16 +216,17 @@
true))
(defn- render-ok
"Maps one drain result to the bridge value. Success keeps the owner live
for explicit disposal. Failures release the owner only if it still is current
(i.e. it owns the page resources) so a stale failure cannot dispose of
resources belonging to a newer owner."
"Maps one drain result to the bridge value.
Success keeps the owner live for explicit disposal. Failures release the owner
only if it still is current (i.e. it owns the page resources) to avoid
disposing of resources belonging to a newer owner in case of a stale failure."
[epoch module-ms graphics-ms upload-ms alive? drain-result snapshot seed ctx width height dpr renderer]
(if-not alive?
(do
(dispose-if-current! epoch)
(fail-data {:phase "first-render"
:message "disposed or context lost during render"}))
(fail/fail-data {:phase "first-render"
:message "disposed or context lost during render"}))
(assoc drain-result
:status "ok"
:module-init-ms module-ms
@ -295,126 +294,6 @@
;; Public interface
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- stale?
"True when `cause` is the superseded-owner marker from `guard-current!`."
[cause]
(true? (::stale (ex-data cause))))
(defn- guard-current!
"Throws the stale marker when `epoch` no longer owns the realm. Every
async step calls it first with its own phase so the terminal handler can
tell superseded work from genuine failures. The marker lives in `ex-data`,
never in the message: message text is not a protocol."
[epoch phase]
(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 kept as numbers in failure causes. 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
@ -423,7 +302,7 @@
accounting; the original failure lives under `:cause` as plain data. Only
the top-level cause decides staleness."
[epoch cause fallback-phase]
(if (stale? cause)
(if (fail/stale? cause)
{:status "stale"}
(let [phase (try (or (:phase (ex-data cause))
fallback-phase
@ -433,13 +312,22 @@
message (try (or (ex-message cause) "unknown failure")
(catch :default _
"unknown failure"))
detail (try (describe-cause cause)
detail (try (fail/describe-cause cause)
(catch :default _
[{:message unrenderable-cause-text}]))]
[{:message fail/unrenderable-cause-text}]))]
(dispose-if-current! epoch)
(fail-data {:phase phase
:message message
:cause detail}))))
(fail/fail-data {:phase phase
:message message
:cause detail}))))
(defn- guard-current!
"Throws the stale marker when `epoch` no longer owns the realm. Every
async step calls it first with its own phase so the terminal handler can
tell superseded work from genuine failures. The marker lives in `ex-data`,
never in the message: message text is not a protocol."
[epoch phase]
(when-not (= epoch @owner-epoch*)
(throw (ex-info "superseded" {::fail/stale true :phase phase}))))
(defn- build-canvas!
"Creates the bench canvas with a `width*dpr` backing buffer and an explicit
@ -459,8 +347,8 @@
(if-not alive?
(do
(dispose-if-current! epoch)
(fail-data {:phase "interact"
:message "disposed or context lost during interaction"}))
(fail/fail-data {:phase "interact"
:message "disposed or context lost during interaction"}))
(merge interaction
{:status "ok"
:module-init-ms module-ms
@ -517,8 +405,8 @@
(try
(let [params (t/decode-str request)]
(if-not (sm/validate schema:load-scene-args params)
{:error (fail-data {:phase "invalid-args"
:message "load-scene needs a Transit request with seed and case"})}
{:error (fail/fail-data {:phase "invalid-args"
:message "load-scene needs a Transit request with seed and case"})}
(let [case-desc (:case params)
scene (core/registered-scene (:scene case-desc))]
(when (nil? scene)
@ -528,9 +416,9 @@
:case-desc (core/check-collected-case case-desc)
:scene scene})))
(catch :default cause
{:error (fail-data {:phase "invalid-args"
:message (or (ex-message cause)
"invalid Transit request")})})))
{:error (fail/fail-data {:phase "invalid-args"
:message (or (ex-message cause)
"invalid Transit request")})})))
(defn- begin-load!
"Claims the page, releases the prior owner, then fixes this attempt's
@ -616,7 +504,7 @@
:snapshot snapshot
:ordered (upload/prepare-scene snapshot)))
(catch :default cause
(if (stale? cause)
(if (fail/stale? cause)
(throw cause)
(throw (ex-info "scene build failed"
{:phase "scene-build"}
@ -646,7 +534,7 @@
(h/call wasm/internal-module "_set_view_end")
(assoc graphics :upload-ms (- (now) u0) :view view))
(catch :default cause
(if (stale? cause)
(if (fail/stale? cause)
(throw cause)
(throw (ex-info "upload failed"
{:phase "upload"}
@ -690,16 +578,16 @@
(terminal-failure epoch cause "aborted")))))))
(catch :default cause
(js/Promise.resolve
(fail-data {:phase "setup" :message (ex-message cause)}))))]
(fail/fail-data {:phase "setup" :message (ex-message cause)}))))]
(-> result
(.then t/encode-str)
(.catch (fn [cause]
(when-some [epoch @epoch*]
(dispose-if-current! epoch))
(t/encode-str
(fail-data {:phase "bridge"
:message (or (ex-message cause)
"result encoding failed")})))))))
(fail/fail-data {:phase "bridge"
:message (or (ex-message cause)
"result encoding failed")})))))))
(defn ping
"Bridge placeholder that checks the Node/browser boundary."

118
frontend/test/benches/render_wasm/failures.cljs Normal file
View File

@ -0,0 +1,118 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.failures
"Helpers for browser failures.")
(def ^:const max-cause-depth
"How many cause levels the failure cause keeps: the phase wrapper, the
WASM-error mapping and the original failure."
3)
(def ^:const max-cause-chars
"Hard cap for any string in the failure cause, to avoid bloating the bridge
payload."
500)
(def ^:const unrenderable-value
"Fallback for a cause value `pr-str` cannot render."
"unrenderable value")
(def ^:const unrenderable-cause-text
"Fallback message when a cause level cannot be rendered."
"unrenderable cause")
(defn stale?
"True when `cause` is the superseded-owner marker from `guard-current!`."
[cause]
(true? (::stale (ex-data cause))))
(defn fail-data
[m]
(assoc m :status "failed"))
(defn- truncate-cause-str
"Truncates `s` to `max-cause-chars` without splitting a unicode surrogate pair.
Never throws."
[s]
(try
(let [text (str s)]
(if (<= (count text) max-cause-chars)
text
;; check whether truncating the string at max-cause-chars would split a
;; Unicode character represented by a surrogate pair (e.g. some emoji)
(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- sanitize-cause-value
"Keeps Transit numbers and other 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)
(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}])))

26
frontend/test/benches/render_wasm/scenes/builder.cljs
View File

@ -5,30 +5,30 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns benches.render-wasm.scenes.builder
"Scoped construction for renderer benchmark scenes.
"Construction of benchmark scenes.
A scene scope owns one seeded generator, one object map, and one label
map. Shape constructors add themselves to the current parent: `rect`,
`circle`, and the `frame`/`group`/`bool` container scopes. The scope
returns a validated snapshot in the ticket02 contract
`{:objects ... :refs ...}`.
A `scene` consists of one seeded generator, one object map, and one label
map.
Ancestry and order are implicit in the nesting of calls: shape constructors
add themselves to the current parent, in the sequence they are called.
Construction is synchronous by design: the scope and the current parent
are carried by dynamic vars, so `let`, `doseq` and functions defined
outside the scope all work inside a scene. Scene scopes cannot nest
and body exceptions unwind without leaving state behind. A container whose
body throws is marked unfinished and `finish!` rejects the instance, so a
caught exception cannot silently produce a half-built scene.
caught exception cannot produce a half-built scene.
Defaults follow the same theme: `*defaults*` maps a shape type to an
attribute generator map, bound by the `scene` macro from the scope
Default attributes follow the same theme: `*defaults*` maps a shape type to
an attribute generator map, bound by the `scene` macro from the scope
params. Per-shape attrs are merged over the generated values, so a recipe
can override anything locally and rebind `*defaults*` around a section.
Coordinates stay page-absolute: nesting supplies ownership and order, not
translation. Frames keep authored bounds; groups derive bounds from their
children inside out; a masked group takes the geometry of its first child.
Booleans derive content and geometry from their children with the canonical
Coordinates are page-absolute like in penpot. Frames use their state bounds
and groups derive their bounds from their children inside out.
A masked group takes the geometry of its first child.
Booleans derive content and geometry from their children with the standard
path engine and inherit style from the head child unless attrs supply it.
Masked groups and the frame/group/bool scopes live here; paths ticket07/08."

14
frontend/test/benches/render_wasm/scenes/core.cljs
View File

@ -341,17 +341,13 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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."
"True when `value` survives Transit encoding and decoding without changing
its wire representation. This permits NaN and infinities while still
rejecting values that Transit cannot encode."
[value]
(try
(= value (-> value t/encode-str t/decode-str))
(let [encoded (t/encode-str value)]
(= encoded (-> encoded t/decode-str t/encode-str)))
(catch :default _ false)))
(defn project-case

17
frontend/test/frontend_tests/benches/contracts_test.cljs
View File

@ -171,8 +171,7 @@
(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/is (false? (core/transit-round-trips? {:point (->Point 1 2)}))))
(t/deftest transit-wire-preserves-json-lossy-shapes
(doseq [value [{:foo 1 "foo" 2}
@ -184,11 +183,21 @@
(t/is (= value (-> value transit/encode-str transit/decode-str))
(pr-str value))))
(t/deftest transit-wire-preserves-non-finite-numbers
(let [value {:nan js/NaN :positive js/Infinity :negative js/-Infinity}
decoded (-> value transit/encode-str transit/decode-str)
case-desc (assoc (first (rect-cases)) :operation value)]
(t/is (number? (:nan decoded)))
(t/is (js/Number.isNaN (:nan decoded)))
(t/is (= js/Infinity (:positive decoded)))
(t/is (= js/-Infinity (:negative decoded)))
(t/is (core/transit-round-trips? value))
(t/is (nil? (failure-data #(core/check-collected-case case-desc))))))
(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)]]
(assoc good :operation {:point (->Point 1 2)})]]
(t/is (= ::core/non-serializable-case
(:type (failure-data #(core/check-collected-case bad))))
(pr-str bad)))))

21
frontend/test/frontend_tests/benches/lifecycle_test.cljs
View File

@ -148,13 +148,13 @@
nil
(catch :default cause
cause))]
(t/is (true? (:benches.render-wasm.browser/stale (ex-data thrown)))
(t/is (true? (:benches.render-wasm.failures/stale (ex-data thrown)))
"the marker lives in ex-data, never in message text")))
(t/testing "terminal stale resolves without disposal"
(let [before @@#'browser/owner-epoch*
result (terminate epoch
(ex-info "superseded"
{:benches.render-wasm.browser/stale true
{:benches.render-wasm.failures/stale true
:phase "upload"})
"upload")
after @@#'browser/owner-epoch*]
@ -556,13 +556,28 @@
(t/is (= "unrenderable cause" (:message (first cause)))
"level fallback holds"))))
(t/deftest non-finite-failure-details-cross-transit-as-numbers
(let [terminate @#'browser/terminal-failure
current @@#'browser/owner-epoch*
failure (ex-info "bad measurement"
{:code js/NaN
:hint js/Infinity
:type js/-Infinity})
result (terminate current failure "aborted")
decoded (-> result transit/encode-str transit/decode-str)
detail (first (:cause decoded))]
(t/is (number? (:code detail)))
(t/is (js/Number.isNaN (:code detail)))
(t/is (= js/Infinity (:hint detail)))
(t/is (= js/-Infinity (:type detail)))))
(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
{:benches.render-wasm.failures/stale true
:phase "upload"}))
result (terminate current nested "aborted")
m result]