github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-09-23 20:36:15 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Retry transient saves with backoff and reconnect notice

Browse Source 
Classify save failures as transient or terminal (`transient-error?`
over the repo retryable types plus `:invalid-save-response`).
Transient failures keep the head commit queued under a new `:retrying`
status and resend it with backoff (2s/8s/20s, then terminal):
stamp rotation reuses the same `:commit-id`, the in-flight guard
prevents double-sends, and episode tokens silence stale timers.
One tagged reconnect notice per episode (hidden on save and on
terminal failure, silent recovery) plus a `:retrying` save-indicator
state; the browser `online` event and new edits resume the episode.
Terminal failures keep the exact `:error` path. Covers tasks 4, 6
and 7 with 31 persistence tests; updates the persistence memory.

Relates to #11724

AI-assisted-by: muse-spark-1.3-contributor
This commit is contained in:
Andrey Antukh 2026-09-17 19:27:20 +02:00
parent 95e551697f
commit 34b24a9d9d
19 changed files with 2534 additions and 1127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
.serena/memories/clojure/idioms.md
View File

@ -1,10 +1,10 @@
# Clojure Idioms (verified)
Behaviors confirmed against the language/stdlib — do not re-derive from
assumption; a wrong assumption here already cost a review round.
Behaviors confirmed against the language/stdlib — do not re-derive from assumption; a wrong assumption here already cost a review round.
- `int?` is NOT 32-bit-only: true for `Long`, `Integer`, `Short`,
`Byte` (fixed-precision integers). Clojure integer literals are
`Long`, so `(int? 5000)` is true.
- `integer?` is the general integer predicate; prefer it when any
integer kind must match, `int?` only when fixed precision is meant.
- `int?` is NOT 32-bit-only: true for `Long`, `Integer`, `Short`, `Byte` (fixed-precision integers). Clojure integer literals are `Long`, so `(int? 5000)` is true.
- `integer?` is the general integer predicate; prefer it when any integer kind must match, `int?` only when fixed precision is meant.
- `await` is a `cljs.core` macro asserting `(:async &env)`: it fails at compile time outside an `^:async` context, never silently.
- The analyzer reads `:async` only from the fn name meta and the `fn` operator meta; list-level meta is ignored (would make a MetaFn). `(fn ^:async [] …)` puts the meta on argv (pre/post only, NOT async).
- Valid: `(defn ^:async f)`, `(defn- ^:async f)`, `(^:async fn [] …)` (the latter is what stock `t/async` generates itself).
- `^:async` fns never throw synchronously (rejected promises instead); `try/catch/finally` supported; continuations are microtasks, timers and RxJS schedulers are macrotasks (FIFO).

2
.serena/memories/frontend/routing-app-shell-subtleties.md
View File

@ -12,7 +12,7 @@
- `app.main.errors/submit-report` is governed by a dedup governor: each report carries a fingerprint (`report-name|type|code|hint|first stack frame`; the report name is part of it so a handled report never coalesces with an unhandled/exception-page one), the first occurrence is always emitted, repeats within 2 minutes are counted and included in the next emitted report as `:occurrences`, and the fingerprint cache is bounded (first-inserted entry evicted, FIFO, via `:order` queue) so memory stays fixed. It applies to `handled-exception`, `unhandled-exception` and `exception-page`; a report without an exception cause is ignored and does not consume a reservation.
- Errors caused by the environment (`environment-error-types`: `:network`, `:offline`, `:bad-gateway`, `:service-unavailable`, `:nitrate-unavailable`, `:nitrate-not-configured`) are not application defects: they are reported as audit-only `handled-exception` (never `unhandled-exception`/`exception-page`, so they skip internal reports and alerts), with a compact report and a fingerprint that drops the stack frame. `:offline` has its own handler and no longer falls through to `:default`; `:network`/`:offline` show the `errors.connection-error` toast.
- `generate-report` accepts an explicit `{:format :compact|:full}` (default `:full`) chosen by its caller (`flash`, `exception-section*`): `:compact` keeps the context header plus type/code/uri, and skips the stack, the `ex-data` dump and the last-events list. It is total: if formatting fails it returns a minimal fallback string instead of nil, so an already reserved emission is never dropped.
- `flash` reserves the report before generating it, so suppressed occurrences do not pay the `generate-report` cost; the toast is unchanged. `flash` derives only the payload format from the cause (`environment-error?` → `:compact`); the audit event name is the canonical one requested by `:type` (`handled-exception`/`unhandled-exception`) and is never reclassified, because external tools filter on those names. `exception-section*` picks `handled-exception`/`exception-page` explicitly per cause; `flash-persistence` only adds the toast hint.
- `flash` runs its whole body (report pipeline first, toast after) inside a single `ts/schedule` callback: nothing executes synchronously on the error handler's stack. The report is reserved before being generated, so suppressed occurrences do not pay the `generate-report` cost; a reporting or notification failure is logged to the console and never propagates, and the toast is still attempted. `flash` returns a total promise (never rejects) resolving with the generated report, or nil when nothing is emitted, once the callback completes; production callers ignore it, tests await it. `flash` derives only the payload format from the cause (`environment-error?` → `:compact`); the audit event name is the canonical one requested by `:type` (`handled-exception`/`unhandled-exception`) and is never reclassified, because external tools filter on those names. `exception-section*` picks `handled-exception`/`exception-page` explicitly per cause; `flash-persistence` only adds the toast hint.
## Store and websocket

34
.serena/memories/frontend/testing.md
View File

@ -6,7 +6,39 @@ Frontend validation: CLJS + React/Rumext + RxJS/Potok; SCSS modules; shared CLJC
READ `mem:testing` FIRST — it defines the execution discipline (no piping, tee to file, preferred commands) that applies to all CLJS/JS test runs.
Frontend unit tests live under `frontend/test/frontend_tests/` and use `cljs.test`. They should be deterministic, avoid DOM/UI integration where possible, and mock side effects such as RPC, storage, timers, or network access. Mock through `frontend-tests.helpers.mock`: prefer `mock/with-mocks` (installs with `set!`, so it survives async boundaries) over `with-redefs`. The `:esm` test build dispatches calls to multi-arity vars as `cljs$core$IFn$_invoke$arity$N`, so stub multi-arity vars with `mock/stub` (arities 0-6); for variadic call sites with more than 6 args use a plain variadic `fn` instead. A mock must not call the mocked var again (self-delegation inside a multi-arity function recurses). Async tests wrap the body in `t/async` and thread its `done` into `mock/with-mocks` as the outer callback; `done'` must be called exactly once (calling it twice only prints a warning; not calling it stalls the run and leaks the mocks).
Frontend unit tests live under `frontend/test/frontend_tests/` and use `cljs.test`. They should be deterministic, avoid DOM/UI integration where possible, and mock side effects such as RPC, storage, timers, or network access.
### Async-first stance
Frontend testing is async-first: everything essentially asynchronous is modeled with a test reproducing the asynchrony, even when the test could be written "synchronously". Sync-passing tests prove nothing about async behavior and rot as soon as an async boundary appears downstream. Consequences: mock through `frontend-tests.helpers.mock`, never `with-redefs`, except unit tests of purely synchronous functions; transport doubles deliver asynchronously (`observe-on :async`) while the test keeps scenario timing (explicit pushes); assertions always follow quiescence (`wait-for` on presence, bare `settle` tick for absence-only blocks), never a trigger.
### Primitives
- `mock/with-mocks` (callback style, legacy compat): installs with `set!` so mocks survive async boundaries; bodies run deferred past the current tick via `asap`, so only done-chained (`t/async`) contexts are allowed; `done'` restores and completes exactly once (twice only warns; never calling it stalls the run and leaks the mocks). Prefer `mock/with-mocks*` for new tests.
- `mock/with-mocks*` (direction): body forms wrapped in a generated `^:async` fn, evaluates to a promise — `await` it, `await` nested scopes too, no `done` in test code. Rejections and non-promise returns report as `:error` via `run-mocked`.
- `mock/stub` wraps fns for arities 0-6 (the `:esm` test build dispatches multi-arity vars as `cljs$core$IFn$_invoke$arity$N`); when the mocked var is variadic-defined (or called with more than 6 args), the call compiles to variadic dispatch, so use a plain variadic `fn` — the stub does not forward variadic. A mock must not call the mocked var again (self-delegation inside a multi-arity function recurses).
- Helpers in `frontend-tests.helpers.async`: `->promise` (single-value observable → promise; beicon has no `to-promise`), `await-response` (subscribe→push→await, atomic), `settle`, `wait-for` (immediate check + bounded poll, fails instead of hanging), `observe` (stream → termination promise; asserts provided, timeout rejects).
- Fixtures return promises (`with-watchdog`, `with-persistence`); `await` them from `^:async` tests. `main_errors` and `fonts` are fully migrated (no legacy `with-mocks` left).
- Valid `^:async` placements: `mem:clojure/idioms`.
### Observing event streams
To assert over emitted event sequences, observe termination: subscribe through `observe` (async delivery forced even for sync sources), `await` its promise, then assert the collected values. Never branch on nil (`when-let` skipping observation lets setup bugs pass as "empty"): producers answer refusals with empty streams, never nil, so every path subscribes uniformly. Observed termination is exact quiescence — no manual `settle` after it. Errors reject unless `:on-error` handles them.
### Runner and library facts (verified: CLJS 1.12.145, beicon2 `df7058a`)
- `cljs.test` keeps its env in a `set!` var: assertions inside deferred ticks count. `run-block`: double `done` only warns; missing `done` stalls.
- `t/async` discards the body promise — completion signals ONLY via `done`. `t/deftest ^:async` adds auto async-context + auto `done`, but awaiting stays the author's job; without it the test passes empty.
- `take 1` is per-subscription on a hot subject: subscribe-before-push or hang. `end!`/`.error` with pending takes only forwards valueless completion.
### Traps that bit
- `^:async` tests require map-style fixtures (`(t/use-fixtures :each {:before f})`): function-style fixtures abort the whole run ("Async tests require fixtures to be specified as maps").
- `st/emit!` doubles collect heterogeneous events: audit `DataEvent`s deref, toast reify-objects do not — discriminate with `ptk/type` (total, never throws), never blind `deref`.
- Subscription order decides delivery order: never resolve settlement from a pre-subscribed branch racing the pipeline.
- Auto-answering mocks lose deadline expressiveness (can't time answers), need teardown timer-cancellation, and post-teardown deliveries hit real implementations — explicit pushes + async delivery + `wait-for` won on every axis.
- Teardown belongs to the terminal continuation, never to `finally`-around-triggers (it would dispose in-flight flows).
- A body that awaits must be `(^:async fn …)` even if the rest is sync; sync sequences are atomic vs the event loop.
From `frontend/`:
- Full unit test run (always builds, suppressed output): `pnpm run test:quiet`.

4
.serena/memories/frontend/workspace-state-persistence-subtleties.md
View File

@ -22,6 +22,10 @@
- Persistence buffers local commits: status becomes pending after about 200ms, commits are flushed after about 3s or `::force-persist`, and buffered commits are merged per file before `:update-file`.
- Persistence sends revn as the max of the commit revn and locally tracked latest revn; remote commits update that revn tracker.
- Persistence is skipped in version preview/read-only mode or without edit permission.
- Save failures split transient vs terminal (`transient-error?`: the repo retryable types `:network`/`:offline`/`:bad-gateway`/`:service-unavailable` plus `:invalid-save-response`; everything else is terminal). Terminal keeps the `:error` halt + `flash-persistence` path; transient enters a `:retrying` episode: the head commit stays queued and resends with backoff 2s/8s/20s (3 retries, then today's terminal path). Resends rotate the `::request-id` stamp only when the old request left `active-requests`, carry the same `:commit-id`, and never double-send while one request is in flight (`:in-flight` stays silent). Retry timers carry the episode token; a superseded token stays silent. Status stays `:retrying` through re-entries (`next-status` refuses `:pending`/`:saving` from it); waiters (`wait-persisted-or-error`) wait through it and reject only on `:error`.
- One reconnect notice per episode: sticky toast tagged `:persistence-reconnecting` (single-toast store, re-show replaces), hidden by tag on drain (`:saved`) and on terminal failure; recovery is silent. Header indicator has a `:retrying` state (`workspace.header.retrying`).
- Resume triggers: backoff timer, the browser `online` event (guarded by `exists? js/window`; re-enters the runner only for a live `:retrying` episode), and new local edits (`append-commit` re-enters the runner during `:retrying`; the emission retires the stuck runner via its stopper).
- Tests instant-trigger retries by stubbing `rx/timer` (recording delays to assert the schedule); dynamic bindings do not survive `await` continuations, so no dynamic var for delays.
- Undo transactions can stay open only temporarily; timed-out pending transactions are force-committed after about 20s. Undo entries are capped at 50.
- Undo/redo are ignored while a normal editor/drawing interaction is active, except grid-layout edition handles undo through this path.
- After local commits and when render-wasm is active, text shapes get derived `:position-data` recomputed in a separate commit tagged `#{:position-data}`; that tag is excluded from the position-data watcher to avoid loops.

42
frontend/src/app/main/data/changes.cljs
View File

@ -247,22 +247,26 @@
;; Historical previews must not create edits to the live file. Check
;; this when creating commits so previously queued edits can still save.
(when (and (:can-edit permissions)
(not (dm/get-in state [:workspace-global :preview-id])))
(log/trace :hint "commit-changes" :redo-changes redo-changes)
(let [selected (dm/get-in state [:workspace-local :selected])]
(rx/of (-> params
(assoc :undo-group undo-group)
(assoc :features features)
(assoc :tags tags)
(assoc :stack-undo? stack-undo?)
(assoc :save-undo? save-undo?)
(assoc :file-id file-id)
(assoc :file-revn (resolve-file-revn state file-id))
(assoc :file-vern (resolve-file-vern state file-id))
(assoc :undo-changes uchg)
(assoc :redo-changes rchg)
(assoc :selected-before selected)
(assoc :translation? translation?)
(assoc :skip-component-sync? skip-component-sync?)
(commit)))))))))
;; Refusals answer with an empty stream (never nil) so callers can
;; uniformly subscribe and observe termination.
(if (and (:can-edit permissions)
(not (dm/get-in state [:workspace-global :preview-id])))
(do
(log/trace :hint "commit-changes" :redo-changes redo-changes)
(let [selected (dm/get-in state [:workspace-local :selected])]
(rx/of (-> params
(assoc :undo-group undo-group)
(assoc :features features)
(assoc :tags tags)
(assoc :stack-undo? stack-undo?)
(assoc :save-undo? save-undo?)
(assoc :file-id file-id)
(assoc :file-revn (resolve-file-revn state file-id))
(assoc :file-vern (resolve-file-vern state file-id))
(assoc :undo-changes uchg)
(assoc :redo-changes rchg)
(assoc :selected-before selected)
(assoc :translation? translation?)
(assoc :skip-component-sync? skip-component-sync?)
(commit)))))
(rx/empty))))))

232
frontend/src/app/main/data/persistence.cljs
View File

@ -8,20 +8,24 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as log]
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.main.data.changes :as dch]
[app.main.data.common :as-alias dc]
[app.main.data.helpers :as dsh]
[app.main.data.notifications :as ntf]
[app.main.data.workspace :as-alias dw]
[app.main.errors :as errors]
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.util.i18n :refer [tr]]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
(declare ^:private run-persistence-task)
(declare ^:private persist-commit)
(log/set-level! :warn)
@ -35,6 +39,16 @@
(def ^:private saving-check-interval-ms 30000)
(def ^:private save-wait-timeout-ms (* 2 60 1000))
(defn terminal-status?
"True when a persistence snapshot releases waiters: a failed save, or
a settled (`nil` / `:saved`) empty queue. Anything else — `:pending`,
`:saving` and the `:retrying` episode — keeps waiting."
[{:keys [status queue]}]
(boolean
(or (= status :error)
(and (empty? queue)
(or (nil? status) (= status :saved))))))
(defn wait-persisted-or-error
"Returns an observable that emits the first terminal persistence status
(nil | :saved) and completes. Raises when the queue has failed and, with
@ -42,10 +56,7 @@
([] (wait-persisted-or-error save-wait-timeout-ms))
([timeout-ms]
(let [base (->> (rx/from-atom refs/persistence {:emit-current-value? true})
(rx/filter (fn [{:keys [status queue]}]
(or (= status :error)
(and (empty? queue)
(or (nil? status) (= status :saved))))))
(rx/filter terminal-status?)
(rx/take 1)
(rx/mapcat (fn [{:keys [status error]}]
(if (= status :error)
@ -74,12 +85,15 @@
(rx/concat (rx/of ::force-persist) (wait-persisted timeout-ms))))
(defn- next-status
"Refuses downgrades: a save in progress stays :saving, and a failed save
stays :error until persistence is resumed."
"Refuses downgrades: a save in progress stays :saving, a failed save
stays :error until persistence is resumed, and a retrying episode stays
:retrying until it saves or errors (re-entries send under the episode
instead of resetting it)."
[from to]
(cond
(and (= to :pending) (= from :saving)) from
(and (= from :error) (#{:pending :saving} to)) from
(and (= from :retrying) (#{:pending :saving} to)) from
:else to))
(defn- update-status
@ -98,14 +112,39 @@
(update :last-progress-at d/nilv (inst-ms (ct/now)))
(#{:error :saved} status)
(dissoc :run-id :last-progress-at :stall-reported?))))))))
(dissoc :run-id :last-progress-at :stall-reported))))))))
(defn transient-error?
"True when a save failure is worth retrying with backoff: a transient
transport failure (from the shared `repo/retryable-types` set, which says
nothing about the edits themselves) or an unusable save response.
Everything else (auth, validation, state) is terminal and keeps the
`:error` path. Checked against both `:type` and `:cause-type` because
`persistence-failed` wraps the original cause under `:type :persistence`."
[{:keys [type cause-type code]}]
(boolean
(or (contains? rp/retryable-types type)
(contains? rp/retryable-types cause-type)
(= :invalid-save-response code))))
(def ^:private retry-delays-ms
"Backoff delays (ms) between save retries; the count is the retry budget.
A plain value (not a dynamic var): dynamic bindings do not survive `await`
continuations, so tests instant-trigger retries by stubbing `rx/timer`."
[2000 8000 20000])
(def ^:private reconnecting-tag
"Tag of the single reconnect notice: re-showing replaces it by
construction (the store holds one toast), and it is hidden by tag on
save or on terminal failure."
:persistence-reconnecting)
(defn- report-stalled-persistence
[now]
(ptk/reify ::report-stalled-persistence
ptk/UpdateEvent
(update [_ state]
(assoc-in state [:persistence :stall-reported?] true))
(assoc-in state [:persistence :stall-reported] true))
ptk/EffectEvent
(effect [_ state _]
@ -113,8 +152,8 @@
commit-id (peek queue)
commit (get index commit-id)
hint "File saving has made no progress for more than five minutes"
cause (ex-info hint
{:type :persistence
cause (ex/error :type :persistence
:hint hint
:code :saving-stalled
:file-id (or (:file-id commit) (:current-file-id state))
:commit-id commit-id
@ -123,12 +162,12 @@
:queued-commits (count queue)
:elapsed-ms (- now last-progress-at)
:can-edit (dm/get-in state [:permissions :can-edit])
:read-only? (dm/get-in state [:workspace-global :read-only?])
:read-only (dm/get-in state [:workspace-global :read-only?])
:preview-id (dm/get-in state [:workspace-global :preview-id])
:render-context-lost? (dm/get-in state [:render-state :lost])})]
:render-context-lost? (dm/get-in state [:render-state :lost]))]
(errors/submit-report :event-name "handled-exception"
:hint hint
:report (errors/generate-report cause)
:report (fn [] (errors/generate-report cause))
:cause cause)))))
(defn- check-persistence
@ -136,11 +175,12 @@
(ptk/reify ::check-persistence
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [status last-progress-at stall-reported?]} (:persistence state)
(let [{:keys [status queue last-progress-at stall-reported]} (:persistence state)
now (inst-ms (ct/now))]
(when (and (#{:pending :saving} status)
(when (and (#{:pending :saving :retrying} status)
(seq queue)
last-progress-at
(not stall-reported?)
(not stall-reported)
(> (- now last-progress-at) saving-stall-timeout-ms))
(rx/of (report-stalled-persistence now)))))))
@ -169,7 +209,8 @@
(throw (ex-info "invalid state" {})))))
(update :index dissoc commit-id)
(assoc :last-progress-at (inst-ms (ct/now)))
(dissoc :stall-reported?)))))))
(dissoc :stall-reported
:attempts :retry-token :retry-for)))))))
(defn- append-commit
"Event used internally to append the current change to the
@ -191,8 +232,14 @@
ptk/WatchEvent
(watch [_ state _]
(let [pstate (:persistence state)]
;; A new edit during `:retrying` re-enters the runner even though
;; the run id no longer matches: the previous runner is stuck
;; behind the failed head, and the emission itself retires it
;; through its stopper. Concurrent re-entries collapse to a
;; single send via the in-flight guard in `attempt-state`.
(when (and (not= :error (:status pstate))
(= run-id (:run-id pstate)))
(or (= run-id (:run-id pstate))
(= :retrying (:status pstate))))
(rx/of (update-status :saving)
(run-persistence-task))))))))
@ -213,11 +260,15 @@
:commit-id commit-id
:hint (ex-message cause)
::errors/handled? true))
(dissoc :run-id :last-progress-at :stall-reported?))))))
(dissoc :run-id :last-progress-at :stall-reported
:attempts :retry-token :retry-for))))))
ptk/WatchEvent
(watch [_ _ _]
(rx/of (ptk/data-event ::error cause)))
;; The terminal toast supersedes the reconnect notice; hide it
;; explicitly instead of relying on the single-toast replacement.
(rx/of (ptk/data-event ::error cause)
(ntf/hide :tag reconnecting-tag)))
ptk/EffectEvent
(effect [_ _ _]
@ -225,6 +276,59 @@
;; navigate away before the user can recover the retained changes.
(errors/flash-persistence cause))))
(defn- persistence-transient-failure
"Transient save failure: the head commit stays queued and a retry is
scheduled with backoff instead of parking the save in `:error`. Once the
budget (`retry-delays-ms`) is exhausted, the failure falls through to the
terminal `persistence-failed` path unchanged."
[commit-id cause]
(ptk/reify ::persistence-transient-failure
ptk/UpdateEvent
(update [_ state]
;; Always counts (even past the budget): the watch routes on the
;; stored count, so it must read — never recompute — attempts.
(let [attempts (inc (dm/get-in state [:persistence :attempts] 0))]
(update state :persistence
(fn [pstate]
(-> pstate
(assoc :status :retrying
:attempts attempts
:retry-token (uuid/next)
:retry-for commit-id
:last-progress-at (inst-ms (ct/now)))
(dissoc :stall-reported))))))
ptk/WatchEvent
(watch [_ state _]
(let [attempts (dm/get-in state [:persistence :attempts])]
(if (> attempts (count retry-delays-ms))
(rx/of (persistence-failed commit-id cause))
(rx/merge
;; One notice per episode: shown on the first attempt,
;; re-showing would only replace the identical toast.
(when (= 1 attempts)
(rx/of (ntf/show {:content (tr "errors.save-retrying")
:type :toast
:level :warning
:tag reconnecting-tag})))
(let [delay-ms (nth retry-delays-ms (dec attempts))
token (dm/get-in state [:persistence :retry-token])]
(->> (rx/timer delay-ms)
(rx/map (fn [_] (persist-commit commit-id {:token token})))))))))))
(defn- rotate-stalled-stamp
"Clears a previous attempt stamp when it is safe to resend: the commit is
the current retry head and its request is no longer in flight. A still
in-flight request is left alone — its own result drives the next step."
[state commit-id]
(let [commit (dm/get-in state [:persistence :index commit-id])]
(if (and (= :retrying (dm/get-in state [:persistence :status]))
(= commit-id (dm/get-in state [:persistence :retry-for]))
(::request-id commit)
(not (contains? @active-requests (::request-id commit))))
(update-in state [:persistence :index commit-id] dissoc ::request-id)
state)))
(defn- commit-persisted
[commit]
(ptk/reify ::commit-persisted
@ -235,7 +339,7 @@
(update [_ state]
;; Keep the acknowledgment even if the queue runner has stopped.
(d/update-in-when state [:persistence :index (:id commit)]
assoc ::acknowledged? true))))
assoc ::acknowledged true))))
(defn- update-file-request
"Issues the `update-file` request, tracked as active for its lifetime."
@ -261,7 +365,7 @@
(cond
(= :error (dm/get-in state [:persistence :status])) :halted
(nil? commit) :missing-commit
(::acknowledged? commit) :acknowledged
(::acknowledged commit) :acknowledged
(contains? @active-requests (::request-id commit)) :in-flight
(and (::request-id commit)
(not= request-id (::request-id commit))) :unknown-outcome
@ -295,19 +399,32 @@
:code :invalid-save-response
:file-id file-id})))))
(rx/catch (fn [cause]
(rx/of (persistence-failed id cause)))))))
(rx/of ((if (transient-error? (ex-data cause))
persistence-transient-failure
persistence-failed)
id cause)))))))
(defn- persist-commit
[commit-id]
"Sends the queued commit, stamping the attempt first. Inside a `:retrying`
episode a previous stamp is rotated when its request is no longer in
flight, so a retry resends the same commit instead of failing as
`:unknown-outcome`. Carries an optional `:token`: retry timers pass the
episode token, and a stale token (superseded episode) stays silent
instead of sending or failing."
[commit-id & {:keys [token]}]
(let [request-id (uuid/next)]
(ptk/reify ::persist-commit
ptk/UpdateEvent
(update [_ state]
(if (= :ready (attempt-state state commit-id request-id))
;; Record the attempt before starting I/O. An interrupted request
;; may have reached the server and must not be replayed blindly.
(assoc-in state [:persistence :index commit-id ::request-id] request-id)
state))
(let [token-ok? (or (nil? token)
(= token (dm/get-in state [:persistence :retry-token])))
state (if token-ok? (rotate-stalled-stamp state commit-id) state)]
(if (and token-ok?
(= :ready (attempt-state state commit-id request-id)))
;; Record the attempt before starting I/O. An interrupted request
;; may have reached the server and must not be replayed blindly.
(assoc-in state [:persistence :index commit-id ::request-id] request-id)
state)))
ptk/WatchEvent
(watch [_ state _]
@ -318,17 +435,22 @@
:code code
:commit-id commit-id
:file-id (:file-id commit)}))))]
(case (attempt-state state commit-id request-id)
:halted (rx/empty)
:missing-commit (fail :missing-commit "A queued save has no change data")
:acknowledged (rx/of (commit-persisted commit))
;; The replacement runner listens for the original request's result.
:in-flight (rx/empty)
;; Even :network and :offline do not prove that the server
;; skipped the write. Keep the attempt stamp to prevent replay.
:unknown-outcome (fail :save-outcome-unknown "An interrupted save has an unknown outcome")
:permission-denied (fail :save-permission-denied "Edit permission was lost before changes could be saved")
:ready (send-queued-commit request-id (:session-id state) commit)))))))
(if (and (some? token)
(not= token (dm/get-in state [:persistence :retry-token])))
;; Stale retry timer: its episode was superseded. Stay silent.
(rx/empty)
(case (attempt-state state commit-id request-id)
:halted (rx/empty)
:missing-commit (fail :missing-commit "A queued save has no change data")
:acknowledged (rx/of (commit-persisted commit))
;; The replacement runner listens for the original request's result.
:in-flight (rx/empty)
;; Fail-safe for anything outside a live retry episode (retry
;; rotation in `update` already cleared the stamp when resending
;; is safe). Keep the attempt stamp to prevent replay.
:unknown-outcome (fail :save-outcome-unknown "An interrupted save has an unknown outcome")
:permission-denied (fail :save-permission-denied "Edit permission was lost before changes could be saved")
:ready (send-queued-commit request-id (:session-id state) commit))))))))
(defn- run-persistence-task
@ -361,7 +483,8 @@
(rx/take-until stoper-s)))
:else
(rx/of (update-status :saved)))))))
(rx/of (update-status :saved)
(ntf/hide :tag reconnecting-tag)))))))
(defn- resume-persistence
[]
@ -371,7 +494,7 @@
(update state :persistence
(fn [pstate]
(-> pstate
(dissoc :error)
(dissoc :error :attempts :retry-token :retry-for)
(assoc :run-id (uuid/next) :status :saving)
(update :last-progress-at d/nilv (inst-ms (ct/now)))))))
ptk/WatchEvent
@ -386,7 +509,10 @@
(let [{:keys [queue index status error run-id]} (:persistence state)
commit (get index (peek queue))]
(cond
;; A retrying episode owns its recovery through the backoff
;; scheduler; resuming here would bypass the attempt budget.
(and (seq queue)
(not= status :retrying)
(or (not= status :error)
(and (= :save-permission-denied (:code error))
(not (::request-id commit))
@ -416,6 +542,19 @@
(assoc :redo-changes rchg)
(assoc :changes rchg)))))))
(defn- resume-on-online
"Re-enters the runner for a retrying episode when the browser reports
connectivity back, instead of waiting out the backoff. Terminal failures
stay terminal: only a live `:retrying` episode resumes."
[]
(ptk/reify ::resume-on-online
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [status queue]} (:persistence state)]
(if (and (seq queue) (= :retrying status))
(rx/of (run-persistence-task))
(rx/empty))))))
(defn initialize-persistence
[]
(ptk/reify ::initialize-persistence
@ -453,6 +592,15 @@
(rx/map (fn [_] (check-persistence)))
(rx/take-until stoper-s))
;; The browser knows when connectivity returns: re-enter the
;; runner for a retrying episode instead of waiting out the
;; backoff. No `window` outside the browser (tests, SSR).
(or (when (exists? js/window)
(->> (rx/from-event js/window "online")
(rx/map (fn [_] (resume-on-online)))
(rx/take-until stoper-s)))
(rx/empty))
(->> notifier-s
(rx/map #(ptk/data-event ::persistence-notification))
(rx/take-until stoper-s))

139
frontend/src/app/main/errors.cljs
View File

@ -16,6 +16,7 @@
[app.main.data.nitrate :as dnt]
[app.main.data.notifications :as ntf]
[app.main.data.workspace :as-alias dw]
[app.main.repo :as rp]
[app.main.router :as rt]
[app.main.store :as st]
[app.main.worker]
@ -136,13 +137,10 @@
(def environment-error-types
"Error types produced by the environment rather than by an application
defect."
#{:network
:offline
:bad-gateway
:service-unavailable
:nitrate-unavailable
:nitrate-not-configured})
defect: the shared transient transport set (`repo/retryable-types`) plus
the nitrate-specific failures."
(into rp/retryable-types #{:nitrate-unavailable
:nitrate-not-configured}))
(defn environment-error?
[cause]
@ -232,7 +230,9 @@
;;
;; The fingerprint cache is bounded: when it is full, the fingerprint
;; inserted first is evicted (FIFO order), so memory cannot grow without
;; limit.
;; limit. Eviction drops the evicted fingerprint's pending counter with
;; it, so its next occurrence emits as a fresh report (`:occurrences`
;; 1): a bounded precision trade-off, not an accounting bug.
(def report-window-ms
"Minimum time between two reports with the same fingerprint."
@ -281,9 +281,16 @@
(str/prune hint 120))]
(if (environment-error? cause)
base
(let [;; A JS stack string starts with "Error: <message>"; the first
;; actual frame is the second line.
frame (or (some-> (.-stack cause) (str/lines) (second)) "")]
(let [;; A JS stack string starts with "Error: <message>". The first
;; actual frame is the first subsequent line shaped like a
;; frame: skipping the message line and matching on `(` tolerates
;; wrapper-prepended stacks instead of trusting the position.
frame (or (some->> (.-stack cause)
(str/lines)
(drop 1)
(filter #(str/includes? % "("))
(first))
"")]
(str base "|" (str/prune frame 120))))))
(defn- evict-oldest
@ -340,6 +347,17 @@
[fingerprint now]
(swap! report-governor reserve-report* fingerprint now))
(defn- reserve!
"Common reservation step shared by `submit-report` and the `flash`
pipeline: fingerprint the cause and ask the governor. Returns the
occurrence count when this report must be emitted, nil when the
governor suppresses it."
[event-name cause]
(let [state (reserve-report! (error-fingerprint event-name cause)
(inst-ms (ct/now)))]
(when (::emit state)
{:occurrences (::occurrences state)})))
(defn- emit-report!
"Emit the audit event for a report that is already reserved by the
governor."
@ -357,17 +375,22 @@
`cause` must be the exception the report describes: a report without a
cause is ignored (and does not consume a governor reservation), so every
report shares the same fingerprint format."
report shares the same fingerprint format.
`report` is either the report string or a zero-arg function building
it: the function runs only when the governor grants emission, so
suppressed occurrences never pay the report-building cost."
[& {:keys [event-name report hint cause]
:or {event-name "unhandled-exception"}}]
(when (and (ex/exception? cause)
(not (str/empty? hint))
(string? report)
(or (string? report) (fn? report))
(string? event-name))
(let [state (reserve-report! (error-fingerprint event-name cause)
(inst-ms (ct/now)))]
(when (::emit state)
(emit-report! event-name report hint (::occurrences state))))))
(when-let [{:keys [occurrences]} (reserve! event-name cause)]
(emit-report! event-name
(if (fn? report) (report) report)
hint
occurrences))))
(defn- download-report!
[report event]
@ -377,6 +400,27 @@
(dom/trigger-download-uri "report" "text/plain" uri)
(ts/schedule-on-idle #(wapi/revoke-uri uri))))
(defn- emit-flash-report!
"Reserves, generates and emits the flash report. Returns the generated
report string, or nil when nothing is emitted (non-exception cause,
`:silent` type, empty hint or denied governor reservation)."
[type cause]
(when (ex/exception? cause)
(when-let [event-name (case type
:handled "handled-exception"
:unhandled "unhandled-exception"
:silent nil)]
(let [format (if (environment-error? cause) :compact :full)
report-hint (ex/get-hint cause)]
(when (and (string? report-hint) (not (str/empty? report-hint)))
(when-let [{:keys [occurrences]} (reserve! event-name cause)]
(let [generated (generate-report cause {:format format})]
(emit-report! event-name
generated
report-hint
occurrences)
generated)))))))
(defn flash
"Show error notification banner and emit error report.
A nil timeout keeps the notification visible until dismissed or replaced.
@ -389,7 +433,19 @@
The report is reserved before being generated, so repeated errors that
fall inside the governor window do not pay the report-building cost.
The notification is scheduled asynchronously (via tm/schedule) to
The whole body (report pipeline first, toast after) runs inside a single
`ts/schedule` callback: nothing report- or toast-related executes
synchronously on the error handler's stack. A failure while reporting or
notifying is logged to the console and never propagates; the toast is
still attempted.
Returns a promise resolving with the generated report (or nil when
nothing is emitted) once the scheduled callback completes. The promise
is total: it never rejects. Production callers ignore it
(fire-and-forget); it exists so tests can await completion instead of
reasoning about timer order.
The notification is scheduled asynchronously (via `ts/schedule`) to
avoid pushing a new event into the potok store while the store's own
error-handling pipeline is still on the call stack. Emitting
synchronously from inside an error handler creates a re-entrant
@ -397,33 +453,26 @@
(RangeError: Maximum call stack size exceeded)."
[& {:keys [type hint cause timeout report-link?]
:or {type :handled timeout 5000}}]
(let [report (when (ex/exception? cause)
(when-let [event-name (case type
:handled "handled-exception"
:unhandled "unhandled-exception"
:silent nil)]
(let [format (if (environment-error? cause) :compact :full)
report-hint (ex/get-hint cause)]
(when (and (string? report-hint) (not (str/empty? report-hint)))
(let [state (reserve-report! (error-fingerprint event-name cause) (inst-ms (ct/now)))]
(when (::emit state)
(let [generated (generate-report cause {:format format})]
(emit-report! event-name
generated
report-hint
(::occurrences state))
generated)))))))]
(ts/schedule
#(st/emit!
(ntf/show
(cond-> {:content (or ^boolean hint (tr "errors.generic"))
:type :toast
:level :error
:timeout timeout}
(and report-link? report)
(assoc :links [{:label (tr "labels.download" "report.txt")
:callback (partial download-report! report)}])))))))
(js/Promise.
(fn [resolve _reject]
(ts/schedule
(fn []
(let [report (try (emit-flash-report! type cause)
(catch :default err
(.error js/console "error on emitting report" err)
nil))]
(try (st/emit!
(ntf/show
(cond-> {:content (or ^boolean hint (tr "errors.generic"))
:type :toast
:level :error
:timeout timeout}
(and report-link? report)
(assoc :links [{:label (tr "labels.download" "report.txt")
:callback (partial download-report! report)}]))))
(catch :default err
(.error js/console "error on emitting toast" err)))
(resolve report)))))))
(defn- handle-connectivity-error
"Report a failure caused by the user's connectivity. These are audit-only

7
frontend/src/app/main/repo.cljs
View File

@ -23,9 +23,12 @@
;; -- Retry helpers -----------------------------------------------------------
(def ^:private retryable-types
(def retryable-types
"Set of error types that are considered transient and safe to retry
for idempotent (GET) requests."
for idempotent (GET) requests. Also the single source of truth for the
transient transport classification consumed by `persistence/transient-error?`
and `errors/environment-error-types`: extend this set (never a copy)
when a new retryable transport failure appears."
#{:network ; js/fetch network-level failure
:bad-gateway ; 502
:service-unavailable ; 503

3
frontend/src/app/main/ui/workspace/left_header.cljs
View File

@ -115,18 +115,21 @@
:pending (stl/css :status-notification :pending-status)
:saving (stl/css :status-notification :saving-status)
:saved (stl/css :status-notification :saved-status)
:retrying (stl/css :status-notification :retrying-status)
:error (stl/css :status-notification :error-status)
(stl/css :status-notification))
:title (case persistence-status
:pending (tr "workspace.header.saving")
:saving (tr "workspace.header.saving")
:saved (tr "workspace.header.saved")
:retrying (tr "workspace.header.retrying")
:error (tr "workspace.header.save-error")
nil)}
(case persistence-status
:pending deprecated-icon/status-alert
:saving deprecated-icon/status-alert
:saved deprecated-icon/status-tick
:retrying deprecated-icon/status-alert
:error deprecated-icon/status-wrong
nil)]
[:div {:class (stl/css :file-name-label)} file-name]])]

4
frontend/src/app/main/ui/workspace/left_header.scss
View File

@ -117,6 +117,10 @@
animation: jump 0.3s ease-out;
}
&.retrying-status {
background-color: var(--status-widget-background-color-warning);
}
&.error-status {
background-color: var(--status-widget-background-color-error);
}

443
frontend/test/frontend_tests/data/persistence_retry_test.cljs Normal file
View File

@ -0,0 +1,443 @@
;; 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 frontend-tests.data.persistence-retry-test
"Retry-episode tests for the file persistence save pipeline
(`app.main.data.persistence`).
Covers the transient-failure retry contract: transient failures resend
the head commit with backoff, the budget bounds the episode, guards
(in-flight, stale token, online resume) prevent double-sends, and hung
resends across governor windows still earn their own stall report."
(:require
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.main.data.changes :as dch]
[app.main.data.event :as ev]
[app.main.data.persistence :as dps]
[app.main.errors :as errors]
[app.main.repo :as rp]
[app.main.router :as rt]
[app.main.store :as st]
[app.util.i18n :as i18n]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[frontend-tests.helpers.async :as async]
[frontend-tests.helpers.mock :as mock]
[potok.v2.core :as ptk]))
(defn- local-commit
"Builds a synthetic local commit event for `file-id`: a page edit as redo,
no undo, from the `:local` source."
[file-id]
(ptk/data-event ::dch/commit
{:id (uuid/next)
:file-id file-id
:file-revn 0
:file-vern 0
:source :local
:features #{}
:redo-changes [{:type :mod-page :id (uuid/next) :name "Edited"}]
:undo-changes []}))
(defn- with-persistence
"Async fixture for the persistence tests: mocks the transport and flash, and
runs `f` with persistence initialized.
Evaluates to a promise resolving once `f` settles and teardown completes;
`await` it from an `^:async` test.
By default the transport responds through the `:response` subject. Pass a
`respond` function (`(fn [cmd params] observable)`) to drive the transport
response directly instead. Delivery through the subject is asynchronous
(`observe-on :async`): await each effect — via `wait-for` — before
asserting it."
[f & [respond]]
(let [file-id (uuid/next)
response (rx/subject)
failures (atom [])
requests (atom [])
store (ptk/store {:state {:current-file-id file-id
:permissions {:can-edit true}
:files {file-id {:id file-id :revn 0}}}
:on-error #(t/is false (str %))})]
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [cmd params]
(swap! requests conj [cmd params])
(if respond
(respond cmd params)
(->> response (rx/take 1) (rx/observe-on :async)))))
errors/flash (fn [& {:keys [cause]}]
(swap! failures conj cause))}
(try
(ptk/emit! store (dps/initialize-persistence))
(await (f {:file-id file-id :response response :failures failures
:requests requests :store store}))
(finally
(rx/dispose! store)
(rx/end! response))))))
(defn- check-failed-save-response
"Feeds `result` as the transport response and asserts the commit stays
queued as a failed save instead of being treated as persisted. Retry
timers fire instantly (stubbed `rx/timer`), so a permanently bad answer
exhausts the 3-retry budget and lands terminal: `:error` carrying
`:invalid-save-response`, queue intact, exactly 4 sends."
[result]
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_] (rx/of :tick)))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(and (= :error (get-in @store [:persistence :status]))
(= :invalid-save-response
(get-in @store [:persistence :error :code]))
(= 1 (count (get-in @store [:persistence :queue]))))
"invalid response fails the save"))
(t/is (= :error (get-in @store [:persistence :status])))
(t/is (= :invalid-save-response (get-in @store [:persistence :error :code])))
(t/is (= 1 (count (get-in @store [:persistence :queue]))))
(t/is (= 4 (count @requests)) "initial send plus 3 retries"))))
(fn [_ _] result)))
;; Variant: an empty answer.
(t/deftest ^:async empty-save-response-preserves-the-queue-as-failed
(await (check-failed-save-response (rx/empty))))
;; Variant: a nil answer.
(t/deftest ^:async nil-save-response-preserves-the-queue-as-failed
(await (check-failed-save-response (rx/of nil))))
;; Variant: a negative revision answer.
(t/deftest ^:async invalid-revision-save-response-preserves-the-queue-as-failed
(await (check-failed-save-response (rx/of {:revn -1}))))
;; Retry tests.
;;
;; Production contract under test: a transient save failure keeps the head
;; commit queued under `:retrying` and resends it with backoff (2s / 8s /
;; 20s, then terminal). Retry timers are stubbed — instant when the test
;; drives completion, manually fired when it scripts the race — and every
;; stub records its delays so the schedule itself is asserted.
;;
;; Same async pattern as above: triggers stay bare, every assert block is
;; preceded by `wait-for` on its leading signal.
;; Scenario: the first send fails transiently, the retry succeeds. Both
;; sends carry the same `:commit-id`; the save lands with an empty queue
;; and the episode metadata is cleared. Proves: one transient failure
;; retries the same commit instead of erroring.
(t/deftest ^:async transient-failure-retries-and-saves
(let [calls (atom 0)]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_] (rx/of :tick)))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"retry saves the file"))
(t/is (= :saved (get-in @store [:persistence :status])))
(t/is (empty? (get-in @store [:persistence :queue])))
(t/is (= 2 (count @requests)) "failed send plus one retry")
(t/is (apply = (map (comp :commit-id second) @requests))
"both sends carry the same commit id")
(t/is (nil? (get-in @store [:persistence :attempts]))
"the episode metadata is cleared on success"))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/throw (ex-info "offline" {:type :offline}))
(rx/of {:revn 1})))))))
;; Scenario: every send fails transiently. The 2s / 8s / 20s retries fire
;; and then the failure falls through to the exact terminal path: `:error`
;; carrying the cause, queue intact, one flash. Proves: the budget bounds
;; the episode (4 sends) and exhaustion is today's terminal behavior.
(t/deftest ^:async retry-exhaustion-goes-terminal
(let [delays (atom [])]
(await
(with-persistence
(^:async fn [{:keys [file-id failures requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [ms] (swap! delays conj ms) (rx/of :tick)))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(and (= :error (get-in @store [:persistence :status]))
(= 4 (count @requests)))
"retries exhaust into terminal error"))
(t/is (= :error (get-in @store [:persistence :status])))
(t/is (= :save-failed (get-in @store [:persistence :error :code])))
(t/is (= 1 (count (get-in @store [:persistence :queue]))))
(t/is (= [2000 8000 20000] @delays) "the backoff schedule fires in order")
(t/is (= 1 (count @failures)) "exhaustion flashes exactly once"))))
(fn [_ _] (rx/throw (ex-info "offline" {:type :offline})))))))
;; Scenario: a retry timer fires while the replacement request is still in
;; flight. The timer is driven by hand: fail the first send, queue a second
;; edit so its run resends (hanging), then fire the pending timer. Proves:
;; the firing is skipped instead of double-sending the same commit.
(t/deftest ^:async retry-skips-resend-while-previous-request-is-in-flight
(let [calls (atom 0)
delays (atom [])
timer-s (rx/subject)]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [ms] (swap! delays conj ms) timer-s))}
;; Phase 1 — first send fails transiently; the retry pends on
;; the hand-fired timer.
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= :retrying (get-in @store [:persistence :status]))
"transient failure retries"))
(t/is (= 1 (count @requests)))
;; Phase 2 — a new edit re-enters the runner under the live
;; episode (status stays :retrying) and resends the head,
;; hanging in flight.
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 2 (count @requests)) "second edit resends"))
(t/is (= :retrying (get-in @store [:persistence :status])))
(t/is (= 1 (get-in @store [:persistence :attempts])))
;; Phase 3 — the pending timer fires into the in-flight request:
;; skipped, never a third send.
(rx/push! timer-s :tick)
(await (async/settle))
(t/is (= 2 (count @requests)) "no double-send while in flight")
(t/is (= :retrying (get-in @store [:persistence :status])))
(t/is (= 2 (count (get-in @store [:persistence :queue]))))
(rx/end! timer-s))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/throw (ex-info "offline" {:type :offline}))
(rx/subject)))))))
;; Scenario: a persist-commit arrives with a superseded episode token after
;; a transient failure. Without the token guard it would fail terminally as
;; `:save-outcome-unknown`; with it, nothing happens. Proves: stale retry
;; timers stay silent.
(t/deftest ^:async stale-retry-token-stays-silent
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_] (rx/subject)))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= :retrying (get-in @store [:persistence :status]))
"transient failure retries"))
(t/is (= 1 (count @requests)))
(ptk/emit! store (#'dps/persist-commit
(peek (get-in @store [:persistence :queue]))
{:token (uuid/next)}))
(await (async/settle))
(t/is (= 1 (count @requests)) "stale token sends nothing")
(t/is (= :retrying (get-in @store [:persistence :status])))
(t/is (nil? (get-in @store [:persistence :error]))))))
(fn [_ _] (rx/throw (ex-info "offline" {:type :offline}))))))
;; Scenario: a transient failure raises the reconnect notice; the retry
;; then succeeds. The timer is driven by hand so the test observes the
;; episode mid-flight: one visible notice (the store holds a single toast,
;; so episodes never stack), gone once the save lands. Proves: exactly one
;; notice per episode, hidden on recovery.
(t/deftest ^:async retry-shows-a-single-reconnect-notice-until-saved
(let [calls (atom 0)
timer-s (rx/subject)]
(await
(with-persistence
(^:async fn [{:keys [file-id store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_] timer-s))
i18n/tr (mock/stub #(str "translated:" %))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 1 (get-in @store [:persistence :attempts]))
"first attempt fails into retrying"))
(let [notice (get @store :notification)]
(t/is (map? notice) "a single notice is visible, never stacked"))
(t/is (= :persistence-reconnecting (get-in @store [:notification :tag])))
(t/is (= "translated:errors.save-retrying"
(get-in @store [:notification :content])))
(rx/push! timer-s :tick)
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(nil? (get @store :notification)))
"save hides the notice"))
(t/is (= :saved (get-in @store [:persistence :status])))
(t/is (nil? (get @store :notification)) "recovery is silent")
(rx/end! timer-s))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/throw (ex-info "offline" {:type :offline}))
(rx/of {:revn 1})))))))
;; Scenario: every send fails transiently with instant timers. Exhaustion
;; takes the terminal path, which hides the reconnect notice explicitly
;; before flashing. Proves: no stale notice survives a terminal failure.
(t/deftest ^:async retry-exhaustion-hides-the-reconnect-notice
(await
(with-persistence
(^:async fn [{:keys [file-id store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_] (rx/of :tick)))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= :error (get-in @store [:persistence :status]))
"retries exhaust into terminal error"))
(t/is (= :error (get-in @store [:persistence :status])))
(t/is (nil? (get @store :notification))
"the terminal path hides the reconnect notice"))))
(fn [_ _] (rx/throw (ex-info "offline" {:type :offline}))))))
;; Scenario: a retrying episode waits on its backoff timer when the browser
;; reports connectivity back. The pending timer never fires, so only the
;; online signal can resume: the head resends under the live episode and,
;; once answered, the file saves. A second online signal with an empty
;; queue sends nothing. Proves: reconnect resumes promptly without
;; terminal failures staying terminal.
(t/deftest ^:async online-event-resumes-a-retrying-episode
(let [calls (atom 0)
timer-s (rx/subject)
second-s (atom nil)]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_] timer-s))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= :retrying (get-in @store [:persistence :status]))
"transient failure retries"))
(t/is (= 1 (count @requests)))
(ptk/emit! store (#'dps/resume-on-online))
(await (async/wait-for #(= 2 (count @requests)) "online resends"))
(t/is (= 2 (count @requests)))
(t/is (= :retrying (get-in @store [:persistence :status])))
(t/is (= 1 (get-in @store [:persistence :attempts])))
(rx/push! @second-s {:revn 1})
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"resumed save lands"))
(t/is (= :saved (get-in @store [:persistence :status])))
(ptk/emit! store (#'dps/resume-on-online))
(await (async/settle))
(t/is (= 2 (count @requests)) "online with an empty queue sends nothing")
(rx/end! timer-s))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/throw (ex-info "offline" {:type :offline}))
(let [s (rx/subject)] (reset! second-s s) s)))))))
(defn- audit-events
"The audit events (report emissions) out of everything collected through
the `st/emit!` double. Discriminates by `ptk/type`, which is total (never
throws)."
[events]
(filter #(= ::ev/event (ptk/type %)) events))
;; Scenario: the `online` event arrives while a retry request is already in
;; flight. The first send fails transiently, a new edit re-enters and
;; resends (hanging), then connectivity reports back mid-flight. Proves:
;; the online entry point honors the in-flight guard instead of
;; double-sending — the same guard as the retry-timer path, through
;; `resume-on-online` -> `run-persistence-task`.
(t/deftest ^:async online-event-does-not-resend-an-in-flight-request
(let [calls (atom 0)
timer-s (rx/subject)]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_] timer-s))}
;; Phase 1 — first send fails transiently; the retry pends on
;; the hand-fired timer.
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= :retrying (get-in @store [:persistence :status]))
"transient failure retries"))
(t/is (= 1 (count @requests)))
;; Phase 2 — a new edit re-enters the runner under the live
;; episode and resends the head, hanging in flight.
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 2 (count @requests)) "second edit resends"))
(t/is (= :retrying (get-in @store [:persistence :status])))
;; Phase 3 — online arrives mid-flight: silent, never a third send.
(ptk/emit! store (#'dps/resume-on-online))
(await (async/settle))
(t/is (= 2 (count @requests)) "online sends nothing while in flight")
(t/is (= :retrying (get-in @store [:persistence :status])))
(rx/end! timer-s))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/throw (ex-info "offline" {:type :offline}))
(rx/subject)))))))
;; Scenario: the same file stalls twice, more than a governor window apart
;; (scripted clock). Each stall emits its own report: the second is a new
;; episode, not a suppressed duplicate of the first. Proves: identical
;; stall causes coalesce only inside the window.
;;
;; Note: unlike `with-watchdog`, the real `submit-report` runs here (only
;; `generate-report` stays doubled), so the test exercises the governor,
;; the thunk contract and the emit path end to end.
(t/deftest ^:async repeated-stalls-across-windows-emit-each-report
(let [clock (atom 0)
ticks (rx/subject)
response (rx/subject)
requests (atom [])
causes (atom [])
events (atom [])
file-id (uuid/next)
store (ptk/store {:state {:current-file-id file-id
:permissions {:can-edit true}
:files {file-id {:id file-id :revn 0}}}
:on-error #(t/is false (str %))})]
(errors/reset-report-governor!)
(await
(mock/with-mocks*
{ct/now (mock/stub #(ct/inst @clock))
rx/interval (mock/stub (fn [_] ticks))
rp/cmd! (mock/stub (fn [cmd params]
(swap! requests conj {:cmd cmd :params params})
(->> response (rx/take 1) (rx/observe-on :async))))
st/state store
errors/generate-report (fn [cause & _]
(swap! causes conj cause)
"report")
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")}
(try
(ptk/emit! store (dps/initialize-persistence))
;; Phase 1 — the first stall reports once.
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(reset! clock 300001)
(rx/push! ticks :tick)
(await (async/wait-for #(= 1 (count (audit-events @events)))
"first stall reports"))
(t/is (= 1 (count @requests)))
;; Phase 2 — the save lands, resetting the stall clock; a new
;; edit stalls again, over a governor window later.
(rx/push! response {:revn 1})
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"first save lands"))
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 2 (count @requests)) "second edit is sent"))
(reset! clock (+ 300001 errors/report-window-ms 300001))
(rx/push! ticks :tick)
(await (async/wait-for #(= 2 (count (audit-events @events)))
"second stall reports"))
(let [audits (audit-events @events)]
(t/is (= 2 (count audits)))
(t/is (= 2 (count @causes)) "each granted stall builds its report")
(t/is (every? #(= 1 (:occurrences (deref %))) audits)
"each stall is a fresh emission, never a coalesced repeat"))
(finally
(rx/dispose! store)
(rx/end! ticks)
(rx/end! response)))))))

1041
frontend/test/frontend_tests/data/persistence_test.cljs
View File

File diff suppressed because it is too large Load Diff

359
frontend/test/frontend_tests/errors_governor_test.cljs Normal file
View File

@ -0,0 +1,359 @@
;; 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 frontend-tests.errors-governor-test
"Unit tests for the error report governor (`app.main.errors`).
Tests cover:
- error fingerprinting – stable identity incl. wrapper stacks
- reserve-report* – pure window/count/eviction decisions
- submit-report – governed emission, thunk reports
- flash report pipeline – reserve-before-generate, totality"
(:require
[app.main.data.event :as ev]
[app.main.errors :as errors]
[app.main.router :as rt]
[app.main.store :as st]
[app.util.timers :as tm]
[cljs.test :as t :include-macros true]
[cuerdas.core :as str]
[frontend-tests.helpers.mock :as mock]
[potok.v2.core :as ptk]))
;; ---------------------------------------------------------------------------
;; Error report governor
;;
;; The governor deduplicates report by fingerprint: the first occurrence is
;; always emitted, repeats inside a 2 minute window are counted, and the
;; fingerprint cache is bounded (the oldest entry is evicted when full).
;; ---------------------------------------------------------------------------
(t/use-fixtures :each {:before #(errors/reset-report-governor!)})
(defn- error-cause
[& {:keys [type code hint]}]
(ex-info (or hint "boom")
(cond-> {}
(some? type) (assoc :type type)
(some? code) (assoc :code code)
(some? hint) (assoc :hint hint))))
(defn- capture-reports!
"Run `f` capturing the events emitted through `st/emit!`."
[f]
(let [events (atom [])]
(with-redefs [st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")]
(f)
@events)))
(t/deftest fingerprint-is-stable-for-equivalent-errors
(let [cause-a (error-cause :type :network :code :fetch-failed :hint "unable to perform fetch operation")
cause-b (error-cause :type :network :code :fetch-failed :hint "unable to perform fetch operation")]
(t/is (= (errors/error-fingerprint "handled-exception" cause-a)
(errors/error-fingerprint "handled-exception" cause-b)))))
(t/deftest fingerprint-changes-with-error-identity
(let [base (error-cause :type :network :code :fetch-failed :hint "boom")]
(t/is (not= (errors/error-fingerprint "handled-exception" base)
(errors/error-fingerprint "handled-exception"
(error-cause :type :network :code :fetch-failed :hint "other"))))
(t/is (not= (errors/error-fingerprint "handled-exception" base)
(errors/error-fingerprint "handled-exception"
(error-cause :type :validation :code :fetch-failed :hint "boom"))))
(t/is (not= (errors/error-fingerprint "handled-exception" base)
(errors/error-fingerprint "handled-exception"
(error-cause :type :network :code :other :hint "boom"))))))
(t/deftest fingerprint-includes-the-report-name
(let [cause (error-cause :type :network :hint "boom")]
(t/is (not= (errors/error-fingerprint "handled-exception" cause)
(errors/error-fingerprint "unhandled-exception" cause)))
(t/is (not= (errors/error-fingerprint "handled-exception" cause)
(errors/error-fingerprint "exception-page" cause)))))
(t/deftest fingerprint-handles-missing-type-and-code
(let [fingerprint (errors/error-fingerprint "handled-exception" (js/Error. "plain failure"))]
(t/is (string? fingerprint))
(t/is (str/starts-with? fingerprint "handled-exception|unknown|unknown|"))))
(t/deftest fingerprint-skips-non-frame-preamble-lines
;; Scenario: a bundler/polyfill wrapper prepends extra non-frame lines
;; before the real frames. Positional indexing would take the preamble
;; as the frame and fragment the grouping; matching the first frame
;; line keeps the identity equal to the plain equivalent. Proves:
;; grouping survives wrapper-prepended stacks.
(let [plain (doto (ex-info "boom" {:type :internal :hint "boom"})
(unchecked-set "stack" "Error: boom\n at call-site-a (app.js:1)"))
wrapped (doto (ex-info "boom" {:type :internal :hint "boom"})
(unchecked-set "stack" "Error: boom\nWrapped by polyfill\n at call-site-a (app.js:1)"))]
(t/is (= (errors/error-fingerprint "handled-exception" plain)
(errors/error-fingerprint "handled-exception" wrapped)))))
(t/deftest environment-fingerprints-ignore-the-stack-frame
(let [cause-a (doto (ex-info "http error" {:type :offline :hint "http error"})
(unchecked-set "stack" "Error: http error\n at call-site-a (app.js:1)"))
cause-b (doto (ex-info "http error" {:type :offline :hint "http error"})
(unchecked-set "stack" "Error: http error\n at call-site-b (app.js:2)"))
defect-a (doto (ex-info "boom" {:type :internal :hint "boom"})
(unchecked-set "stack" "Error: boom\n at call-site-a (app.js:1)"))
defect-b (doto (ex-info "boom" {:type :internal :hint "boom"})
(unchecked-set "stack" "Error: boom\n at call-site-b (app.js:2)"))]
(t/testing "environment failures group across internal call sites"
(t/is (= (errors/error-fingerprint "handled-exception" cause-a)
(errors/error-fingerprint "handled-exception" cause-b))))
(t/testing "application defects keep the stack frame in their identity"
(t/is (not= (errors/error-fingerprint "handled-exception" defect-a)
(errors/error-fingerprint "handled-exception" defect-b))))))
(t/deftest governor-emits-first-occurrence-and-suppresses-repeats
(let [d1 (errors/reserve-report* (errors/initial-report-state) "fp" 1000)
d2 (errors/reserve-report* d1 "fp" 2000)
d3 (errors/reserve-report* d2 "fp" 3000)
d4 (errors/reserve-report* d3 "fp" (+ 1000 errors/report-window-ms))]
(t/is (true? (::errors/emit d1)))
(t/is (= 1 (::errors/occurrences d1)))
(t/is (false? (::errors/emit d2)))
(t/is (nil? (::errors/occurrences d2)))
(t/is (false? (::errors/emit d3)))
(t/is (nil? (::errors/occurrences d3)))
(t/is (true? (::errors/emit d4)))
(t/is (= 3 (::errors/occurrences d4)))))
(t/deftest governor-evicts-oldest-entry-when-cache-is-full
(let [base (reduce (fn [state i]
(errors/reserve-report* state (str "fp-" i) (* 1000 i)))
(errors/initial-report-state)
(range errors/max-tracked-fingerprints))
state (errors/reserve-report* base
"fp-new"
(* 1000 errors/max-tracked-fingerprints))]
(t/is (= errors/max-tracked-fingerprints (count (:entries state))))
(t/is (= errors/max-tracked-fingerprints (count (:order state))))
(t/is (true? (::errors/emit state)))
(t/is (nil? (get-in state [:entries "fp-0"])))
(t/is (= "fp-1" (peek (:order state))))
(t/is (some? (get-in state [:entries "fp-new"])))))
(t/deftest governor-evicts-by-insertion-order-not-by-last-emission
(let [base (reduce (fn [state i]
(errors/reserve-report* state (str "fp-" i) (* 1000 i)))
(errors/initial-report-state)
(range errors/max-tracked-fingerprints))
;; fp-0 re-emits after the window, so its :emitted-at becomes the
;; most recent one, but it keeps its insertion position.
re-emitted (errors/reserve-report* base
"fp-0"
(+ (* 1000 errors/max-tracked-fingerprints)
errors/report-window-ms))
state (errors/reserve-report* re-emitted
"fp-new"
(+ (* 1000 errors/max-tracked-fingerprints)
errors/report-window-ms
1000))]
(t/is (true? (::errors/emit state)))
;; FIFO: the first inserted one goes, even though it was the last
;; emitted and fp-1 is the oldest by :emitted-at.
(t/is (nil? (get-in state [:entries "fp-0"])))
(t/is (some? (get-in state [:entries "fp-1"])))
(t/is (= errors/max-tracked-fingerprints (count (:entries state))))
(t/is (= errors/max-tracked-fingerprints (count (:order state))))))
(t/deftest submit-report-is-governed-and-reports-occurrences
(let [cause (error-cause :type :network :code :fetch-failed :hint "boom")
events (capture-reports!
(fn []
(dotimes [_ 5]
(errors/submit-report :event-name "handled-exception"
:report "report"
:hint "boom"
:cause cause))))]
(t/is (= 1 (count events)))
(t/is (= 1 (:occurrences (deref (first events)))))))
(t/deftest invalid-report-does-not-consume-a-reservation
(let [cause (error-cause :type :network :hint "boom")
events (capture-reports!
(fn []
(errors/submit-report :event-name "handled-exception"
:report nil :hint "boom" :cause cause)
(errors/submit-report :event-name "handled-exception"
:report "report" :hint "boom" :cause cause)))]
(t/is (= 1 (count events)))
(t/is (= 1 (:occurrences (deref (first events)))))))
(t/deftest submit-report-evaluates-thunk-reports-lazily
;; Scenario: the same failure is submitted twice with the report as a
;; thunk. The first occurrence is granted and builds the report; the
;; second is suppressed and must never run the thunk. Proves: suppressed
;; occurrences skip the report-building cost entirely.
(let [calls (atom 0)
report (fn [] (swap! calls inc) "report")
cause (error-cause :type :network :hint "boom")
events (capture-reports!
(fn []
(errors/submit-report :event-name "handled-exception"
:report report
:hint "boom"
:cause cause)
(errors/submit-report :event-name "handled-exception"
:report report
:hint "boom"
:cause cause)))]
(t/is (= 1 (count events)))
(t/is (= 1 @calls) "only the granted occurrence builds the report")
(t/is (= "report" (:report (deref (first events)))))))
(t/deftest governor-applies-to-every-report-name
(let [events (capture-reports!
(fn []
(doseq [event-name ["handled-exception" "unhandled-exception" "exception-page"]]
(let [cause (error-cause :type :internal :hint event-name)]
(errors/submit-report :event-name event-name
:report "report"
:hint event-name
:cause cause)
(errors/submit-report :event-name event-name
:report "report"
:hint event-name
:cause cause)))))]
(t/is (= 3 (count events)))))
(t/deftest submit-report-without-cause-is-ignored
(let [events (capture-reports!
(fn []
(errors/submit-report :event-name "exception-page" :report "report" :hint "boom")
(errors/submit-report :event-name "exception-page"
:report "report"
:hint "boom"
:cause (error-cause :type :internal :hint "boom"))))]
;; The cause-less call is ignored and must not consume the reservation
;; of the cause-based report.
(t/is (= 1 (count events)))
(t/is (= 1 (:occurrences (deref (first events)))))))
(t/deftest governor-bounds-an-incident-like-loop
(let [cause (error-cause :type :network :hint "unable to perform fetch operation")
events (capture-reports!
(fn []
(dotimes [_ 10000]
(errors/submit-report :event-name "handled-exception"
:report "report"
:hint "unable to perform fetch operation"
:cause cause))))]
(t/is (= 1 (count events)))))
(defn- report-events
"The audit events (report emissions) out of everything collected through
the `st/emit!` double. Toasts are ungoverned by design — one per `flash`
call — so only the events typed as audit events count for emission
bounds. Discriminates by `ptk/type`, which is total (never throws),
because toasts are not derefable."
[events]
(filter #(= ::ev/event (ptk/type %)) events))
(t/deftest ^:async flash-suppressed-occurrence-does-not-build-a-report
;; Scenario: the same failure flashes 3 times inside the governor window.
;; Only the first occurrence reserves emission; the suppressed ones skip
;; generation entirely. Proves: one audit event and a single report build
;; for the whole burst; each `flash` is awaited to completion, so no
;; timer reasoning is involved.
(let [generated (atom 0)
cause (error-cause :type :internal :hint "unable to perform fetch operation")
events (atom [])]
(await
(mock/with-mocks*
{st/format-last-events (mock/stub (fn [& _] (swap! generated inc) "report"))
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")
tm/schedule (mock/stub (fn [f] (mock/asap f)))}
(dotimes [_ 3]
(await (errors/flash :cause cause :type :handled)))
(t/is (= 1 (count (report-events @events))))
(t/is (= 1 @generated))))))
(t/deftest ^:async flash-bounds-an-incident-like-loop
;; Scenario: 10 000 identical flashes, replaying the incident loop. Every
;; flash is awaited (all 10 000 scheduled at once, one wait for all of
;; them), but the governor emits only the first occurrence. Proves: the
;; burst produces exactly one audit event and one report build.
(let [generated (atom 0)
cause (error-cause :type :internal :hint "unable to perform fetch operation")
events (atom [])]
(await
(mock/with-mocks*
{st/format-last-events (mock/stub (fn [& _] (swap! generated inc) "report"))
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")
tm/schedule (mock/stub (fn [f] (mock/asap f)))}
(await (js/Promise.all
(into-array
(map (fn [_] (errors/flash :cause cause :type :handled))
(range 10000)))))
(t/is (= 1 (count (report-events @events))))
(t/is (= 1 @generated))))))
(t/deftest generate-report-is-total-when-formatting-fails
(with-redefs [st/format-last-events (mock/stub (fn [& _] (throw (ex-info "formatting failed" {}))))]
(let [report (errors/generate-report (error-cause :type :network :hint "boom"))]
(t/is (string? report)))))
(t/deftest ^:async flash-emits-a-fallback-report-when-generation-fails
;; Scenario: the full-report formatter throws. `generate-report` stays
;; total and the fallback string is what gets emitted. Proves: a
;; formatting failure still produces exactly one audit event carrying a
;; string report, with the `flash` awaited to completion.
(let [events (atom [])]
(await
(mock/with-mocks*
{st/format-last-events (mock/stub (fn [& _] (throw (ex-info "formatting failed" {}))))
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")
tm/schedule (mock/stub (fn [f] (mock/asap f)))}
(await (errors/flash :cause (error-cause :type :internal :hint "boom") :type :handled))
(let [reports (report-events @events)]
(t/is (= 1 (count reports)))
(t/is (string? (:report (deref (first reports))))))))))
(t/deftest ^:async flash-emits-nothing-synchronously
;; Scenario: a single handled failure. Nothing report- or toast-related
;; may run on the error handler's stack: the whole `flash` body executes
;; inside one scheduled callback. Proves: zero events right after the
;; call returns; report + toast once the returned promise completes.
(errors/reset-report-governor!)
(let [events (atom [])
cause (error-cause :type :internal :hint "async flash probe")]
(await
(mock/with-mocks*
{st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")
tm/schedule (mock/stub (fn [f] (mock/asap f)))}
(let [completed (errors/flash :cause cause :type :handled)]
(t/is (empty? @events) "nothing emitted synchronously")
(await completed)
(t/is (= 2 (count @events)) "report + toast once completed"))))))
(t/deftest ^:async flash-report-failure-neither-propagates-nor-kills-the-toast
;; Scenario: the report emission itself throws (audit sink down). The
;; failure is logged and swallowed at the schedule boundary while the
;; toast is still attempted, so the user keeps the banner. Proves:
;; `flash` never throws, its promise still completes, and a reporting
;; failure still leaves the toast emitted.
(errors/reset-report-governor!)
(let [events (atom [])
calls (atom 0)
cause (error-cause :type :internal :hint "emit failure probe")]
(await
(mock/with-mocks*
{st/emit! (mock/stub (fn [& emitted]
(if (zero? @calls)
(do (swap! calls inc)
(throw (ex-info "sink down" {})))
(swap! events into emitted))))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")
tm/schedule (mock/stub (fn [f] (mock/asap f)))}
(await (errors/flash :cause cause :type :handled))
(t/is (= 1 (count @events)) "only the toast survives a reporting failure")))))

166
frontend/test/frontend_tests/fonts_test.cljs
View File

@ -11,6 +11,7 @@
[app.util.http :as http]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[frontend-tests.helpers.async :as async]
[frontend-tests.helpers.mock :as mock]))
(def sample-font
@ -139,104 +140,107 @@
(t/use-fixtures
:each
(fn [test-fn]
(reset! fonts/preview-sprite {:status :idle :ids #{} :node nil :refs 0})
(test-fn)))
{:before #(reset! fonts/preview-sprite {:status :idle :ids #{} :node nil :refs 0})})
(defn- fake-node
"A minimal DOM-like node exposing only what the sprite attach/detach touches."
[]
#js {:remove (fn [] nil)})
(t/deftest attach-preview-sprite-returns-nil-while-sprite-is-not-ready
(mock/with-mocks
{globals/browser? (mock/stub (constantly true))}
(fn [done]
(reset! fonts/preview-sprite {:status :loading :ids #{} :node nil :refs 0})
(t/is (nil? (fonts/attach-preview-sprite!)))
(t/is (= 0 (:refs @fonts/preview-sprite)))
(t/deftest ^:async attach-preview-sprite-returns-nil-while-sprite-is-not-ready
(await
(mock/with-mocks*
{globals/browser? (mock/stub (constantly true))}
(reset! fonts/preview-sprite {:status :loading :ids #{} :node nil :refs 0})
(t/is (nil? (fonts/attach-preview-sprite!)))
(t/is (= 0 (:refs @fonts/preview-sprite)))
(reset! fonts/preview-sprite {:status :error :ids #{} :node nil :refs 0})
(t/is (nil? (fonts/attach-preview-sprite!)))
(t/is (= 0 (:refs @fonts/preview-sprite)))
(done))
(fn [] nil)))
(reset! fonts/preview-sprite {:status :error :ids #{} :node nil :refs 0})
(t/is (nil? (fonts/attach-preview-sprite!)))
(t/is (= 0 (:refs @fonts/preview-sprite)))
;; Trailing settle: the body is synchronous, but `with-mocks*`
;; evaluates to a promise, so the body must settle one.
(await (async/settle)))))
(t/deftest attach-preview-sprite-increments-refs-and-returns-the-node
(mock/with-mocks
{globals/browser? (mock/stub (constantly true))}
(fn [done]
(let [node (fake-node)]
(reset! fonts/preview-sprite {:status :ready :ids #{"a"} :node node :refs 0})
(t/is (identical? node (fonts/attach-preview-sprite!)))
(t/is (= 1 (:refs @fonts/preview-sprite)))
(t/is (identical? node (fonts/attach-preview-sprite!)))
(t/is (= 2 (:refs @fonts/preview-sprite)))
(done)))
(fn [] nil)))
(t/deftest ^:async attach-preview-sprite-increments-refs-and-returns-the-node
(await
(mock/with-mocks*
{globals/browser? (mock/stub (constantly true))}
(let [node (fake-node)]
(reset! fonts/preview-sprite {:status :ready :ids #{"a"} :node node :refs 0})
(t/is (identical? node (fonts/attach-preview-sprite!)))
(t/is (= 1 (:refs @fonts/preview-sprite)))
(t/is (identical? node (fonts/attach-preview-sprite!)))
(t/is (= 2 (:refs @fonts/preview-sprite)))
;; Trailing settle: the body is synchronous, but `with-mocks*`
;; evaluates to a promise, so the body must settle one.
(await (async/settle))))))
(t/deftest detach-preview-sprite-removes-node-only-when-last-reference-drops
(mock/with-mocks
{globals/browser? (mock/stub (constantly true))}
(fn [done]
(let [removed? (volatile! false)
node #js {:remove (fn [] (vreset! removed? true))}]
(reset! fonts/preview-sprite {:status :ready :ids #{"a"} :node node :refs 0})
(fonts/attach-preview-sprite!)
(fonts/attach-preview-sprite!)
(t/deftest ^:async detach-preview-sprite-removes-node-only-when-last-reference-drops
(await
(mock/with-mocks*
{globals/browser? (mock/stub (constantly true))}
(let [removed? (volatile! false)
node #js {:remove (fn [] (vreset! removed? true))}]
(reset! fonts/preview-sprite {:status :ready :ids #{"a"} :node node :refs 0})
(fonts/attach-preview-sprite!)
(fonts/attach-preview-sprite!)
;; First detach keeps the node: another dropdown is still open.
(fonts/detach-preview-sprite! node)
(t/is (= 1 (:refs @fonts/preview-sprite)))
(t/is (false? @removed?))
;; First detach keeps the node: another dropdown is still open.
(fonts/detach-preview-sprite! node)
(t/is (= 1 (:refs @fonts/preview-sprite)))
(t/is (false? @removed?))
;; Second detach reaches zero refs, so the node is removed from the DOM.
(fonts/detach-preview-sprite! node)
(t/is (= 0 (:refs @fonts/preview-sprite)))
(t/is (true? @removed?))
(done)))
(fn [] nil)))
;; Second detach reaches zero refs, so the node is removed from the DOM.
(fonts/detach-preview-sprite! node)
(t/is (= 0 (:refs @fonts/preview-sprite)))
(t/is (true? @removed?))
;; Trailing settle: the body is synchronous, but `with-mocks*`
;; evaluates to a promise, so the body must settle one.
(await (async/settle))))))
(t/deftest detach-preview-sprite-clamps-refs-at-zero
(mock/with-mocks
{globals/browser? (mock/stub (constantly true))}
(fn [done]
(let [removed? (volatile! false)
node #js {:remove (fn [] (vreset! removed? true))}]
(reset! fonts/preview-sprite {:status :ready :ids #{"a"} :node node :refs 0})
(fonts/detach-preview-sprite! node)
(t/is (= 0 (:refs @fonts/preview-sprite)))
(t/is (true? @removed?))
(done)))
(fn [] nil)))
(t/deftest ^:async detach-preview-sprite-clamps-refs-at-zero
(await
(mock/with-mocks*
{globals/browser? (mock/stub (constantly true))}
(let [removed? (volatile! false)
node #js {:remove (fn [] (vreset! removed? true))}]
(reset! fonts/preview-sprite {:status :ready :ids #{"a"} :node node :refs 0})
(fonts/detach-preview-sprite! node)
(t/is (= 0 (:refs @fonts/preview-sprite)))
(t/is (true? @removed?))
;; Trailing settle: the body is synchronous, but `with-mocks*`
;; evaluates to a promise, so the body must settle one.
(await (async/settle))))))
(t/deftest prefetch-preview-sprite-fetches-only-from-idle-or-error
(t/deftest ^:async prefetch-preview-sprite-fetches-only-from-idle-or-error
(let [calls (volatile! 0)
fetch (mock/stub (fn [& _]
(vswap! calls inc)
(rx/empty)))]
(mock/with-mocks
{globals/browser? (mock/stub (constantly true))
http/fetch fetch}
(fn [done]
;; :ready → no refetch
(reset! fonts/preview-sprite {:status :ready :ids #{"a"} :node (fake-node) :refs 0})
(fonts/prefetch-preview-sprite!)
(t/is (= 0 @calls))
(await
(mock/with-mocks*
{globals/browser? (mock/stub (constantly true))
http/fetch fetch}
;; :ready → no refetch
(reset! fonts/preview-sprite {:status :ready :ids #{"a"} :node (fake-node) :refs 0})
(fonts/prefetch-preview-sprite!)
(t/is (= 0 @calls))
;; :loading → no refetch (an earlier request is in flight)
(reset! fonts/preview-sprite {:status :loading :ids #{} :node nil :refs 0})
(fonts/prefetch-preview-sprite!)
(t/is (= 0 @calls))
;; :loading → no refetch (an earlier request is in flight)
(reset! fonts/preview-sprite {:status :loading :ids #{} :node nil :refs 0})
(fonts/prefetch-preview-sprite!)
(t/is (= 0 @calls))
;; :error → retries
(reset! fonts/preview-sprite {:status :error :ids #{} :node nil :refs 0})
(fonts/prefetch-preview-sprite!)
(t/is (= 1 @calls))
;; :error → retries
(reset! fonts/preview-sprite {:status :error :ids #{} :node nil :refs 0})
(fonts/prefetch-preview-sprite!)
(t/is (= 1 @calls))
;; :idle → first fetch
(reset! fonts/preview-sprite {:status :idle :ids #{} :node nil :refs 0})
(fonts/prefetch-preview-sprite!)
(t/is (= 2 @calls))
(done))
(fn [] nil))))
;; :idle → first fetch
(reset! fonts/preview-sprite {:status :idle :ids #{} :node nil :refs 0})
(fonts/prefetch-preview-sprite!)
(t/is (= 2 @calls))
;; Trailing settle: the body is synchronous, but `with-mocks*`
;; evaluates to a promise, so the body must settle one.
(await (async/settle))))))

92
frontend/test/frontend_tests/helpers/async.cljs Normal file
View File

@ -0,0 +1,92 @@
;; 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 frontend-tests.helpers.async
"Async-first plumbing for ClojureScript tests.
Lets a test read sequentially while presupposing asynchronous APIs:
triggers run, effects are awaited as promises, and `done` always runs
at the end. Relies on two platform properties:
- `cljs.test` keeps its env in a `set!` var, so assertions inside
deferred ticks are still counted.
- RxJS delivers `observe-on :async` notifications in scheduling (FIFO)
order, so awaiting the last scheduled delivery observes every effect
scheduled before it."
(:require
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]))
(defn ->promise
"Coerces a single-value observable into a js/Promise that resolves
with its first value (or rejects on error)."
[ob]
(js/Promise. (fn [resolve reject] (rx/subs! resolve reject ob))))
(defn ^:async await-response
"Pushes `value` into the `response` subject and resolves once the last
recorded request completes, delivery included.
The promise subscribes BEFORE pushing: subscribing after the push
would never resolve. Request entries are maps holding the request
observable under `:req`."
[requests response value]
(let [p (->promise (:req (last @requests)))]
(rx/push! response value)
(await p)))
(defn settle
"Resolves on the next macrotask, letting scheduled deliveries land.
Await it before asserting absence: silence is only meaningful once the
queue had a chance to deliver."
[]
(js/Promise. (fn [resolve] (js/setTimeout resolve 0))))
(defn observe
"Subscribes to `ob` forcing asynchronous delivery through `observe-on
:async` — even when the source is synchronous — and returns a promise
resolving once the stream terminates.
Keyword args: `:on-next` per value, `:on-error` (handled errors resolve;
unhandled reject), `:on-complete` on clean termination, `:timeout-ms`
(default 2000). Asserts the stream is provided: resolving nil would let
a test pass without observing anything. Rejects on timeout instead of
hanging."
[ob & {:keys [on-next on-error on-complete timeout-ms]
:or {timeout-ms 2000}}]
(assert (some? ob) "observe requires an observable stream")
(js/Promise.
(fn [resolve reject]
(let [timer (js/setTimeout
#(reject (ex-info "Stream did not terminate in time" {}))
timeout-ms)
settle (fn [f v]
(js/clearTimeout timer)
(f v))]
(->> ob
(rx/observe-on :async)
(rx/subs!
(fn [v] (when on-next (on-next v)))
(fn [e]
(if on-error
(do (on-error e) (settle resolve nil))
(settle reject e)))
(fn []
(when on-complete (on-complete))
(settle resolve nil))))))))
(defn ^:async wait-for
"Resolves once `pred` holds, checking immediately and then once per
macrotask (bounded: records a failure instead of hanging). Await it
before asserting effects of triggers — it holds whether the effect
lands synchronously or not."
[pred msg & [{:keys [max-ticks] :or {max-ticks 50}}]]
(if (pred)
nil
(if (<= max-ticks 0)
(t/is false (str "Timed out waiting for: " msg))
(do (await (settle))
(await (wait-for pred msg {:max-ticks (dec max-ticks)}))))))

123
frontend/test/frontend_tests/helpers/mock.cljc
View File

@ -19,13 +19,20 @@
The `with-mocks` helper wraps the lifecycle:
1. Reset recording atoms
2. Save original var values, install mocks via `set!`
3. Execute `(test-fn inner-done)`
3. Defer `(test-fn inner-done)` past the current tick via `asap`,
so the body provably runs with mocks that survived an async
boundary
4. `inner-done` restores originals and calls `outer-done`
(typically `cljs.test/async`'s done).
(typically `cljs.test/async`'s done). A throw inside the deferred
body is reported as an `:error`, then restores and completes.
Requires a done-chained context (usually `t/async`): a synchronous
test completes before its deferred body runs.
Usage: `(with-mocks {ns/sym mock-fn, ...} test-fn done)`"
#?(:cljs (:require
[beicon.v2.core :as rx]))
[beicon.v2.core :as rx]
[cljs.test :as t]))
#?(:cljs (:require-macros [frontend-tests.helpers.mock])))
;; ═══════════════════════════════════════════════════════════════
@ -34,15 +41,19 @@
#?(:clj
(defmacro with-mocks
"Resets recording atoms, installs `mocks` via `set!`, then
calls `(test-fn inner-done)`. Original var values are restored
when `inner-done` is called.
"Resets recording atoms, installs `mocks` via `set!`, then defers
`(test-fn inner-done)` past the current tick via `asap`.
`mocks` is a map of sym → mock-fn
(e.g. `{app.main.repo/cmd! mock-fn}`).
`inner-done` restores the originals and calls `outer-done` (the
`cljs.test/async` `done` callback).
`cljs.test/async` `done` callback). A throw inside the deferred body
is reported as an `:error` before restoring and completing, so a
failing body can neither leak the mocks nor stall the run.
Requires a done-chained context (usually `t/async`): a synchronous
caller completes before its deferred body runs.
Example:
@ -55,7 +66,8 @@
(rx/subs!
(fn [v] ...)
(fn [err] (done'))
(fn [] (done'))))))))"
(fn [] (done')))))
done)))"
[mocks test-fn outer-done]
(let [entries (map identity mocks)
gen-pairs (mapv (fn [[qsym _mock]]
@ -76,13 +88,67 @@
(fn [{:keys [qsym osym]}]
`(set! ~qsym ~osym))
gen-pairs)]
`(let [test-fn# ~test-fn]
(frontend-tests.helpers.mock/reset-state!)
(let ~let-bindings
~@install-exprs
(frontend-tests.helpers.mock/asap
(fn []
(try
(test-fn# (fn []
~@restore-exprs
(~outer-done)))
(catch :default e#
~@restore-exprs
(cljs.test/report {:type :error
:message "Uncaught exception, not in assertion."
:expected nil
:actual e#})
(~outer-done))))))))))
#?(:clj
(defmacro with-mocks*
"Installs `mocks` via `set!`, then evaluates `body` inside a generated
`^:async` fn awaited via `run-mocked`: when the body settles, the
originals are restored — always. A rejection is reported as an `:error`.
Evaluates to a promise resolving once the body settles and the mocks
are restored. `await` it, either directly or by returning it from an
`^:async` fn; nested scopes must be awaited too.
Example:
(t/deftest ^:async my-async-test
(await (mock/with-mocks*
{app.main.repo/cmd! mock/rpc-cmd-mock}
(await (some-async-flow))
...)))"
[mocks & body]
(let [entries (map identity mocks)
gen-pairs (mapv (fn [[qsym _mock]]
{:qsym qsym
:osym (gensym "orig-")})
entries)
let-bindings (vec (mapcat
(fn [{:keys [qsym osym]}]
[osym qsym])
gen-pairs))
install-exprs (mapv
(fn [[_qsym mock-fn] {:keys [qsym]}]
`(set! ~qsym ~mock-fn))
entries
gen-pairs)
restore-exprs (mapv
(fn [{:keys [qsym osym]}]
`(set! ~qsym ~osym))
gen-pairs)]
`(do
(frontend-tests.helpers.mock/reset-state!)
(let ~let-bindings
~@install-exprs
(~test-fn (fn inner-done# []
~@restore-exprs
(~outer-done))))))))
(frontend-tests.helpers.mock/run-mocked
(^:async fn [] ~@body)
(fn [] ~@restore-exprs)))))))
;; ═══════════════════════════════════════════════════════════════
;; Runtime (ClojureScript only)
@ -164,6 +230,41 @@
([a b c d e] (f a b c d e))
([a b c d e g] (f a b c d e g))))
;; Scheduling
;; ═══════════════════════════════════════════════════════════════
(defn asap
"Runs `f` on the next macrotask (`js/setTimeout` 0) and returns
the timer id. Used by `with-mocks` to defer the test body past
the current tick, so installed mocks provably survive async
boundaries."
[f]
(js/setTimeout f 0))
(defn ^:async run-mocked
"Awaits the async zero-arg `thunk`, then runs `restore` — always, in
that order — and resolves. A rejection is reported as an `:error`
(uncaught-exception semantics, like `test-var-block*`); a non-promise
return is reported as an `:error` too."
[thunk restore]
(let [p (thunk)]
(if (and (some? p) (fn? (.-then p)))
(try
(await p)
(catch :default e
(t/report {:type :error
:message "Uncaught exception, not in assertion."
:expected nil
:actual e}))
(finally
(restore)))
(do
(restore)
(t/report {:type :error
:message "with-mocks* body did not return a promise."
:expected nil
:actual p})))))
;; Lifecycle
;; ═══════════════════════════════════════════════════════════════

944
frontend/test/frontend_tests/main_errors_test.cljs
View File

File diff suppressed because it is too large Load Diff

4
frontend/test/frontend_tests/runner.cljs
View File

@ -12,6 +12,7 @@
[frontend-tests.data.dashboard-test]
[frontend-tests.data.exports-assets-test]
[frontend-tests.data.nitrate-test]
[frontend-tests.data.persistence-retry-test]
[frontend-tests.data.persistence-test]
[frontend-tests.data.profile-test]
[frontend-tests.data.repo-test]
@ -31,6 +32,7 @@
[frontend-tests.data.workspace-texts-test]
[frontend-tests.data.workspace-thumbnails-test]
[frontend-tests.data.workspace-versions-test]
[frontend-tests.errors-governor-test]
[frontend-tests.errors-test]
[frontend-tests.fonts-test]
[frontend-tests.helpers-shapes-test]
@ -130,6 +132,7 @@
'frontend-tests.data.comments-filters-test
'frontend-tests.data.dashboard-test
'frontend-tests.data.nitrate-test
'frontend-tests.data.persistence-retry-test
'frontend-tests.data.persistence-test
'frontend-tests.data.profile-test
'frontend-tests.data.repo-test
@ -150,6 +153,7 @@
'frontend-tests.data.workspace-texts-test
'frontend-tests.data.workspace-thumbnails-test
'frontend-tests.data.workspace-versions-test
'frontend-tests.errors-governor-test
'frontend-tests.errors-test
'frontend-tests.fonts-test
'frontend-tests.helpers-shapes-test

8
frontend/translations/en.po
View File

@ -1915,6 +1915,10 @@ msgid "errors.save-failed"
msgstr ""
"Autosave is not working due to an error. Contact support to report the error and reload to continue from your last saved version."
#: src/app/main/data/persistence.cljs:308
msgid "errors.save-retrying"
msgstr "Connection lost. Retrying to save your changes."
#: src/app/main/errors.cljs:442
msgid "errors.svg-parser.invalid-svg"
msgstr "SVG is invalid or malformed"
@ -7564,6 +7568,10 @@ msgstr "Reset"
msgid "workspace.header.save-error"
msgstr "Error on saving"
#: src/app/main/ui/workspace/left_header.cljs:125
msgid "workspace.header.retrying"
msgstr "Retrying to save"
#: src/app/main/ui/workspace/left_header.cljs:123
msgid "workspace.header.saved"
msgstr "Saved"