github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-28 21:40:34 +00:00
Code Issues Packages Projects Releases Wiki Activity

⏪ Backport persistence related fixes from staging (#12306)

Browse Source 
* ✨ Add async test helpers and the with-mocks* macro

Backport of the test scaffolding that the persistence retry work needs,
taken from staging. Purely additive: no existing helper changes behavior,
so the suite result is unchanged (740 tests, 0 failures).

- frontend-tests.helpers.async: ->promise, await-response, settle,
  observe and wait-for. wait-for checks immediately and then polls one
  macrotask at a time, bounded, so it fails instead of hanging.
- mock/with-mocks*: installs mocks with set! and evaluates its body in a
  generated ^:async fn, so the test reads sequentially and there is no
  done to thread. Evaluates to a promise.
- mock/asap and mock/run-mocked: run-mocked awaits the body and restores
  the originals always, in that order, reporting a rejection or a
  non-promise return as an :error.

The matching change that made with-mocks defer its body via asap is NOT
backported: it would force all 58 existing uses across 14 files into
done-chained contexts, which is a separate refactor.

AI-assisted-by: space-bunny-free

* ✨ Add an error report governor with compact payloads

One browser session could emit an unbounded number of identical error
reports, and a dropped connection was reported as an application defect
with the full payload. Both are fixed here, in one place, because the
persistence retry work that follows depends on the new submit-report
contract.

- A report governor in app.main.errors. Each report carries a
  fingerprint (report-name|type|code|hint|first stack frame); the first
  occurrence is always emitted, repeats inside a 2 minute window are
  counted, and the next emitted report carries them as :occurrences. The
  cache is bounded by evicting the oldest entry, so memory stays fixed.
- flash reserves the report before generating it, so a suppressed
  occurrence never pays the report-building cost. Its whole body now
  runs inside one ts/schedule callback, a reporting or notification
  failure is logged instead of propagating, and it returns a total
  promise so tests can await it.
- generate-report accepts :format :compact|:full. The compact payload
  keeps the context header plus type, code and uri, and skips the
  stack, the ex-data dump (it can carry request headers) and the
  last-events list.
- environment-error-types is derived from rp/retryable-types, so the
  transport classification has a single source of truth. Environment
  failures are audit-only handled-exceptions and never reach the
  exception page or the alerts. :offline gets its own handler instead
  of falling through to :default.

:occurrences travels inside the audit event :props, which the backend
schema accepts as a free-form map, so no backend change is needed.

The dedup governor test file is new: 7 tests over the fingerprint, the
pure reservation decision, and the flash pipeline.

Relates to #11726, #11743

AI-assisted-by: space-bunny-free

* ♻️ Answer commit refusals with an empty stream

commit-changes used to return nil when it refused to build a commit,
which forced every caller that wanted to observe the outcome to
special-case nil. It now returns an empty stream, so a refusal and an
empty result look the same and callers can subscribe uniformly.

Only the refusal branch changes: the accepted branch already answered
with (rx/of commit). Potok treats a nil watch result as "nothing", so
both spellings were already correct at the store level.

The 57 call sites that wrap this event in rx/of are unaffected. They
hold the ::commit-changes event itself, not the value its watch
returns, so they keep processing exactly as before.

AI-assisted-by: space-bunny-free

* ✨ Retry transient saves with backoff and a reconnect notice

Any failed update-file landed on the same path: the queue halted in
:error, the retained changes were flushed away, and the user was told
to reload. A dropped connection and a revoked permission are not the
same thing, so they now take different paths.

transient-error? splits them, checking :type and :cause-type because
persistence-failed wraps the original cause. Transient failures enter
a :retrying episode: the head commit stays queued and resends with
backoff at 2s, 8s and 20s, then falls through to today's terminal path.
Everything else is terminal and keeps the exact :error path.

- Resends rotate the ::request-id stamp only once the old request has
  left active-requests, carry the same :commit-id, and never double
  send while one request is in flight.
- Retry timers carry an episode token; a timer whose episode was
  superseded stays silent instead of sending or failing.
- One tagged reconnect notice per episode, hidden by tag on save and on
  terminal failure. Recovery is silent.
- The browser online event re-enters the runner, but only for a live
  :retrying episode, guarded by exists? js/window.
- wait-persisted-or-error waits through :retrying instead of cutting the
  wait short.

The episode keeps its :run-id, so a new local edit only joins the queue.
Re-entering the runner on every edit would bypass the backoff and spend
one attempt per batched commit.

The retry test namespace is new: 13 tests over the classification, the
backoff schedule, stamp rotation, stale tokens and the notice lifecycle.

Relates to #11724

AI-assisted-by: space-bunny-free

* 🐛 Fix stalled saves that never answer and edits lost on leave

Two holes the retry work did not close.

An update-file request that never gets an answer kept its attempt
stamp forever, so the queue could not move and the user saw a saving
state that never resolved. The request now has a 7 minute timeout that
fails it as a transient network error, which hands it to the retry path
instead of blocking. The timeout is longer than the 5 minute stall
threshold on purpose: the stalled report must fire before the retry,
not instead of it.

The leave-page warning also had gaps. It now tracks unsaved edits
directly, through sync-unload-guard, which holds :persistence in
st/ongoing-tasks while edits sit in the buffer or the queue. Edits kept
in the queue after a failed save keep the guard on too, so closing the
tab warns instead of dropping them.

store.cljs guards its ongoing-tasks watcher with exists? js/window,
because the new tests exercise it without a window.

Four new tests: three for the guard across buffering, an in-flight save
and a retained edit, and one for a hung request that must resend and
save.

Closes #12223

AI-assisted-by: space-bunny-free

* 🐛 Skip the save when a missing font cannot be remapped

fix-deleted-fonts emitted text and typography changes even when no
replacement font existed, so opening a page that uses a deleted custom
font rewrote identical content and cleared position-data on every
visit. Every visit became a save with nothing to save.

Both loops now compare the remapped value with the original and emit
nothing when they match. The remapped path is unchanged.

Two new tests cover the no-replacement case and the remapped case.

Closes #12151

AI-assisted-by: space-bunny-free

* ✨ Add a debug helper that simulates an intermediary response

A save that never reaches the backend is hard to reproduce: you need a
proxy, a captive portal or a CDN in the way. This wraps fetch and
answers the named API method with a status and a body that carries no
Penpot error code, leaving every other request alone.

Without a duration the simulation is spent after answering one call.
With one it answers every matching call for that long, which is how to
watch the save retry, warn, keep retrying and finally recover.

  debug.simulateHttpError('update-file')
  debug.simulateHttpError('get-comment-threads', 403)
  debug.simulateHttpError('update-file', 524, 120)
  debug.clearHttpErrorSimulation()

Dev-only and self-contained: no production path reads it.

AI-assisted-by: space-bunny-free

* 🌐 Add the save retry and connection error strings

Three strings the new persistence and error paths need:

- errors.save-retrying, shown once per retry episode while the queue
  resends a queued save after a connection loss.
- workspace.header.retrying, the save indicator state for an episode
  in progress.
- errors.connection-error, shown by the network and offline handlers,
  which no longer fall through to the generic message.

Added to en.po only. The translations script also normalizes every
other locale and drops 439 strings that were already stale before this
work; that belongs in its own maintenance pass, not in a backport.

AI-assisted-by: space-bunny-free

* 🐛 Report save failures as unhandled when they are our defect

flash-persistence reported every failure it did not delegate as
handled-exception, including the ones that are plainly our fault. A
validation failure means the client sent something the server refused,
yet it landed in the audit log with a name that skips the internal
reports and the alerts. Nobody was paged.

The report type now follows the cause. :validation, :server-error and
:internal report as unhandled-exception, so they alert. The rest are
unchanged.

Two exclusions are deliberate:

- Environment failures stay handled. They reach this point after the
  retry budget is spent, and the user's connection is not our bug.
- :assertion stays handled, because its own handler already reports it
  that way and the two paths should not disagree.

The cause type is read from :cause-type first, since persistence-failed
wraps the original under :type :persistence. Reading :type alone would
match the wrapper every time and change nothing.

The user still gets the same sticky toast and report link; only the
audit event name moves.

The test that asserted a validation failure is "still notified" now
asserts which event name it gets, across the bare and wrapped shapes,
the environment types that must stay handled, and an unclassified one.

AI-assisted-by: space-bunny-free

* 🐛 Unblock persistence when opening a file after a terminal failure

A terminal save failure set the state to :error and left the queue
alone. recover-persistence only resumed for :save-permission-denied, so
for every other terminal code both of its branches were false and it
emitted nothing. Leaving and reopening the same file therefore changed
nothing: the editor stayed halted until a reload, which rebuilds the
whole store and loses the queue anyway.

The path had two jobs under one name. initialize-persistence fires when
the workspace view mounts and tears down the previous subscription;
recover-persistence fires when a file is opened or the role changes.
They are now separate: initialization picks up a queue left behind by a
previous session, and deliberately does not lift a halt, so undeliverable
edits are released when the user acts rather than when the view mounts.

Recovery lifts the halt by releasing what can never be saved.
release-failed-file drops every queued commit of the file that failed,
then resume-persistence clears the error and settles an empty queue to
:saved. Retaining them until that point is deliberate: it is what keeps
wait-persisted-or-error rejecting, which is what stops
workspace/versions.cljs from building a snapshot out of unsaved edits.
Releasing at failure time would make waiters resolve instead.

Permission loss is treated as permanent too, which the previous
exception got wrong. The backend raises :not-found for a missing edit
permission, so a resend does not succeed — it routes the user to the
exception page. The old branch made that reachable: it resumed the save
whenever the cached can-edit flag said yes, and the server disagreed.
The only case where the flag can return to true is a team switch, where
the queue is gone anyway, so nothing real is lost by releasing.

Because the queue is shared, dropping the failed file is also what lets
the other files' pending edits drain. One file that cannot be saved no
longer blocks everything else.

Tests: the failure retains the queue and notifies once, recovery
releases it without replaying, a failed file does not block a second
one, permission loss is released rather than resumed, and initialization
leaves a halt alone.

AI-assisted-by: space-bunny-free

* ✨ Offer a reload on the save failure toast

A terminal save failure stops autosave for the whole session, but the
toast asked the user to reload without offering the reload. It listed
five implied actions, none of them reachable from the banner, and it
never said that the changes could not be saved.

flash now takes a :links vector of actions, appended after the download
link that :report-link? produces, so a caller can add recovery actions
without reaching into the report handling. flash-persistence passes a
reload built from labels.reload-page and location.reload, the pattern
already used elsewhere in the app for a full restart.

The message now says what happened, what is lost, and what to do about
it: autosave has stopped for this session, the changes since the last
successful save cannot be saved, and either reloading or leaving the
file and opening it again restarts it. Naming both matters, because the
toast links are easy to miss.

Saying the edits are lost is not optional: recovery releases them, so
without it the user finds out when they come back to the file.

Translated in en.po and es.po only. The translations script would also
normalize all 40 locales and drop entries that were already stale, which
is a maintenance pass of its own.

The reload callback cannot be invoked under the test runner, since
js/location does not exist there, so it is covered by its label and by
being callable. Whether the reload works is a manual check.

AI-assisted-by: space-bunny-free

* 🐛 Classify the responses the backend never wrote

A reply written by a proxy instead of the backend carries no Penpot
error code, so handle-response raised it as :internal. A 504 on a save
skipped the retry cycle and stopped autosave at once, and because
:internal reports as unhandled, it raised an alert. In a standard
deployment this is how a slow save ends: nginx answers 504 after 300s,
before the client's 7 minute timeout fires.

The status now decides the type:

- 504 and the Cloudflare 520-524 family raise :gateway-error, which
  joins retryable-types. Saves retry with backoff like 502 and 503,
  GETs retry, and a save that spends its retries reports as handled,
  because the report rules derive from the same set.
- 429 raises :rate-limit, and any other error status
  :unexpected-response. Neither retries; both show a toast instead of
  the error page.
- :internal is kept for a response below 400 that does not decode.

Bodies we cannot read are cut to 500 characters, since proxy error
pages run to tens of kilobytes.

Tests: classification and retries per status, the transport handlers
keep the page, a 504 and a 524 built by the real handle-response go
through the save path and land on a retry, and the new types stay
handled once the retries are spent.

AI-assisted-by: claude-opus-5-5

* ✨ Keep retrying failed saves on a slow cycle

Once the three backoff retries were spent, a save that failed on the
connection stopped autosave like any terminal failure, and opening a
file again dropped its edits. A connection that comes back after a
minute lost the work all the same.

A transport failure that outlasts the backoff now arms a slow cycle:
one silent resend every 30s, until a save lands or 24h have passed
since the failure started. The cycle stops when persistence restarts,
the queue resumes another way, or the workspace closes.

A save that keeps failing slowly is not resent for a day. A gateway
that answers 504 after its own timeout may leave the backend applying
the save, so each resend can cost the whole save again, and the failing
file holds back every other file's queued edits. An attempt that fails
after 90s or more counts as a slow failure; at three, the slow cycle
stops sending the commit and the save fails as before. Fast failures,
such as being offline, never count.

- The first failure shows a toast that says the changes are kept and
  keep being sent, with no reload link, since a reload loses them. A
  save that lands hides it.
- Opening a file sends a queue still inside its retry window once
  more instead of releasing it. Failures outside the window, and every
  non-transport failure, are still released.
- A freshly loaded file gets back the queued edits of its version, so
  reopening it shows the changes that are still waiting to be saved. An
  edit that no longer applies to the loaded data leaves the file as the
  server sent it, so the file still opens; the edits stay queued.
- A commit whose earlier request is no longer in flight is simply sent
  again under the same commit id: changes are idempotent, so there is
  no unknown-outcome guard any more. A request still in flight still
  blocks a parallel send.

flash takes a :tag so the save failure toast can be hidden by tag.

Tests: the spent backoff arms the slow cycle, a 504 arms it, a terminal
failure does not, the cycle stops when the window closes or at the slow
failure limit, recovery resends instead of releasing, reopening restores
only the loaded file's edits and survives one that no longer applies,
and the retrying toast offers no reload.

* 🐛 Turn off the leave-page warning when failed edits are released

The leave-page warning only followed the queue on appends and discards.
Opening a file again releases the edits of a file that failed for good,
but that release changed the queue without either event, so the warning
stayed on with nothing left to save. Leaving the page asked about
unsaved changes until the next save went through.

The warning now also follows the release.

Tests: releasing the last failed edit turns the warning off.

* 🐛 Stop retrying failed saves outside the workspace

Leaving the workspace was meant to stop the slow retry cycle, but only
a cycle already armed stopped. A backoff timer kept firing after the
user left, and a backoff spent outside the workspace armed a slow cycle
that kept sending for up to a day from the dashboard. Those sends check
the edit permission of whatever team is open, so a switch to a team
where the user only views failed the queued edits for good, and the
next file they opened dropped them.

Leaving the workspace now suspends retries. A pending backoff timer
goes stale, and while suspended a transport failure schedules no
backoff, a spent backoff arms no slow cycle and the online event sends
nothing. The edits stay queued and a request in flight still lands.
Opening a file lifts the suspension and resends a retrying save whose
backoff was cut short; a role change does not lift it.

Tests: leaving stops a pending backoff, a failure after leaving
schedules no retry and ignores the online event, a backoff spent
outside the workspace arms no slow cycle, and opening a file saves the
held edit in each case.

---------

Co-authored-by: alonso.torres <alonso.torres@kaleidos.net>
This commit is contained in:
Andrey Antukh 2026-10-15 12:14:32 +02:00
parent 3458b2f2e5
commit d57cdb4588
27 changed files with 4396 additions and 733 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -8,3 +8,13 @@ assumption; a wrong assumption here already cost a review round.
`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).

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

@ -8,6 +8,14 @@
- The root app renders an exception page from `:exception` state before the normal error boundary. `rt/navigated` clears `:exception`.
- Frontend error handling treats stale cross-build JS chunk failures specially: messages containing `$cljs$cst$` or `$cljs$core$I` plus undefined/null/not-a-function signatures trigger throttled reload.
- Plugin-originated uncaught errors are identified through the plugin runtime hook and logged rather than turning into the global exception page.
- `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`, `:gateway-error`, `: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`/`:gateway-error` show the `errors.connection-error` toast.
- `repo/handle-response` classifies responses the backend never wrote (body is not a transit map) by status: 504 and Cloudflare 520–524 → `:gateway-error` (retryable, so GETs and saves retry); 429 → `:rate-limit`; any other ≥400 → `:unexpected-response` (both toast-only via `handle-transport-error`, never the exception page). `:internal :unable-to-process-repository-response` is left for a <400 response that does not decode. Uninterpretable bodies are capped at 500 chars in `:data`.
- `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` 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.
- `flash` accepts a `:links` vector of `{:label :callback}` actions, appended after the download link that `:report-link?` produces. `flash-persistence` passes a reload link, so a terminal save failure hands the user both the report and the only action that restarts persistence for the session. `labels.reload-page` plus `js/location.reload` is the established full-restart pattern; the link cannot be invoked under the test runner because `js/location` does not exist there, so it is covered by its label and by being callable.
- `flash-persistence` only delegates to another handler for `:authentication`, `:not-found` and `:code :vern-conflict`. Everything else it reports itself, and the report type is derived from the cause: `#{:validation :server-error :internal}` are application defects and report as `unhandled-exception` so they reach the internal reports and the alerts; the rest stay `handled-exception`. `:cause-type` wins over `:type` when classifying, because `persistence-failed` wraps the original cause under `:type :persistence`. Environment failures are deliberately kept handled: they land here after the retry budget is spent and the user's connection is not our bug. `:assertion` is also kept handled, matching its own handler.
- The report governor is global and stateful across tests: two reports with the same fingerprint inside `report-window-ms` collapse. Call `errors/reset-report-governor!` between assertions that expect an emission.
## Store and websocket

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

@ -8,6 +8,19 @@ READ `mem:testing` FIRST — it defines the execution discipline (no piping, tee
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.
### Mock primitives
- `mock/with-mocks` (callback style, the default): installs with `set!` so mocks survive async boundaries. Body runs immediately and `done'` restores and completes — so the call site must be inside `t/async`, and `done'` is called exactly once (twice only warns; never calling it stalls the run and leaks the mocks).
- `mock/with-mocks*` (preferred for new tests): body forms are wrapped in a generated `^:async` fn and it evaluates to a promise — `await` it, `await` nested scopes too, no `done` in test code. A rejection or a non-promise return is reported as an `:error` by `run-mocked`, which restores the originals in either case.
- `mock/asap` runs `f` on the next macrotask; used to make a scheduled callback fire under test control.
- `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).
- Valid `^:async` placements: `mem:clojure/idioms`.
From `frontend/`:
- Full unit test run (always builds, suppressed output): `pnpm run test:quiet`.
- Full unit test run (always builds, build output visible): `pnpm run test`.

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

@ -11,17 +11,27 @@
## Repo calls
- `app.main.repo/send!` uses GET only when the RPC name starts with `get-`, when all params are query params, or for configured special cases. Only GET requests are retried.
- GET retry is limited to transient `:network`, `:bad-gateway`, `:service-unavailable`, and `:offline` errors with exponential backoff. Mutations are not retried.
- `repo/retryable-types` is public and is the single source of truth for the transient transport classification. `persistence/transient-error?` and `errors/environment-error-types` both derive from it; extend that set, never copy it.
- GET retry is limited to transient `:network`, `:bad-gateway`, `:service-unavailable`, `:gateway-error` (504, Cloudflare 52x), and `:offline` errors with exponential backoff. Mutations are not retried.
- A server SSE response is only accepted when the command is configured `:stream?`; otherwise it raises an unexpected-response assertion.
## Commits, undo, persistence
- `commit-changes` refuses to create commits unless `:permissions :can-edit` is true. It captures file revn/vern, selected-before, features, tags, undo group, and translation flag into a `::commit` event.
- `commit-changes` refuses to create commits unless `:permissions :can-edit` is true. It captures file revn/vern, selected-before, features, tags, undo group, and translation flag into a `::commit` event. A refusal answers with an empty stream, never nil, so callers subscribe uniformly instead of branching on nil.
- Applying a remote commit first rolls back pending local commits, applies the remote changes, then replays pending local redo changes. Index updates are emitted for undo, remote redo, and replayed redo paths.
- Local commits are independently consumed by undo, persistence, WASM model updates, thumbnail/library watchers, and text position-data recalculation.
- 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.
- A terminal failure halts the queue on purpose: the edits stay queued so `wait-persisted-or-error` keeps rejecting, and `workspace/versions.cljs` relies on that to avoid snapshotting a file whose edits were never saved. `recover-persistence` lifts the halt when a file is opened again or the role changes. A transport failure still inside its retry window (`slow-retry-pending?`) is resent once (`resume-persistence true`), never released; any other halt emits `release-failed-file` (drops every queued commit of the file that failed) then `resume-persistence`. Opening a file also replays the queued edits of its version onto the loaded data (`pending-file-changes` → `restore-pending-changes` in `bundle-fetched`); a replay that throws keeps the server data and the queue. That is what unblocks the editor without a reload; because the queue is shared, dropping the failed file is also what lets other files' pending edits drain. `release-failed-file` runs at recovery time, never at failure time — clearing the error eagerly would make waiters resolve.
- The split between `initialize-persistence-state` and `recover-persistence` is deliberate: initialization deliberately does NOT lift a halt, so undeliverable edits are released when the user acts, not when the view mounts.
- **Every non-transport terminal save failure is permanent.** There is no "stale but valid" category: permission lost, file gone, and server-rejected changes all fail again on a resend. Losing edit permission is not temporary — the backend raises `:not-found` for it (`check-edition-permissions!` → `perms/make-check-fn`), and `:not-found` routes to the exception page. So `:save-permission-denied` (a client-side `can-edit` check) must never be resumed: replaying the save to discover that routes the user to the exception page. Release it instead.
- Save failures split transient vs terminal (`transient-error?`: the repo retryable types `:network`/`:offline`/`:bad-gateway`/`:service-unavailable`/`:gateway-error` 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 the `:error` path). A transient failure that outlasts the backoff arms `slow-retry-cycle`: one silent resend (`:recovering`) every `slow-retry-delay-ms` (30s) until a save lands, `retry-give-up-ms` (24h since `:failing-since`) passes, or the head commit collects `max-slow-failures` (3) attempts that failed after `slow-failure-ms` (90s) or more (`:slow-failures`, counted in `persistence-transient-failure` from the attempt's elapsed time): a gateway timeout may leave the backend applying the save, so a save that keeps failing slowly must not be replayed for a day, while fast failures (offline) never count; the cycle stops on `::resume-persistence`, `::initialize-persistence` and `finalize-workspace`. Leaving the workspace also emits `suspend-retries` (`:suspended` in `:persistence`, drops `:retry-token` so a pending backoff timer goes stale): no backoff, slow cycle or `online` resend runs outside the workspace; only `workspace-initialized` (not a role change) lifts it via `recover-persistence` (`opened-file?`), which also resends a `:retrying` episode whose backoff was cut short. Its toast is `errors.save-still-retrying` without a reload link; a landing save hides the failure toast (`errors/persistence-failed-tag`). Replaying a save is safe because changes are idempotent, so there is no unknown-outcome guard: a commit whose earlier request left `active-requests` is simply sent again under the same `:commit-id`; only a request still in flight blocks a resend (`:in-flight` stays silent). Tests hold the slow cycle by stubbing `rx/timer` to never fire for `slow-retry-delay-ms`, or instant timers loop forever. 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 and the browser `online` event (guarded by `exists? js/window`; re-enters the runner only for a live `:retrying` episode). New local edits during `:retrying` only join the queue: the episode keeps its `:run-id`, so `append-commit` does not re-enter, and the live runner (still waiting on the head's `commit-persisted`) sends them after the head. Re-entering on edits would bypass the backoff and spend an attempt per batched commit.
- 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.
- `save-request-timeout-ms` is 7 minutes and wraps the `update-file` request in `rx/timeout`, failing it as a transient `:network` error so the retry path resends instead of blocking the queue forever. It is deliberately longer than `saving-stall-timeout-ms` (5 min) so the stalled report fires before the retry.
- `sync-unload-guard` keeps `:persistence` in `st/ongoing-tasks` while edits are buffered or queued, which is what holds the browser leave-page warning on. It syncs on `::append-commit`, `::discard-commit` and `::release-failed-file` (every queue change). It is the one effect that must stay in `store.cljs`'s `omitset`, and `store.cljs`'s `ongoing-tasks` watcher is guarded by `exists? js/window` because tests run without a window.
- 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.

7
frontend/playwright/ui/specs/text-editor-v3.spec.js
View File

@ -168,10 +168,13 @@ test.describe("BUG 10934 - Double-clicking a text side handle sets auto-size", (
await workspace.goToWorkspace();
await workspace.waitForFirstRender();
// Select the text and zoom to fit, so it is fully visible in the viewport
// Select the text and zoom to fit, so it is fully visible in the viewport.
// Wait for the zoom label to change so the handles are at their final spot.
await workspace.clickLeafLayer("Fixed text");
const zoomLabel = page.getByTitle("Zoom", { exact: true });
const initialZoom = await zoomLabel.innerText();
await page.keyboard.press("Shift+1");
await workspace.waitForIdle();
await expect(zoomLabel).not.toHaveText(initialZoom);
return workspace;
}

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

@ -246,21 +246,25 @@
;; 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?)
(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?)
(commit)))))
(rx/empty))))))

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

@ -8,20 +8,27 @@
(: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.main.store :as st]
[app.util.i18n :refer [tr]]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
(declare ^:private run-persistence-task)
(declare ^:private persist-commit)
(declare ^:private resume-persistence)
(declare ^:private slow-retry-cycle)
(log/set-level! :warn)
@ -31,9 +38,40 @@
(def force-persist? #(= % ::force-persist))
(def slow-retry-delay-ms
"Pause between the attempts of a queue whose backoff is spent: one attempt
per cycle, until it saves or the retry window closes."
30000)
(def retry-give-up-ms
"How long a queue that keeps failing on transport errors is sent again."
(* 24 60 60 1000))
(def slow-failure-ms
"An attempt that fails after this long may have kept the backend busy,
as a gateway timeout does, so it counts towards `max-slow-failures`."
(* 90 1000))
(def max-slow-failures
"Slow failures a queued commit may collect before the slow cycle stops
sending it. Fast failures, such as being offline, never count."
3)
(def ^:private saving-stall-timeout-ms (* 5 60 1000))
(def ^:private saving-check-interval-ms 30000)
(def ^:private save-wait-timeout-ms (* 2 60 1000))
;; Longer than the stall threshold so a hung save is reported before it is retried.
(def ^:private save-request-timeout-ms (* 7 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
@ -42,10 +80,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 +109,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 +136,56 @@
(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- retry-window-open?
"True while a failing queue may still be sent again."
[pstate]
(let [since (:failing-since pstate)]
(or (nil? since)
(< (- (inst-ms (ct/now)) since) retry-give-up-ms))))
(defn- slow-retry-pending?
"True when the queue is halted by a transport failure that the slow retry
cycle keeps sending. A commit whose attempts keep failing slowly is not
sent again: each attempt may cost the backend the whole save."
[{:keys [status error slow-failures] :as pstate}]
(and (= :error status)
(transient-error? error)
(retry-window-open? pstate)
(< (or slow-failures 0) max-slow-failures)))
(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 +193,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,23 +203,25 @@
: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
[]
(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)))))))
@ -168,7 +250,9 @@
(throw (ex-info "invalid state" {})))))
(update :index dissoc commit-id)
(assoc :last-progress-at (inst-ms (ct/now)))
(dissoc :stall-reported?)))))))
(dissoc :stall-reported :failing-since :recovering
:slow-failures :attempts :retry-token
:retry-for)))))))
(defn- append-commit
"Event used internally to append the current change to the
@ -190,11 +274,31 @@
ptk/WatchEvent
(watch [_ state _]
(let [pstate (:persistence state)]
;; A `:retrying` episode keeps its run id, so a new edit only
;; joins the queue: the live runner sends it after the head, and
;; resends stay on the backoff schedule and its attempt budget.
(when (and (not= :error (:status pstate))
(= run-id (:run-id pstate)))
(rx/of (update-status :saving)
(run-persistence-task))))))))
(defn- drop-file-commits
"Removes every queued commit belonging to `file-id`, together with its
index entry."
[pstate file-id]
(if-not file-id
pstate
(let [dropped (into #{}
(keep (fn [commit-id]
(when (= file-id (get-in pstate [:index commit-id :file-id]))
commit-id)))
(:queue pstate))]
(if (empty? dropped)
pstate
(-> pstate
(update :queue #(into (empty %) (remove dropped) %))
(update :index #(apply dissoc % dropped)))))))
(defn- persistence-failed
[commit-id cause]
(ptk/reify ::persistence-failed
@ -212,17 +316,87 @@
:commit-id commit-id
:hint (ex-message cause)
::errors/handled? true))
(dissoc :run-id :last-progress-at :stall-reported?))))))
(update :failing-since d/nilv (inst-ms (ct/now)))
(dissoc :run-id :last-progress-at :stall-reported
:attempts :retry-token :retry-for))))))
ptk/WatchEvent
(watch [_ _ _]
(rx/of (ptk/data-event ::error cause)))
(watch [_ state stream]
(rx/merge
;; 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))
;; A transport failure that outlasts the backoff can still pass, so
;; the queue keeps trying at a slow pace.
(let [pstate (:persistence state)]
(if (and (not (:suspended pstate))
(slow-retry-pending? pstate))
(slow-retry-cycle stream)
(rx/empty)))))
ptk/EffectEvent
(effect [_ _ _]
;; Report without invoking global handlers that may reload the file or
;; navigate away before the user can recover the retained changes.
(errors/flash-persistence cause))))
(effect [_ state _]
;; A failed slow attempt repeats a failure the user was already warned
;; about. Report without invoking global handlers that may reload the
;; file or navigate away before the user can recover the retained
;; changes.
(let [pstate (:persistence state)]
(when-not (and (:recovering pstate)
(slow-retry-pending? pstate))
(errors/flash-persistence cause :retrying (slow-retry-pending? pstate)))))))
(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, or when the failed attempt was
one of the slow cycle, the failure falls through to the `persistence-failed`
path, which schedules the next slow attempt. While retries are suspended
nothing is scheduled: the episode waits for a file to be opened again.
`elapsed-ms` is how long the failed attempt took."
[commit-id cause elapsed-ms]
(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)))
(update :failing-since d/nilv (inst-ms (ct/now)))
(cond-> (>= elapsed-ms slow-failure-ms)
(update :slow-failures (fnil inc 0)))
(dissoc :stall-reported))))))
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [attempts recovering suspended]} (:persistence state)]
(cond
(or recovering (> attempts (count retry-delays-ms)))
(rx/of (persistence-failed commit-id cause))
suspended
(rx/empty)
:else
(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- commit-persisted
[commit]
@ -234,7 +408,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."
@ -255,32 +429,38 @@
"Classifies what should happen with a queued commit before sending it.
The attempt stamp and the send decision both read this, so a commit is
only ever stamped with a request that is actually going to be sent."
[state commit-id request-id]
[state commit-id]
(let [commit (dm/get-in state [:persistence :index commit-id])]
(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
(not (dm/get-in state [:permissions :can-edit])) :permission-denied
:else :ready)))
(defn- send-queued-commit
"Sends one queued commit and maps its outcome to persistence events."
[request-id session-id {:keys [id file-id file-revn file-vern changes features] :as commit}]
(let [params {:id file-id
:revn (max file-revn (get @revn-data file-id 0))
:vern file-vern
:session-id session-id
:origin (:origin commit)
:created-at (:created-at commit)
:commit-id id
:changes (vec changes)
:features features}]
(let [sent-at (inst-ms (ct/now))
params {:id file-id
:revn (max file-revn (get @revn-data file-id 0))
:vern file-vern
:session-id session-id
:origin (:origin commit)
:created-at (:created-at commit)
:commit-id id
:changes (vec changes)
:features features}]
;; UI read-only mode does not invalidate already queued edits.
(->> (update-file-request request-id params)
;; Fails an unanswered request as a transient network error, so the
;; retry path resends it instead of blocking the queue.
(rx/timeout save-request-timeout-ms
(rx/throw (ex-info "The save request timed out"
{:type :network
:code :save-request-timeout
:file-id file-id})))
(rx/take 1)
;; A response that carries no revision, including one that never
;; arrived, is treated as a failed save rather than a saved file.
@ -294,19 +474,31 @@
: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
id cause (- (inst-ms (ct/now)) sent-at))
(persistence-failed id cause))))))))
(defn- persist-commit
[commit-id]
"Sends the queued commit, stamping the attempt first. A commit whose
earlier request is no longer in flight is sent again: changes are
idempotent, so a save the backend already applied can be applied again.
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])))]
(if (and token-ok?
(= :ready (attempt-state state commit-id)))
;; Stamp the attempt before any I/O, so a request in flight is
;; never sent twice in parallel.
(assoc-in state [:persistence :index commit-id ::request-id] request-id)
state)))
ptk/WatchEvent
(watch [_ state _]
@ -317,17 +509,18 @@
: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)
: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)
: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
@ -354,49 +547,199 @@
(rx/filter #(= commit-id (:id %)))
(rx/take 1)
(rx/mapcat (fn [_]
;; A save that lands shows the connection
;; is back: the failure warning goes away.
(rx/of (discard-commit commit-id)
(ntf/hide :tag errors/persistence-failed-tag)
(run-persistence-task)))))
(rx/of (persist-commit commit-id)))
(rx/take-until stoper-s)))
:else
(rx/of (update-status :saved)))))))
(rx/of (update-status :saved)
(ntf/hide :tag reconnecting-tag)))))))
(defn- resume-persistence
"Starts the queue again. A `recovering` resume is an attempt of the slow
cycle, which sends once instead of starting a backoff episode."
([] (resume-persistence false))
([recovering]
(ptk/reify ::resume-persistence
ptk/UpdateEvent
(update [_ state]
(update state :persistence
(fn [pstate]
(-> pstate
(dissoc :error :attempts :retry-token :retry-for)
(assoc :run-id (uuid/next)
:status :saving
:recovering recovering)
(update :last-progress-at d/nilv (inst-ms (ct/now)))))))
ptk/WatchEvent
(watch [_ _ _]
(rx/of (run-persistence-task))))))
(defn- slow-retry-cycle
"Resumes a failed queue after `slow-retry-delay-ms`, unless the queue is
resumed some other way, persistence restarts or the workspace closes."
[stream]
(let [stopper-s (rx/merge
(rx/filter (ptk/type? ::resume-persistence) stream)
(rx/filter (ptk/type? ::initialize-persistence) stream)
(rx/filter (ptk/type? ::dw/finalize-workspace) stream))]
(->> (rx/timer slow-retry-delay-ms)
(rx/map (fn [_] (resume-persistence true)))
(rx/take-until stopper-s))))
(defn- suspend-retries
"Stops retrying when the workspace closes. A pending backoff timer goes
stale, and no backoff or slow cycle is armed until a file is opened
again. Queued edits stay queued and a request in flight still lands."
[]
(ptk/reify ::resume-persistence
(ptk/reify ::suspend-retries
ptk/UpdateEvent
(update [_ state]
(update state :persistence
(fn [pstate]
(-> pstate
(dissoc :error)
(assoc :run-id (uuid/next) :status :saving)
(update :last-progress-at d/nilv (inst-ms (ct/now)))))))
ptk/WatchEvent
(watch [_ _ _]
(rx/of (run-persistence-task)))))
#(-> %
(assoc :suspended true)
(dissoc :retry-token))))))
(defn- recover-persistence
(defn- restore-retries
"Lets failed saves be retried again once a file is opened."
[]
(ptk/reify ::recover-persistence
(ptk/reify ::restore-retries
ptk/UpdateEvent
(update [_ state]
(update state :persistence dissoc :suspended))))
(defn- release-failed-file
"Drops the queued commits of the file whose save failed terminally.
This runs when the user opens a file again, not at failure time. The
failure itself stays visible, because `wait-persisted-or-error` must keep
rejecting: callers use it to avoid snapshotting a file whose edits were
never saved. What must not survive is the halt. Left in place, the failed
commits sit at the head of the queue forever and, because the queue is
shared, they also block the pending edits of every other file."
[]
(ptk/reify ::release-failed-file
ptk/UpdateEvent
(update [_ state]
(let [commit-id (get-in state [:persistence :error :commit-id])
file-id (get-in state [:persistence :index commit-id :file-id])]
(update state :persistence
#(-> %
(drop-file-commits file-id)
(dissoc :failing-since :slow-failures)))))))
(defn- queue-needs-a-runner?
"True when the queue still holds commits that nobody is sending.
The runner does not survive a subscription teardown, so both
initialization and recovery hit this. A halted queue is excluded: the
halt is lifted by `recover-persistence`, which has its own triggers. A
retrying episode is excluded too: its backoff timer owns the recovery,
or `recover-persistence` resumes it when retries were suspended."
[{:keys [queue status]}]
(and (seq queue)
(not= :error status)
(not= :retrying status)))
(defn pending-file-changes
"Queued edits to restore into a freshly loaded file, in queue order.
Only edits of the loaded version belong in its data. A permanently
failed file is excluded because recovery releases its edits."
[{:keys [persistence]} {:keys [id vern]}]
(let [{:keys [queue index status error]} persistence
failed-file-id (get-in index [(:commit-id error) :file-id])]
(if (and (= :error status)
(= id failed-file-id)
(not (slow-retry-pending? persistence)))
[]
(into []
(comp (map #(get index %))
(filter #(and (= id (:file-id %))
(= vern (:file-vern %))))
(mapcat :redo-changes))
queue))))
(defn- initialize-persistence-state
"Brings persistence to a coherent starting shape when the workspace
mounts.
Deliberately leaves a halted or retrying queue alone. Lifting a halt is
`recover-persistence`'s job, and it waits for the user to open a file, so
doing it here would release edits the moment the view mounts rather than
when the user acts on them."
[]
(ptk/reify ::initialize-persistence-state
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [queue index status error run-id]} (:persistence state)
commit (get index (peek queue))]
(let [{:keys [queue status run-id]} (:persistence state)]
(cond
(and (seq queue)
(or (not= status :error)
(and (= :save-permission-denied (:code error))
(not (::request-id commit))
(= (:file-id commit) (:current-file-id state))
(dm/get-in state [:permissions :can-edit]))))
;; A commit left queued by a previous session, with no runner.
(queue-needs-a-runner? (:persistence state))
(rx/of (resume-persistence))
;; Nothing queued and nothing in flight: there is nothing to save.
(and (empty? queue)
(not= status :error)
(or run-id (#{:pending :saving} status)))
(rx/of (update-status :saved)))))))
(rx/of (update-status :saved))
:else
(rx/empty))))))
(defn- recover-persistence
"Lifts a halted queue when a file is opened again or the role changes.
Leaving the workspace suspends retries (`suspend-retries`), so opening a
file (`opened-file?`) restores them, resends a retrying episode whose
backoff was cut short, and sends a failure the slow cycle still covers
(`slow-retry-pending?`) once more instead of dropping it.
Every other terminal failure is permanent for that file: permission lost,
file gone, or changes the server refuses. None of them can succeed on a
resend, so opening a file releases them instead of replaying them.
Retaining them until here is deliberate: it is what keeps
`wait-persisted-or-error` rejecting, which is what stops
`workspace/versions.cljs` from building a snapshot out of unsaved edits.
A lost permission is not a temporary condition. The backend raises
`:not-found` for it, and replaying the save to find that out routes the
user to the exception page."
[opened-file?]
(ptk/reify ::recover-persistence
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [queue status run-id suspended]} (:persistence state)]
(rx/concat
(if (and opened-file? suspended)
(rx/of (restore-retries))
(rx/empty))
(cond
;; A live retry episode owns its recovery through the backoff
;; scheduler; resuming here would bypass the attempt budget.
;; A suspended one has no scheduler left.
(= :retrying status)
(if (and opened-file? suspended)
(rx/of (resume-persistence))
(rx/empty))
(slow-retry-pending? (:persistence state))
(rx/of (resume-persistence true))
(= :error status)
(rx/of (release-failed-file) (resume-persistence))
(queue-needs-a-runner? (:persistence state))
(rx/of (resume-persistence))
(and (empty? queue) (or run-id (#{:pending :saving} status)))
(rx/of (update-status :saved))
:else
(rx/empty)))))))
(def ^:private xf-mapcat-undo
(mapcat :undo-changes))
@ -415,6 +758,31 @@
(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, never one
suspended outside the workspace."
[]
(ptk/reify ::resume-on-online
ptk/WatchEvent
(watch [_ state _]
(let [{:keys [status queue suspended]} (:persistence state)]
(if (and (seq queue) (= :retrying status) (not suspended))
(rx/of (run-persistence-task))
(rx/empty))))))
(defn- sync-unload-guard
"Turns the browser's leave-page warning on while edits are unsaved:
buffered, queued, or retained after a failed save."
[buffered?]
(ptk/reify ::sync-unload-guard
ptk/EffectEvent
(effect [_ state _]
(if (or buffered? (seq (dm/get-in state [:persistence :queue])))
(swap! st/ongoing-tasks conj :persistence)
(swap! st/ongoing-tasks disj :persistence)))))
(defn initialize-persistence
[]
(ptk/reify ::initialize-persistence
@ -423,6 +791,9 @@
(log/debug :hint "initialize persistence")
(let [stoper-s (rx/filter (ptk/type? ::initialize-persistence) stream)
;; True while local commits wait in the buffer for the next flush.
buffered? (volatile! false)
local-commits-s
(->> stream
(rx/filter dch/commit?)
@ -440,22 +811,51 @@
(rx/filter #(= % ::force-persist))))]
(rx/merge
(rx/of (recover-persistence))
(rx/of (initialize-persistence-state))
(->> stream
(rx/filter (ptk/type? ::dw/finalize-workspace))
(rx/map (fn [_] (suspend-retries)))
(rx/take-until stoper-s))
(->> stream
(rx/filter #(or (ptk/type? ::dc/change-team-role %)
(ptk/type? ::dw/workspace-initialized %)))
(rx/map (fn [_] (recover-persistence)))
(rx/map #(recover-persistence (ptk/type? ::dw/workspace-initialized %)))
(rx/take-until stoper-s))
(->> (rx/interval saving-check-interval-ms)
(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))
;; Syncs the leave-page warning on every local commit and on every
;; queue change (append after a flush, discard after a save,
;; release of a failed file).
(->> (rx/merge
(rx/of false)
(->> local-commits-s
(rx/map (fn [_] (vreset! buffered? true))))
(->> stream
(rx/filter #(or (ptk/type? ::append-commit %)
(ptk/type? ::discard-commit %)
(ptk/type? ::release-failed-file %)))
(rx/map (fn [_] @buffered?))))
(rx/map sync-unload-guard)
(rx/take-until stoper-s))
(->> local-commits-s
(rx/debounce 200)
(rx/map (fn [_]
@ -468,6 +868,7 @@
(->> local-commits-s
(rx/take-until stoper-s)
(rx/buffer-until notifier-s)
(rx/tap (fn [_] (vreset! buffered? false)))
(rx/mapcat merge-commit)
(rx/map append-commit)
(rx/finalize (fn []

24
frontend/src/app/main/data/workspace.cljs
View File

@ -9,6 +9,7 @@
[app.common.attrs :as attrs]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.files.changes :as cpc]
[app.common.files.changes-builder :as pcb]
[app.common.files.helpers :as cfh]
[app.common.files.variant :as cfv]
@ -321,6 +322,22 @@
:file-id file-id
:team-id team-id)))))))
(defn- restore-pending-changes
"Applies the edits still waiting to be saved to a freshly loaded `file`.
An edit that no longer applies to the loaded data leaves the file as the
server sent it; the save queue keeps the edits either way."
[state file]
(let [changes (dps/pending-file-changes state file)]
(if (empty? changes)
file
(try
(update file :data cpc/process-changes changes false)
(catch :default cause
(log/wrn :hint "unable to restore pending changes"
:file-id (dm/str (:id file))
:cause cause)
file)))))
(defn- bundle-fetched
[{:keys [file file-id thumbnails] :as bundle}]
(ptk/reify ::bundle-fetched
@ -330,9 +347,10 @@
ptk/UpdateEvent
(update [_ state]
(-> state
(assoc :thumbnails (d/update-vals thumbnails (fn [uri] {:uri uri :rendered-at nil})))
(update :files assoc file-id file)))))
(let [file (restore-pending-changes state file)]
(-> state
(assoc :thumbnails (d/update-vals thumbnails (fn [uri] {:uri uri :rendered-at nil})))
(update :files assoc file-id file))))))
(defn zoom-to-frame
[]

28
frontend/src/app/main/data/workspace/fix_deleted_fonts.cljs
View File

@ -65,15 +65,18 @@
[{:keys [objects id]}]
(reduce-kv (fn [changes shape-id shape]
(if (shape-has-invalid-font-family?? shape)
(conj changes {:type :mod-obj
:id shape-id
:page-id id
:operations [{:type :set
:attr :content
:val (fix-shape-content shape)}
{:type :set
:attr :position-data
:val nil}]})
(let [fixed-content (fix-shape-content shape)]
(if (not= fixed-content (:content shape))
(conj changes {:type :mod-obj
:id shape-id
:page-id id
:operations [{:type :set
:attr :content
:val fixed-content}
{:type :set
:attr :position-data
:val nil}]})
changes))
changes))
[]
objects))
@ -82,8 +85,11 @@
[fdata]
(reduce-kv (fn [changes _ typography]
(if (has-invalid-font-family? typography)
(conj changes {:type :mod-typography
:typography (fix-typography typography)})
(let [fixed-typography (fix-typography typography)]
(if (not= fixed-typography typography)
(conj changes {:type :mod-typography
:typography fixed-typography})
changes))
changes))
[]
(:typographies fdata)))

501
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]
@ -127,50 +128,269 @@
;; Set the main potok error handler
(reset! st/on-error on-error)
(defn generate-report
;; --- Environment failures
;;
;; Failures caused by the user's environment (connectivity, a degraded or
;; misconfigured service) are not application defects. They are reported to the
;; audit log as compact events and must never reach the internal error reports
;; (`unhandled-exception`/`exception-page`), which trigger alerts.
(def environment-error-types
"Error types produced by the environment rather than by an application
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]
(contains? environment-error-types (:type (ex-data cause))))
(defn- report-context
"Common context header for every report format."
[cause]
(let [team-id (:current-team-id @st/state)
file-id (:current-file-id @st/state)
profile-id (:profile-id @st/state)
data (ex-data cause)]
(with-out-str
(println "Context:")
(println "--------------------")
(println "Timestamp:" (ct/format-inst (ct/now) :rfc1123))
(println "Hint: " (or (:hint data) (ex-message cause) "--"))
(println "Prof ID: " (str (or profile-id "--")))
(println "Team ID: " (str (or team-id "--")))
(when-let [file-id (or (:file-id data) file-id)]
(println "File ID: " (str file-id)))
(println "Version: " (:full cf/version))
(println "HREF: " (rt/get-current-href)))))
(defn- generate-full-report
"Complete report: context, formatted throwable (including `ex-data`) and the
last events."
[cause]
(with-out-str
(print (report-context cause))
(println)
(println
(ex/format-throwable cause))
(println)
(println "Last events:")
(println "--------------------")
(println (st/format-last-events))
(println)))
(defn- generate-compact-report
"Reduced report for environment failures: context plus the error type, code
and uri. It skips the stack trace, the `ex-data` dump (which may contain
request headers) and the last-events list."
[cause]
(let [data (ex-data cause)]
(with-out-str
(print (report-context cause))
(println)
(println "Error:")
(println "--------------------")
(println "Type: " (or (:type data) "--"))
(println "Code: " (or (:code data) "--"))
(when-let [uri (:uri data)]
(println "URI: " uri)))))
(defn generate-report
"Build the report string for `cause`.
`:format` selects the payload: `:full` (default) includes the formatted
throwable and the last events; `:compact` keeps only the context and the
error type/code/uri, for environment failures. The option is accepted both
as keyword arguments and as a trailing map."
[cause & {:keys [format] :or {format :full}}]
(try
(let [team-id (:current-team-id @st/state)
file-id (:current-file-id @st/state)
profile-id (:profile-id @st/state)
data (ex-data cause)]
(case format
:compact (generate-compact-report cause)
(generate-full-report cause))
(catch :default err
(.error js/console "error on generating report" err)
;; Keep this function total: `flash` reserves a report slot before
;; generating it, so returning nil here would consume the slot
;; without emitting anything.
(str "Report generation failed: " (or (ex-message err) "--")
"\nOriginal hint: " (or (ex/get-hint cause) "--")))))
(with-out-str
(println "Context:")
(println "--------------------")
(println "Timestamp:" (ct/format-inst (ct/now) :rfc1123))
(println "Hint: " (or (:hint data) (ex-message cause) "--"))
(println "Prof ID: " (str (or profile-id "--")))
(println "Team ID: " (str (or team-id "--")))
(when-let [file-id (or (:file-id data) file-id)]
(println "File ID: " (str file-id)))
(println "Version: " (:full cf/version))
(println "HREF: " (rt/get-current-href))
(println)
;; --- Error report governor
;;
;; Bounds the volume of reports emitted by a single browser session. Each
;; report carries a fingerprint; the first occurrence is always emitted and
;; repeated occurrences of the same fingerprint within `report-window-ms`
;; are counted but not emitted. The next emitted report carries the number
;; of occurrences since the previous one as `:occurrences`. The report name
;; is part of the fingerprint, so a handled report never coalesces with an
;; unhandled/exception-page report of the same cause.
;;
;; The fingerprint cache is bounded: when it is full, the fingerprint
;; inserted first is evicted (FIFO order), so memory cannot grow without
;; 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.
(println
(ex/format-throwable cause))
(println)
(def report-window-ms
"Minimum time between two reports with the same fingerprint."
(* 2 60 1000))
(println "Last events:")
(println "--------------------")
(println (st/format-last-events))
(println)))
(catch :default cause
(.error js/console "error on generating report" cause)
nil)))
(def max-tracked-fingerprints
"Maximum number of fingerprints kept in the governor cache."
2000)
(defn initial-report-state
[]
{:entries {}
:order #queue []})
(defonce ^:private report-governor
(atom (initial-report-state)))
(defn reset-report-governor!
"Testing helper: clear the governor state."
[]
(reset! report-governor (initial-report-state)))
(defn- label
[v]
(cond
(nil? v) ""
(keyword? v) (name v)
(string? v) v
:else (str v)))
(defn error-fingerprint
"Stable identity of an error, used to group repeated reports.
The report name is part of the identity, so a `handled-exception` report
never coalesces with an `unhandled-exception`/`exception-page` report of
the same cause (those two do reach the error reports and alerts).
Environment failures drop the stack frame: their internal call site is an
implementation detail, and keeping it would fragment the grouping."
[event-name cause]
(let [data (ex-data cause)
ftype (or (:type data) :unknown)
code (or (:code data) :unknown)
hint (or (ex/get-hint cause) "")
base (str (label event-name) "|" (label ftype) "|" (label code) "|"
(str/prune hint 120))]
(if (environment-error? cause)
base
(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
"Drops the fingerprint inserted first. `:order` mirrors the insertion
order of `:entries`, so this is O(1)."
[state]
(let [fingerprint (peek (:order state))]
(-> state
(update :entries dissoc fingerprint)
(update :order pop))))
(defn reserve-report*
"Pure decision step of the report governor.
Given the governor `state`, an error `fingerprint` and the current time in
milliseconds, returns the next governor state with this occurrence's
decision attached: `::emit` tells whether it must be emitted and
`::occurrences` carries the counter (present only when `::emit` is true)."
[state fingerprint now]
(let [entry (get-in state [:entries fingerprint])
emit? (or (nil? entry)
(>= (- now (:emitted-at entry)) report-window-ms))
pending (or (:pending entry) 0)]
(cond
;; New fingerprint: insert it, evicting the oldest when the cache
;; is full.
(and emit? (nil? entry))
(let [state (cond-> state
(>= (count (:entries state)) max-tracked-fingerprints)
(evict-oldest))]
(-> state
(assoc-in [:entries fingerprint] {:emitted-at now :pending 0})
(update :order conj fingerprint)
(assoc ::emit true)
(assoc ::occurrences (inc pending))))
;; Known fingerprint re-emitted after the window: keep its position.
emit?
(-> state
(assoc-in [:entries fingerprint] {:emitted-at now :pending 0})
(assoc ::emit true)
(assoc ::occurrences (inc pending)))
;; Suppressed occurrence: only the counter moves.
:else
(-> state
(update-in [:entries fingerprint :pending] inc)
(assoc ::emit false)
(dissoc ::occurrences)))))
(defn reserve-report!
"Reserve a slot for a report. Returns the updated governor state, whose
`::emit`/`::occurrences` describe the decision for this occurrence."
[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."
[event-name report hint occurrences]
(st/emit!
(ev/event {::ev/name event-name
:hint hint
:href (rt/get-current-href)
:report report
:occurrences occurrences})))
(defn submit-report
"Report the error report to the audit log subsystem"
[& {:keys [event-name report hint] :or {event-name "unhandled-exception"}}]
(when (and (not (str/empty? hint))
(string? report)
"Report the error report to the audit log subsystem, subject to the
report governor.
`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` 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))
(or (string? report) (fn? report))
(string? event-name))
(st/emit!
(ev/event {::ev/name event-name
:hint hint
:href (rt/get-current-href)
:report report}))))
(when-let [{:keys [occurrences]} (reserve! event-name cause)]
(emit-report! event-name
(if (fn? report) (report) report)
hint
occurrences))))
(defn- download-report!
[report event]
@ -180,47 +400,148 @@
(dom/trigger-download-uri "report" "text/plain" uri)
(ts/schedule-on-idle #(wapi/revoke-uri uri))))
(defn- report-format
"Payload format for `cause`: compact for environment failures, full
otherwise."
[cause]
(if (environment-error? cause) :compact :full))
(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 (report-format cause)
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.
A `:tag` lets the notification be hidden later by that tag.
The notification is scheduled asynchronously (via tm/schedule) to
The payload format is derived from the cause: environment failures get a
compact report. The audit event name is the canonical one requested by
`:type` (`handled-exception`/`unhandled-exception`); it is an external
contract, so flash never reclassifies it.
The report is reserved before being generated, so repeated errors that
fall inside the governor window do not pay the report-building cost.
With `:report-link?` the toast always carries a download link: when no
report is emitted (suppressed repeat, empty hint, `:silent`), one is
generated for the link alone, without emitting it.
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
event-processing cycle that can exhaust the JS call stack
(RangeError: Maximum call stack size exceeded)."
[& {:keys [type hint cause timeout report-link?]
[& {:keys [type hint cause timeout tag report-link? links]
:or {type :handled timeout 5000}}]
(let [report (when (ex/exception? cause) (generate-report cause))]
(when report
(when-let [event-name (case type
:handled "handled-exception"
:unhandled "unhandled-exception"
:silent nil)]
(submit-report :event-name event-name
:report report
:hint (ex/get-hint cause))))
(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))
link-report (when report-link?
(or report
(when (ex/exception? cause)
(generate-report cause {:format (report-format cause)}))))
;; The download link comes first because `:report-link?` is
;; what puts the report on the toast at all; caller links are
;; the recovery actions and follow it.
all-links (cond-> []
link-report
(conj {:label (tr "labels.download" "report.txt")
:callback (partial download-report! link-report)})
(seq links) (into links))]
(try (st/emit!
(ntf/show
(cond-> {:content (or ^boolean hint (tr "errors.generic"))
:type :toast
:level :error
:timeout timeout}
(some? tag)
(assoc :tag tag)
(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)}])))))))
(seq all-links)
(assoc :links all-links))))
(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
telemetry with a compact payload: they never reach the internal error
reports and a stack trace adds nothing for a network condition."
[error prefix]
(when-let [cause (::instance error)]
(ex/print-throwable cause :prefix prefix))
(flash :cause (::instance error)
:type :handled
:hint (tr "errors.connection-error")))
(defn- handle-transport-error
"Reports a failure whose answer did not come from the backend. These affect
one request and pass on their own, so the user keeps the page and gets a
toast."
[error prefix]
(when-let [cause (::instance error)]
(ex/print-throwable cause :prefix prefix))
(flash :cause (::instance error) :type :handled))
(defmethod ptk/handle-error :network
[error]
;; Transient network errors (e.g. lost connectivity, DNS failure)
;; should not replace the entire page with an error screen. Show a
;; non-intrusive toast instead and let the user continue working.
(when-let [cause (::instance error)]
(ex/print-throwable cause :prefix "Network Error"))
(flash :cause (::instance error) :type :handled))
(handle-connectivity-error error "Network Error"))
(defmethod ptk/handle-error :offline
[error]
;; Status 0 (browser offline) must not fall through to `:default`:
;; that would report it as an unhandled application error.
(handle-connectivity-error error "Offline Error"))
(defmethod ptk/handle-error :gateway-error
[error]
(handle-connectivity-error error "Gateway Error"))
(defmethod ptk/handle-error :rate-limit
[error]
(handle-transport-error error "Rate Limit Error"))
(defmethod ptk/handle-error :unexpected-response
[error]
(handle-transport-error error "Unexpected Response"))
(def ^:private delegated-persistence-types
"Save failure causes routed to their own error handler: retaining the
@ -234,18 +555,72 @@
;; The retained changes no longer apply to the restored version.
(= :vern-conflict code)))
(def ^:private unhandled-persistence-types
"Save failure causes that are application defects, not expected
outcomes: the client asked for something the server refused, or the
server or our own code broke. They must reach the internal reports and
the alerts, so they are reported as unhandled.
Environment failures are deliberately absent: the user's connection is
not our bug, and they land here once the retry budget is spent.
`:assertion` is absent on purpose too, because its own handler already
reports it as handled."
#{:validation :server-error :internal})
(defn- persistence-report-type
"The audit event name a save failure gets. `persistence-failed` wraps the
original cause under `:type :persistence` and keeps the real type in
`:cause-type`, so `:cause-type` wins: reading `:type` alone would match the
wrapper and never the cause."
[{:keys [type cause-type]}]
(if (contains? unhandled-persistence-types (or cause-type type))
:unhandled
:handled))
(defn- reload-page-link
"Recovery action for a save failure: reload the window.
Persistence stops for the session once a save fails terminally, and
reloading is the only way to get a fresh one without the user having to
know they can also leave the file and come back. `location.reload` is the
pattern used elsewhere in the app for a full restart."
[]
{:label (tr "labels.reload-page")
:callback (fn [event]
(dom/prevent-default event)
(js/location.reload))})
(def persistence-failed-tag
"Tag of the save failure notification, hidden once a save lands."
:persistence-failed)
(defn flash-persistence
[cause]
"Notifies a save failure. With `:retrying` the failure is transient and
the queue keeps trying in the background, so the toast says the changes
are kept and offers no reload, which would lose them."
[cause & {:keys [retrying]}]
(let [data (ex-data cause)]
(if (delegated-persistence-failure? data)
(cond
(delegated-persistence-failure? data)
;; The persistence state wraps the failure and records the original
;; type under :cause-type; dispatch on it to reach the cause's handler.
(on-error (-> (exception->error-data cause)
(assoc :type (or (:cause-type data) (:type data)))))
retrying
(flash :cause cause
:type :handled
:type (persistence-report-type data)
:timeout nil
:tag persistence-failed-tag
:report-link? true
:hint (tr "errors.save-still-retrying"))
:else
(flash :cause cause
:type (persistence-report-type data)
:timeout nil
:tag persistence-failed-tag
:report-link? true
:links [(reload-page-link)]
:hint (tr "errors.save-failed")))))
(defmethod ptk/handle-error :persistence

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

@ -23,12 +23,16 @@
;; -- 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
:gateway-error ; 504 and the Cloudflare 52x family
:offline}) ; status 0 (browser offline)
(defn retryable-error?
@ -76,6 +80,28 @@
;; -- Response handling -------------------------------------------------------
(def ^:private gateway-statuses
"Statuses raised by an edge proxy when the request never reached the
backend or its answer never came back."
#{504 ; gateway timeout
520 ; cloudflare: unknown origin error
521 ; cloudflare: origin is down
522 ; cloudflare: connection timed out
523 ; cloudflare: origin unreachable
524}) ; cloudflare: origin timed out
(def ^:private max-body-excerpt
"Number of characters kept from a body that we could not interpret."
500)
(defn- body-excerpt
"Keeps the head of an uninterpretable body. Error pages from proxies run
into tens of kilobytes and the excerpt is enough to recognize them."
[body]
(if (and (string? body) (> (count body) max-body-excerpt))
(str (subs body 0 max-body-excerpt) "...")
body))
(defn handle-response
[{:keys [status body headers uri] :as response}]
(cond
@ -118,6 +144,35 @@
(and (>= status 400) (map? body))
(rx/throw (ex-info "http error" (assoc body :uri uri :status status)))
;; The branches below handle responses the backend never wrote: the
;; body carries no error code, so the status is all we can read.
(contains? gateway-statuses status)
(rx/throw
(ex/error :type :gateway-error
:code :gateway-error
:hint "the request did not reach the backend"
:uri uri
:status status))
(= 429 status)
(rx/throw
(ex/error :type :rate-limit
:code :rate-limited
:hint "too many requests"
:uri uri
:status status))
(>= status 400)
(rx/throw
(ex/error :type :unexpected-response
:code :unexpected-error-response
:hint "unexpected error response"
:uri uri
:status status
:headers headers
:data (body-excerpt body)))
:else
(rx/throw
(ex/error :type :internal
@ -126,7 +181,7 @@
:uri uri
:status status
:headers headers
:data body))))
:data (body-excerpt body)))))
(def default-options
{:update-file {:query-params [:id]}

9
frontend/src/app/main/store.cljs
View File

@ -84,6 +84,7 @@
(let [buffer (atom [])
omitset #{:potok.v2.core/undefined
:app.main.data.workspace.persistence/update-persistence-status
:app.main.data.persistence/sync-unload-guard
:app.main.data.websocket/send-message
:app.main.data.workspace.notifications/handle-pointer-send
:app.main.router/assign-exception}]
@ -145,6 +146,8 @@
(add-watch ongoing-tasks ::ongoing-tasks
(fn [_ _ _ events]
(if (empty? events)
(obj/set! js/window "onbeforeunload" nil)
(obj/set! js/window "onbeforeunload" (constantly false)))))
;; No `window` outside the browser.
(when (exists? js/window)
(if (empty? events)
(obj/set! js/window "onbeforeunload" nil)
(obj/set! js/window "onbeforeunload" (constantly false))))))

20
frontend/src/app/main/ui/static.cljs
View File

@ -560,21 +560,25 @@
(mf/defc exception-section*
{::mf/private true}
[{:keys [data] :as props}]
(let [type (get data :type)
cause (get data ::errors/instance)
(let [type (get data :type)
cause (get data ::errors/instance)
environment (errors/environment-error? cause)
report (mf/with-memo [cause]
(when (ex/exception? cause)
(errors/generate-report cause)))
report (mf/with-memo [cause]
(when (ex/exception? cause)
(errors/generate-report cause {:format (if environment :compact :full)})))
props (mf/spread-props props {:report report})]
props (mf/spread-props props {:report report})]
(mf/with-effect [report type cause]
(when (and (ex/exception? cause)
(not (contains? #{:not-found :authentication} type)))
(errors/submit-report :event-name "exception-page"
;; Environment pages are audit-only: they use the canonical
;; `handled-exception` event instead of `exception-page`.
(errors/submit-report :event-name (if environment "handled-exception" "exception-page")
:report report
:hint (ex/get-hint cause))))
:hint (ex/get-hint cause)
:cause cause)))
(case type
:not-found

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);
}

81
frontend/src/debug.cljs
View File

@ -374,6 +374,87 @@
(.text response))
(p/then apply-changes)))
(def ^:private simulated-error-body
"Stands in for the error page a proxy or CDN writes when it answers instead
of the backend."
"<html><head><title>Simulated error</title></head><body>simulated intermediary response</body></html>")
(defonce ^:private pending-http-error (atom nil))
(defn- simulated-status
"Status to answer `uri` with, or nil to let the request through. A
simulation without a deadline answers one call; one with a deadline answers
every matching call until it runs out."
[uri]
(let [{:keys [method status until]} @pending-http-error]
(when (and (some? method)
(str/includes? uri (str "/api/main/methods/" method)))
(cond
(nil? until) (do (reset! pending-http-error nil) status)
(< (js/Date.now) until) status
:else (do (reset! pending-http-error nil) nil)))))
;; The original fetch and the wrapper standing in for it, or nil when unhooked.
(defonce ^:private http-error-hook (atom nil))
(defn- install-http-error-hook!
[]
(when (nil? @http-error-hook)
(let [original (unchecked-get js/globalThis "fetch")
wrapper (fn [input params]
(let [uri (if (string? input) input (unchecked-get input "url"))]
(if-let [status (simulated-status uri)]
(p/resolved (js/Response. simulated-error-body
#js {:status status
:headers #js {"content-type" "text/html"}}))
(.call original js/globalThis input params))))]
(reset! http-error-hook {:original original :wrapper wrapper})
(unchecked-set js/globalThis "fetch" wrapper))))
(defn- remove-http-error-hook!
[]
(when-let [{:keys [original wrapper]} @http-error-hook]
;; Restore only while the wrapper is still installed, so a later
;; wrapper survives.
(when (identical? wrapper (unchecked-get js/globalThis "fetch"))
(unchecked-set js/globalThis "fetch" original))
(reset! http-error-hook nil)))
(defn ^:export simulateHttpError
"Answers calls to an API method with `status` and a body that carries no
Penpot error code, the way a CDN or a corporate proxy does. Every other
request goes through untouched.
Without `seconds` the simulation is spent once it answers one call. With
`seconds` it answers every matching call for that long, which is how to
watch a save retry, warn, keep retrying and finally recover.
debug.simulateHttpError('update-file')
debug.simulateHttpError('get-comment-threads', 403)
debug.simulateHttpError('update-file', 524, 120)"
([method]
(simulateHttpError method 524 nil))
([method status]
(simulateHttpError method status nil))
([method status seconds]
(install-http-error-hook!)
(let [until (when (and (number? seconds) (pos? seconds))
(+ (js/Date.now) (* 1000 seconds)))]
(reset! pending-http-error {:method method
:status status
:until until})
(if (some? until)
(str "every " method " call will be answered with " status
" for the next " seconds " seconds")
(str "the next " method " call will be answered with " status)))))
(defn ^:export clearHttpErrorSimulation
"Stops a running simulation and takes the wrapper off `fetch`."
[]
(reset! pending-http-error nil)
(remove-http-error-hook!)
"requests reach the backend again")
(defn ^:export reset-viewport
[]
(st/emit!

75
frontend/test/frontend_tests/data/fix_deleted_fonts_test.cljs Normal file
View File

@ -0,0 +1,75 @@
;; 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 INC Sucursal en España SL
(ns frontend-tests.data.fix-deleted-fonts-test
(:require
[app.common.test-helpers.files :as cthf]
[app.common.test-helpers.ids-map :as cthi]
[app.common.test-helpers.shapes :as cths]
[app.common.types.shape :as cts]
[app.common.types.text :as txt]
[app.main.data.changes :as dwc]
[app.main.data.workspace.fix-deleted-fonts :as fdf]
[app.main.fonts :as fonts]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[frontend-tests.helpers.state :as ths]
[potok.v2.core :as ptk]))
(t/use-fixtures :each
{:before cthi/reset-idmap!})
(def ^:private missing-font-id
"custom-missing-font-id")
(defn- text-content-with-font
[text font-id font-family]
(-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width})
:content
(txt/change-text text :font-id font-id :font-family font-family)))
(defn- file-with-text-shape
[font-id font-family]
(-> (cthf/sample-file :file1 :page-label :page1)
(cths/add-sample-shape :text
{:type :text
:content (text-content-with-font "TEST"
font-id
font-family)})))
(defn- watch-fix-deleted-fonts-events
[file]
(let [events (atom [])
store (ths/setup-store file)
state @store]
(when-let [result (ptk/watch (fdf/fix-deleted-fonts-for-page (:id file)
(cthf/current-page-id file))
state
(rx/empty))]
(->> result (rx/subs! #(swap! events conj %))))
@events))
(t/deftest fix-deleted-fonts-skips-unfixable-missing-font
(let [file (file-with-text-shape missing-font-id "Gibson")
events (watch-fix-deleted-fonts-events file)]
(t/is (empty? events)
"missing custom fonts with no replacement must not commit changes")))
(t/deftest fix-deleted-fonts-remaps-when-replacement-exists
(let [replacement-id "custom-gibson-replacement"
cleanup #(swap! fonts/fontsdb dissoc replacement-id)]
(try
(swap! fonts/fontsdb assoc replacement-id
{:id replacement-id
:family "Gibson"
:name "Gibson"
:variants []})
(let [file (file-with-text-shape missing-font-id "Gibson")
events (watch-fix-deleted-fonts-events file)]
(t/is (= 1 (count events)))
(t/is (ptk/type? ::dwc/commit-changes (first events))))
(finally
(cleanup)))))

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

@ -0,0 +1,884 @@
;; 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 INC Sucursal en España 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, flash and
the leave-page task set (`:tasks`), 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 [])
tasks (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))
st/ongoing-tasks tasks}
(try
(ptk/emit! store (dps/initialize-persistence))
(await (f {:file-id file-id :response response :failures failures
:requests requests :store store :tasks tasks}))
(finally
(rx/dispose! store)
(rx/end! response))))))
(defn- instant-backoff
"Timer double: the backoff delays fire at once and the slow cycle never
does, so a failure that outlasts the backoff settles in `:error`."
[ms]
(if (= ms dps/slow-retry-delay-ms)
(rx/subject)
(rx/of :tick)))
(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`, slow cycle held), 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 instant-backoff)}
(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 instant-backoff)}
(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})))))))
(defn- check-gateway-response-retries
"Answers the first send with a proxy error page for `status`, built by the
real `rp/handle-response`, and the retry with a valid revision. The save
must take the retry path and land, never halt in `:error`."
[status]
(let [calls (atom 0)]
(with-persistence
(^:async fn [{:keys [file-id failures requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub instant-backoff)}
(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])))
(str "a " status " is retried and the save lands")))
(t/is (= 2 (count @requests)) "the proxy error plus one retry")
(t/is (empty? @failures) "a retried proxy error never reaches the failure toast"))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rp/handle-response {:status status
:headers {"content-type" "text/html"}
:body "<html><body>Gateway Timeout</body></html>"
:uri "https://penpot.example.com/api/main/methods/update-file"})
(rx/of {:revn 1}))))))
;; Variant: the proxy in front of the backend timed out.
(t/deftest ^:async gateway-timeout-save-is-retried
(await (check-gateway-response-retries 504)))
;; Variant: Cloudflare gave up waiting for the origin.
(t/deftest ^:async cloudflare-origin-timeout-save-is-retried
(await (check-gateway-response-retries 524)))
;; 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) (instant-backoff ms)))}
(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 dps/slow-retry-delay-ms] @delays)
"the backoff schedule fires in order, then the slow cycle is armed")
(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, let the
;; online signal resend the head (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 — the online signal resends the head under the live
;; episode (status stays :retrying), hanging in flight.
(ptk/emit! store (#'dps/resume-on-online))
(await (async/wait-for #(= 2 (count @requests)) "online 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 (= 1 (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 send outside the
;; backoff schedule; 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 new edit lands while the episode waits on its backoff timer.
;; The edit only joins the queue: nothing is sent and no attempt is spent
;; until the timer fires. The retry then saves the head and the runner
;; sends the new edit after it. Proves: edits during an episode never
;; bypass the backoff nor consume the retry budget.
(t/deftest ^:async new-edit-during-retry-waits-for-the-backoff
(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 joins the queue without resending.
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 2 (count (get-in @store [:persistence :queue])))
"second edit is queued"))
(await (async/settle))
(t/is (= 1 (count @requests)) "the edit does not resend the head")
(t/is (= 1 (get-in @store [:persistence :attempts])) "no attempt is spent")
(t/is (= [2000] @delays) "the pending backoff is kept")
(t/is (= :retrying (get-in @store [:persistence :status])))
;; Phase 3 — the timer fires: the head saves, then the new edit.
(rx/push! timer-s :tick)
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"both edits save"))
(t/is (= 3 (count @requests)) "failed send, retry, then the new edit")
(let [[first-id retry-id edit-id] (map (comp :commit-id second) @requests)]
(t/is (= first-id retry-id) "the retry resends the head")
(t/is (not= retry-id edit-id) "the new edit is sent after the head"))
(rx/end! timer-s))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/throw (ex-info "offline" {:type :offline}))
(rx/of {:revn @calls})))))))
;; 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 instant-backoff)}
(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, the retry timer 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 — the retry timer fires and resends the head,
;; hanging in flight.
(rx/push! timer-s :tick)
(await (async/wait-for #(= 2 (count @requests)) "retry 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")
st/ongoing-tasks (atom #{})}
(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)))))))
;; Scenario: the first send never answers. The request timeout fails it as
;; a transient error, and the retry resends the same commit and saves. The
;; timeout is shortened by wrapping the real operator. Proves: a hung save
;; does not block the queue.
(t/deftest ^:async hung-save-request-times-out-and-retries
(let [calls (atom 0)
timeouts (atom [])
timeout rx/timeout]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub instant-backoff)
rx/timeout (mock/stub (fn [ms with ob]
(swap! timeouts conj ms)
(timeout 0 with ob)))}
(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])))
"the retry saves the file"))
(t/is (= 2 (count @requests)) "hung send plus one retry")
(t/is (apply = (map (comp :commit-id second) @requests))
"both sends carry the same commit id")
(t/is (= [420000 420000] @timeouts) "every send gets the 7 minute timeout"))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/subject)
(rx/of {:revn 1})))))))
;; ---------------------------------------------------------------------------
;; slow cycle
;; ---------------------------------------------------------------------------
(defn- slow-cycle-timer
"Timer double: the backoff delays fire at once, and every slow cycle waits
on a subject collected in `cycles`, so the test fires them one by one."
[cycles]
(fn [ms]
(if (= ms dps/slow-retry-delay-ms)
(let [cycle-s (rx/subject)]
(swap! cycles conj cycle-s)
cycle-s)
(rx/of :tick))))
;; Scenario: the backoff is spent while the network is down. The queue keeps
;; trying on the slow cycle, one send per cycle, without warning the user
;; again, and saves once the network is back. Proves: a session outlasting
;; the backoff still recovers on its own.
(t/deftest ^:async a-spent-backoff-keeps-trying-on-a-slow-cycle
(let [calls (atom 0)
cycles (atom [])]
(await
(with-persistence
(^:async fn [{:keys [file-id failures requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (slow-cycle-timer cycles))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(and (= :error (get-in @store [:persistence :status]))
(= 1 (count @cycles)))
"the spent backoff arms the slow cycle"))
(t/is (= 4 (count @requests)))
(t/is (= 1 (count @failures)))
(rx/push! (last @cycles) :tick)
(await (async/wait-for #(= 2 (count @cycles))
"a failed slow attempt arms the next cycle"))
(t/is (= 5 (count @requests)) "a slow cycle sends once")
(t/is (= :error (get-in @store [:persistence :status])))
(t/is (= 1 (count @failures)) "the user is not warned again")
;; The warning the first failure left on screen.
(ptk/emit! store #(assoc % :notification {:tag errors/persistence-failed-tag
:level :error}))
(rx/push! (last @cycles) :tick)
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"the slow attempt saves"))
(t/is (= 6 (count @requests)))
(t/is (apply = (map (comp :commit-id second) @requests))
"every attempt carries the same commit id")
(t/is (nil? (get-in @store [:persistence :recovering])))
(t/is (nil? (get-in @store [:persistence :failing-since])))
(t/is (nil? (get @store :notification))
"the failure warning goes away once the save lands"))))
(fn [_ _]
(if (< (swap! calls inc) 6)
(rx/throw (ex-info "offline" {:type :offline}))
(rx/of {:revn 1})))))))
;; Scenario: a gateway error outlasts the backoff, then the proxy recovers.
;; Proves: each gateway status takes the slow cycle and saves the held edit.
(t/deftest ^:async a-gateway-error-arms-the-slow-cycle
(doseq [status [504 520 521 522 523 524]]
(let [calls (atom 0)
cycles (atom [])]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (slow-cycle-timer cycles))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 1 (count @cycles))
(str status " arms the slow cycle")))
(t/is (= 4 (count @requests)))
(t/is (= :gateway-error (get-in @store [:persistence :error :cause-type])))
(t/is (= 1 (count (get-in @store [:persistence :queue]))))
(rx/push! (last @cycles) :tick)
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
(str status " recovers on the slow cycle")))
(t/is (= 5 (count @requests)))
(t/is (apply = (map (comp :commit-id second) @requests))
"the slow cycle saves the held commit"))))
(fn [_ _]
(if (<= (swap! calls inc) 4)
(rp/handle-response {:status status :body "<html>Gateway error</html>" :uri "/api"})
(rx/of {:revn 1}))))))))
;; Scenario: a save fails for a reason no attempt can get past. Proves: only
;; transport failures arm the slow cycle.
(t/deftest ^:async a-terminal-failure-does-not-arm-the-slow-cycle
(let [cycles (atom [])]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (slow-cycle-timer cycles))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= :error (get-in @store [:persistence :status]))
"the save fails"))
(await (async/settle))
(t/is (= 1 (count @requests)))
(t/is (empty? @cycles)))))
(fn [_ _] (rx/throw (ex-info "Validation failed" {:type :validation})))))))
;; Scenario: a gateway answers 504 only after its own timeout, while the
;; backend may still be applying the save. Proves: slow failures below the
;; limit still arm the slow cycle; at the limit the save stops being sent,
;; and opening a file releases it instead of sending it again.
(t/deftest ^:async slow-failures-stop-the-slow-cycle-at-the-limit
(doseq [[slow-count armed?] [[(dec dps/max-slow-failures) true]
[dps/max-slow-failures false]]]
(let [clock (atom 0)
calls (atom 0)
cycles (atom [])]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (slow-cycle-timer cycles))
ct/now (mock/stub #(ct/inst @clock))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= :error (get-in @store [:persistence :status]))
(str slow-count " slow failures spend the backoff")))
(await (async/settle))
(t/is (= 4 (count @requests)))
(t/is (= slow-count (get-in @store [:persistence :slow-failures])))
(t/is (= (if armed? 1 0) (count @cycles))
(str slow-count " slow failures " (if armed? "arm" "do not arm") " the slow cycle"))
(when-not armed?
(ptk/emit! store (ptk/data-event :app.main.data.common/change-team-role))
(await (async/wait-for #(empty? (get-in @store [:persistence :queue]))
"recovery releases the held edit"))
(t/is (= 4 (count @requests)) "the released edit is not sent again")))))
(fn [_ _]
(when (<= (swap! calls inc) slow-count)
(swap! clock + dps/slow-failure-ms))
(rp/handle-response {:status 504 :body "<html>Gateway timeout</html>" :uri "/api"})))))))
;; Scenario: the slow cycle is still failing when the retry window closes.
;; Proves: the cycle gives up, keeping the edits queued.
(t/deftest ^:async the-slow-cycle-stops-when-the-retry-window-closes
(let [clock (atom 0)
cycles (atom [])]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (slow-cycle-timer cycles))
ct/now (mock/stub #(ct/inst @clock))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 1 (count @cycles)) "the slow cycle is armed"))
(reset! clock (+ dps/retry-give-up-ms 1000))
(rx/push! (last @cycles) :tick)
(await (async/wait-for #(= 5 (count @requests)) "the last slow attempt"))
(await (async/wait-for #(= :error (get-in @store [:persistence :status]))
"the attempt fails"))
(await (async/settle))
(t/is (= 1 (count @cycles)) "no further cycle is armed")
(t/is (= 1 (count (get-in @store [:persistence :queue])))))))
(fn [_ _] (rx/throw (ex-info "offline" {:type :offline})))))))
;; Scenario: the backoff is spent and the user leaves the workspace, which
;; stops the slow cycle, then opens a file again. Recovery sends the queue
;; once more instead of releasing it, and it saves. Proves: edits held by a
;; transport failure are never dropped by recovery.
(t/deftest ^:async recovery-resends-a-transport-failure-instead-of-releasing-it
(let [calls (atom 0)
cycles (atom [])]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (slow-cycle-timer cycles))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 1 (count @cycles)) "the slow cycle is armed"))
(ptk/emit! store (ptk/data-event :app.main.data.workspace/finalize-workspace))
(ptk/emit! store (ptk/data-event :app.main.data.common/change-team-role))
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"recovery saves the held edit"))
(t/is (= 5 (count @requests)))
(t/is (apply = (map (comp :commit-id second) @requests))
"recovery sends the same commit, not a released queue"))))
(fn [_ _]
(if (< (swap! calls inc) 5)
(rx/throw (ex-info "offline" {:type :offline}))
(rx/of {:revn 1})))))))
;; Leaving the workspace tests.
;; Scenario: a save fails on a transport error and the user leaves the
;; workspace before the backoff fires. The pending retry stays silent, and
;; opening a file sends the held edit again. Proves: the backoff does not
;; run outside the workspace and resumes once a file is opened.
(t/deftest ^:async leaving-the-workspace-stops-the-backoff
(let [calls (atom 0)
timers (atom [])]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_]
(let [timer-s (rx/subject)]
(swap! timers conj timer-s)
timer-s)))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 1 (count @timers)) "the failure schedules a retry"))
(ptk/emit! store (ptk/data-event :app.main.data.workspace/finalize-workspace))
(await (async/wait-for #(get-in @store [:persistence :suspended])
"leaving the workspace suspends retries"))
(rx/push! (first @timers) :tick)
(await (async/settle))
(t/is (= 1 (count @requests)) "the pending retry stays silent")
(t/is (= :retrying (get-in @store [:persistence :status])))
(t/is (= 1 (count (get-in @store [:persistence :queue]))))
(ptk/emit! store (ptk/data-event :app.main.data.workspace/workspace-initialized))
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"opening a file saves the held edit"))
(t/is (= 2 (count @requests)))
(t/is (apply = (map (comp :commit-id second) @requests))
"the same commit is sent again")
(t/is (nil? (get-in @store [:persistence :suspended]))))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/throw (ex-info "offline" {:type :offline}))
(rx/of {:revn 1})))))))
;; Scenario: the user leaves the workspace while a save is in flight, and the
;; save then fails on a transport error. No backoff is scheduled, the online
;; event does not resend, and opening a file does. Proves: a failure that
;; lands outside the workspace waits for the user instead of retrying there.
(t/deftest ^:async a-failure-after-leaving-the-workspace-arms-no-retry
(let [calls (atom 0)
timers (atom [])
first-s (rx/subject)]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [ms] (swap! timers conj ms) (rx/subject)))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the edit is sent"))
(ptk/emit! store (ptk/data-event :app.main.data.workspace/finalize-workspace))
(await (async/wait-for #(get-in @store [:persistence :suspended])
"leaving the workspace suspends retries"))
(rx/error! first-s (ex-info "offline" {:type :offline}))
(await (async/wait-for #(= :retrying (get-in @store [:persistence :status]))
"the failure keeps the edit queued"))
(await (async/settle))
(t/is (empty? @timers) "no backoff is scheduled")
(ptk/emit! store (#'dps/resume-on-online))
(await (async/settle))
(t/is (= 1 (count @requests)) "the online event does not resend")
(ptk/emit! store (ptk/data-event :app.main.data.workspace/workspace-initialized))
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"opening a file saves the held edit"))
(t/is (= 2 (count @requests))))))
(fn [_ _]
(if (= 1 (swap! calls inc))
first-s
(rx/of {:revn 1})))))))
;; Scenario: the last backoff attempt is in flight when the user leaves the
;; workspace, and it fails. The queue halts without arming the slow cycle,
;; and opening a file sends it once more. Proves: the slow cycle never
;; starts outside the workspace.
(t/deftest ^:async a-spent-backoff-outside-the-workspace-arms-no-slow-cycle
(let [calls (atom 0)
cycles (atom [])
last-s (rx/subject)]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (slow-cycle-timer cycles))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 4 (count @requests)) "the last retry is sent"))
(ptk/emit! store (ptk/data-event :app.main.data.workspace/finalize-workspace))
(await (async/wait-for #(get-in @store [:persistence :suspended])
"leaving the workspace suspends retries"))
(rx/error! last-s (ex-info "offline" {:type :offline}))
(await (async/wait-for #(= :error (get-in @store [:persistence :status]))
"the spent backoff halts the queue"))
(await (async/settle))
(t/is (empty? @cycles) "no slow cycle is armed")
(t/is (= 1 (count (get-in @store [:persistence :queue]))))
(ptk/emit! store (ptk/data-event :app.main.data.workspace/workspace-initialized))
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"opening a file saves the held edit"))
(t/is (= 5 (count @requests))))))
(fn [_ _]
(let [n (swap! calls inc)]
(cond
(< n 4) (rx/throw (ex-info "offline" {:type :offline}))
(= n 4) last-s
:else (rx/of {:revn 1}))))))))

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

File diff suppressed because it is too large Load Diff

128
frontend/test/frontend_tests/data/repo_test.cljs
View File

@ -8,7 +8,8 @@
(:require
[app.main.repo :as repo]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]))
[cljs.test :as t :include-macros true]
[cuerdas.core :as str]))
;; ---------------------------------------------------------------------------
;; retryable-error? tests (synchronous)
@ -29,6 +30,11 @@
(let [err (ex-info "service unavailable" {:type :service-unavailable})]
(t/is (true? (repo/retryable-error? err))))))
(t/deftest retryable-error-gateway-error
(t/testing "504 and the Cloudflare 52x family are retryable"
(let [err (ex-info "http error" {:type :gateway-error})]
(t/is (true? (repo/retryable-error? err))))))
(t/deftest retryable-error-offline
(t/testing "offline (status 0) is retryable"
(let [err (ex-info "offline" {:type :offline})]
@ -215,3 +221,123 @@
(t/is (= 2 @call-count))
(t/is (= :authentication (:type (ex-data err))))
(done))))))))
;; ---------------------------------------------------------------------------
;; handle-response classification tests
;; ---------------------------------------------------------------------------
(defn- capture-error
"Subscribes to `handle-response` for `response` and calls `k` with the
`ex-data` of the raised error."
[response k]
(->> (repo/handle-response response)
(rx/subs!
(fn [_] (t/is false "expected an error response") (k nil))
(fn [cause] (k (ex-data cause))))))
(def ^:private html-error-page
"<html><head><title>Web Page Blocked</title></head><body>blocked</body></html>")
(t/deftest handle-response-gateway-statuses
(t/testing "every edge status that never reached the backend is a gateway error"
(t/async done
(let [statuses [504 520 521 522 523 524]
pending (atom (count statuses))]
(doseq [status statuses]
(capture-error {:status status
:body html-error-page
:headers {"content-type" "text/html"}
:uri "https://design.penpot.app/api/main/methods/get-teams"}
(fn [data]
(t/is (= :gateway-error (:type data))
(str "status " status " should be a gateway error"))
(t/is (= status (:status data))
(str "status " status " should be carried through"))
(when (zero? (swap! pending dec))
(done)))))))))
(t/deftest handle-response-rate-limit
(t/testing "a 429 with no interpretable body is a rate-limit error"
(t/async done
(capture-error {:status 429
:body ""
:headers {}
:uri "https://design.penpot.app/api/main/methods/get-teams"}
(fn [data]
(t/is (= :rate-limit (:type data)))
(t/is (= 429 (:status data)))
(done))))))
(t/deftest handle-response-intercepted-by-proxy
(t/testing "an error page from a filtering proxy is not an internal error"
(t/async done
(capture-error {:status 403
:body html-error-page
:headers {"content-type" "text/html"
"server" "Zscaler/6.2"}
:uri "https://design.penpot.app/api/main/methods/update-file"}
(fn [data]
(t/is (= :unexpected-response (:type data)))
(t/is (= 403 (:status data)))
(done))))))
(t/deftest handle-response-keeps-body-excerpt
(t/testing "a body too long to keep is cut short and marked as cut"
(t/async done
(capture-error {:status 403
:body (apply str (repeat 5000 "x"))
:headers {"content-type" "text/html"}
:uri "https://design.penpot.app/api/main/methods/update-file"}
(fn [data]
(t/is (= 503 (count (:data data))) "500 characters and an ellipsis")
(t/is (str/ends-with? (:data data) "..."))
(done))))))
(t/deftest handle-response-keeps-a-short-body-whole
(t/testing "a body short enough to read is passed through untouched"
(t/async done
(capture-error {:status 403
:body html-error-page
:headers {"content-type" "text/html"}
:uri "https://design.penpot.app/api/main/methods/update-file"}
(fn [data]
(t/is (= html-error-page (:data data)))
(done))))))
(t/deftest handle-response-challenge-still-authorization
(t/testing "a Cloudflare challenge keeps its own type"
(t/async done
(capture-error {:status 403
:body html-error-page
:headers {"server" "cloudflare"
"cf-mitigated" "challenge"}
:uri "https://design.penpot.app/api/main/methods/get-teams"}
(fn [data]
(t/is (= :authorization (:type data)))
(t/is (= :challenge-required (:code data)))
(done))))))
(t/deftest handle-response-keeps-backend-error
(t/testing "an error the backend itself reported is passed through untouched"
(t/async done
(capture-error {:status 400
:body {:type :validation :code :missing-param}
:headers {"content-type" "application/transit+json"}
:uri "https://design.penpot.app/api/main/methods/update-file"}
(fn [data]
(t/is (= :validation (:type data)))
(t/is (= :missing-param (:code data)))
(t/is (= 400 (:status data)))
(done))))))
(t/deftest handle-response-undecodable-non-error-is-internal
(t/testing "a non-error response we cannot interpret is still an internal error"
(t/async done
(capture-error {:status 301
:body html-error-page
:headers {"content-type" "text/html"}
:uri "https://design.penpot.app/api/main/methods/get-teams"}
(fn [data]
(t/is (= :internal (:type data)))
(t/is (= :unable-to-process-repository-response (:code data)))
(done))))))

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

@ -0,0 +1,403 @@
;; 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 INC Sucursal en España 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")))))
(defn- toast-links
"The download links of every toast collected through the `st/emit!`
double, one entry per toast."
[events]
(->> events
(remove #(= ::ev/event (ptk/type %)))
(map #(get-in (ptk/update % {}) [:notification :links]))))
(t/deftest ^:async repeated-flash-keeps-the-report-download-link
;; Scenario: the same save failure flashes twice inside the governor
;; window with a report link. The repeat is not emitted, but its toast
;; still offers the report. Proves: the governor bounds emission, never
;; the user's download.
(let [generated (atom 0)
cause (error-cause :type :validation :hint "save failed")
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 [_ 2]
(await (errors/flash :cause cause :type :handled :report-link? true)))
(t/is (= 1 (count (report-events @events))) "the repeat is not emitted")
(t/is (= [1 1] (map count (toast-links @events))) "both toasts carry the link")
(t/is (= 2 @generated) "the repeat builds its report for the link only")))))
(t/deftest ^:async unreportable-flash-keeps-the-report-download-link
;; Scenario: a failure with an empty hint flashes with a report link. It
;; cannot be emitted, but its toast still offers the report. Proves: the
;; link does not depend on emission.
(let [cause (ex-info "" {:type :validation})
events (atom [])]
(await
(mock/with-mocks*
{st/format-last-events (mock/stub (fn [& _] "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 (errors/flash :cause cause :type :handled :report-link? true))
(t/is (empty? (report-events @events)) "nothing is emitted")
(t/is (= [1] (map count (toast-links @events))) "the toast carries the link")))))

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 INC Sucursal en España 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)}))))))

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

@ -23,9 +23,14 @@
4. `inner-done` restores originals and calls `outer-done`
(typically `cljs.test/async`'s done).
Usage: `(with-mocks {ns/sym mock-fn, ...} test-fn done)`"
Usage: `(with-mocks {ns/sym mock-fn, ...} test-fn done)`.
`with-mocks*` is the preferred form for new tests: it wraps the body in a
generated `^:async` fn and evaluates to a promise, so there is no `done` to
thread. See [[run-mocked]] for the restore-on-settle machinery."
#?(:cljs (:require
[beicon.v2.core :as rx]))
[beicon.v2.core :as rx]
[cljs.test :as t]))
#?(:cljs (:require-macros [frontend-tests.helpers.mock])))
;; ═══════════════════════════════════════════════════════════════
@ -84,6 +89,50 @@
~@restore-exprs
(~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
(frontend-tests.helpers.mock/run-mocked
(^:async fn [] ~@body)
(fn [] ~@restore-exprs)))))))
;; ═══════════════════════════════════════════════════════════════
;; Runtime (ClojureScript only)
;; ═══════════════════════════════════════════════════════════════
@ -164,6 +213,39 @@
([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."
[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
;; ═══════════════════════════════════════════════════════════════

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

@ -11,13 +11,15 @@
- stale-asset-error? – pure predicate
- exception->error-data – pure transformer
- on-error re-entrancy guard – prevents recursive invocations
- flash schedules async emit – ntf/show is not emitted synchronously
- flash schedules async report and toast – neither the report nor
ntf/show is emitted synchronously
- organization SSO recovery – expired SSO sessions go back to the provider
- invalid-sso-config handler – requires :organization-id to promote to :sso-error
- save failure notification – sticky toast carrying the error report
- delegated save failures – causes handled by the handler for their type"
(:require
[app.common.uuid :as uuid]
[app.main.data.event :as ev]
[app.main.data.persistence :as dps]
[app.main.data.workspace :as-alias dw]
[app.main.errors :as errors]
@ -31,6 +33,8 @@
[app.util.webapi :as wapi]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[cuerdas.core :as str]
[frontend-tests.helpers.async :as async]
[frontend-tests.helpers.mock :as mock]
[potok.v2.core :as ptk]))
@ -97,6 +101,245 @@
data (errors/exception->error-data err)]
(t/is (= "fallback message" (:hint data))))))
;; Shared report-test helpers (copied from the governor suite so each
;; namespace stays self-contained).
(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)))
(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))
(defn- ^:async report-names
"Drives `flash-persistence` with an `ex-data` map of `cause-data` and
returns the audit event names it emitted, in order.
The report generator is stubbed and the scheduler runs its callback
inline, so the whole flash body completes before returning. The emitter
is the only observable."
[cause-data]
(let [events (atom [])
cause (ex-info "Save failed" (assoc cause-data :hint "Save failed"))]
;; The governor is global and remembers fingerprints for two minutes, so
;; a second identical report would be suppressed. Clear it per case.
(errors/reset-report-governor!)
(await
(mock/with-mocks*
{errors/generate-report (fn [_ & _] "generated error report")
st/emit! (mock/stub (fn [& emitted]
(swap! events into emitted)))
;; `schedule` is multi-arity, so the mock needs every arity the
;; flash body may call it with.
tm/schedule (mock/stub (fn
([] nil)
([callback] (callback))
([_ms callback] (callback))))}
(errors/flash-persistence cause)))
(mapv #(-> % deref ::ev/name) (report-events @events))))
;; ---------------------------------------------------------------------------
;; Environment failures
;;
;; Connectivity and service failures are not application defects: they are
;; audit-only telemetry with a compact report and a dedicated toast.
;; ---------------------------------------------------------------------------
(t/deftest environment-error-classification
(t/testing "environment failures are recognised"
(doseq [type [:network :offline :bad-gateway :service-unavailable
:gateway-error :nitrate-unavailable :nitrate-not-configured]]
(t/is (true? (errors/environment-error? (error-cause :type type)))
(str "expected environment error: " type))))
(t/testing "application defects are not environment failures"
(doseq [type [:internal :assertion :persistence :validation :authentication]]
(t/is (false? (errors/environment-error? (error-cause :type type)))
(str "did not expect environment error: " type))))
(t/testing "causes without ex-data are not environment failures"
(t/is (false? (errors/environment-error? (js/Error. "plain failure"))))
(t/is (false? (errors/environment-error? nil)))))
(t/deftest ^:async generate-report-compact-omits-stack-data-and-last-events
(await
(mock/with-mocks*
{st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")}
(let [cause (ex-info "http error" {:type :offline
:hint "http error"
:uri "/api/rpc/command/update-file"
:headers {"x-session-id" "secret"}})
report (errors/generate-report cause {:format :compact})]
(t/is (string? report))
(t/is (str/includes? report "Hint:"))
(t/is (str/includes? report "http error"))
(t/is (str/includes? report ":offline"))
(t/is (str/includes? report "/api/rpc/command/update-file"))
(t/is (not (str/includes? report "Last events:")))
(t/is (not (str/includes? report "Data:")))
(t/is (not (str/includes? report "====")))
(t/is (not (str/includes? report "secret")))
;; Trailing settle: the body is synchronous, but `with-mocks*`
;; evaluates to a promise, so the body must settle one.
(await (async/settle))))))
(t/deftest ^:async generate-report-defaults-to-the-full-format
(await
(mock/with-mocks*
{st/format-last-events (mock/stub (fn [& _] "(stub last events)"))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")}
(let [report (errors/generate-report (error-cause :type :internal :hint "boom"))]
(t/is (str/includes? report "Last events:"))
(t/is (str/includes? report "(stub last events)"))
;; Trailing settle: the body is synchronous, but `with-mocks*`
;; evaluates to a promise, so the body must settle one.
(await (async/settle))))))
(t/deftest ^:async connectivity-handlers-report-governed-compact-audit-events
;; Scenario: a network failure and an offline status through the global
;; handler. Each is reported as a governed compact audit event plus its
;; connection toast. Proves: per type, report first and toast right after,
;; with no stack in the report and the dedicated toast message.
(doseq [type [:network :offline :gateway-error]]
(errors/reset-report-governor!)
(let [events (atom [])
cause (ex-info "http error" {:type type :hint "http error"})]
(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] (f)))
st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))}
(errors/on-error cause)
(await (async/settle))
;; `flash` emits the report first and schedules the toast right after.
(t/is (= 2 (count @events)) (str "unexpected event count for " type))
(let [report-event (first @events)
toast-event (second @events)
props (deref report-event)]
(t/is (= "handled-exception" (::ev/name props)))
(t/is (not (str/includes? (:report props) "Last events:")))
(t/is (= (i18n/tr "errors.connection-error")
(get-in (ptk/update toast-event {}) [:notification :content])))))))))
(t/deftest ^:async flash-keeps-the-canonical-event-name-and-derives-the-format
;; Scenario: an environment failure flashed as `:handled` and as
;; `:unhandled`. The audit event name is the canonical one requested by
;; the caller while only the payload format derives from the cause
;; (compact, with no stack and no header dump). Proves: per type, one
;; compact audit event under the requested name, with the `flash`
;; awaited to completion.
(let [cause (ex-info "http error" {:type :network
:hint "http error"
:headers {"x-session-id" "secret"}})]
(doseq [[type event-name] [[:handled "handled-exception"]
[:unhandled "unhandled-exception"]]]
(errors/reset-report-governor!)
(let [events (atom [])]
(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)))
st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))}
;; The event name is the canonical one requested by the caller;
;; only the payload format is derived from the cause.
(await (errors/flash :cause cause :type type))
(let [reports (report-events @events)]
(t/is (= 1 (count reports)) (str "unexpected event count for " type))
(let [props (deref (first reports))
report (:report props)]
(t/is (= event-name (::ev/name props)) (str "event name for " type))
(t/is (not (str/includes? report "Last events:")))
(t/is (not (str/includes? report "secret")))))))))))
(t/deftest ^:async offline-loop-is-governed-and-never-unhandled
;; Scenario: 10 000 offline errors through the global handler, replaying
;; a connectivity outage. Every occurrence is handled (never unhandled)
;; and the governor emits only the first. Proves: one `handled-exception`
;; audit event for the whole loop, observed after timers drain.
(let [events (atom [])
cause (ex-info "http error" {:type :offline :hint "http error"})]
(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)))
st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))}
(dotimes [_ 10000]
(errors/on-error cause))
(await (async/settle))
(t/is (= 1 (count (report-events @events))))
(t/is (= "handled-exception" (::ev/name (deref (first (report-events @events))))))))))
(t/deftest ^:async flash-persistence-uses-compact-reports-for-environment-failures
;; Scenario: a save failure caused by the environment. `flash-persistence`
;; delegates to `flash`, so the audit event carries a compact report
;; (context only: no stack, no header dump). Proves: one
;; `handled-exception` with a compact payload, observed after timers
;; drain.
(let [events (atom [])]
(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)))
st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))}
(errors/flash-persistence (ex-info "http error" {:type :offline
:hint "http error"
:headers {"x-session-id" "secret"}}))
(await (async/settle))
(let [reports (report-events @events)]
(t/is (= 1 (count reports)))
(let [props (deref (first reports))]
(t/is (= "handled-exception" (::ev/name props)))
(t/is (not (str/includes? (:report props) "Last events:")))
(t/is (not (str/includes? (:report props) "secret")))))))))
(t/deftest exception-page-reports-dedup-by-cause
(let [cause-a (error-cause :type :internal :code :unable-to-process-repository-response :hint "boom")
cause-b (error-cause :type :internal :code :other :hint "other")
events (capture-reports!
(fn []
(errors/submit-report :event-name "exception-page"
:report "report" :hint "boom" :cause cause-a)
(errors/submit-report :event-name "exception-page"
:report "report" :hint "different hint" :cause cause-a)
(errors/submit-report :event-name "exception-page"
:report "report" :hint "other" :cause cause-b)))]
(t/is (= 2 (count events)))))
(t/deftest reports-of-the-same-cause-under-different-names-do-not-coalesce
(let [cause (error-cause :type :internal :hint "boom")
events (capture-reports!
(fn []
(errors/submit-report :event-name "handled-exception"
:report "report" :hint "boom" :cause cause)
(errors/submit-report :event-name "unhandled-exception"
:report "report" :hint "boom" :cause cause)
(errors/submit-report :event-name "exception-page"
:report "report" :hint "boom" :cause cause)))]
(t/is (= 3 (count events)))))
;; ---------------------------------------------------------------------------
;; on-error dispatches to ptk/handle-error
;;
@ -173,152 +416,136 @@
:organization-id organization-id
:team-id "b8f8bb52-8b70-8144-8004-4a5085f0bdc9"})
(t/deftest expired-organization-sso-navigates-to-identity-provider
(t/async done
(t/testing "the browser is sent to the identity provider instead of an error page"
(let [events (atom [])]
(mock/with-mocks
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized false
:redirect-uri "https://idp.example.com/authorize"})))
rt/get-current-href (constantly workspace-href)
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))}
(fn [done']
(errors/on-error (sso-required-error))
(t/is (= [::rt/nav-raw] (mapv ptk/type @events)))
(done'))
done)))))
(t/deftest ^:async expired-organization-sso-navigates-to-identity-provider
(t/testing "the browser is sent to the identity provider instead of an error page"
(let [events (atom [])]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized false
:redirect-uri "https://idp.example.com/authorize"})))
rt/get-current-href (constantly workspace-href)
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))}
(errors/on-error (sso-required-error))
(await (async/settle))
(t/is (= [::rt/nav-raw] (mapv ptk/type @events))))))))
(t/deftest expired-organization-sso-comes-back-to-the-current-location
(t/async done
(t/testing "the SSO check asks the provider to return the user where they were"
(let [rpc-calls (atom [])]
(mock/with-mocks
{rp/cmd! (mock/stub
(fn [command params]
(swap! rpc-calls conj {:command command :params params})
(rx/of {:authorized false
:redirect-uri "https://idp.example.com/authorize"})))
rt/get-current-href (constantly workspace-href)
st/emit! mock/noop}
(fn [done']
(errors/on-error (sso-required-error))
(t/is (= [{:command :check-nitrate-sso
:params {:team-id "b8f8bb52-8b70-8144-8004-4a5085f0bdc9"
:organization-id organization-id
:url workspace-href}}]
@rpc-calls))
(done'))
done)))))
(t/deftest ^:async expired-organization-sso-comes-back-to-the-current-location
(t/testing "the SSO check asks the provider to return the user where they were"
(let [rpc-calls (atom [])]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub
(fn [command params]
(swap! rpc-calls conj {:command command :params params})
(rx/of {:authorized false
:redirect-uri "https://idp.example.com/authorize"})))
rt/get-current-href (constantly workspace-href)
st/emit! mock/noop}
(errors/on-error (sso-required-error))
(await (async/settle))
(t/is (= [{:command :check-nitrate-sso
:params {:team-id "b8f8bb52-8b70-8144-8004-4a5085f0bdc9"
:organization-id organization-id
:url workspace-href}}]
@rpc-calls)))))))
(t/deftest already-satisfied-organization-sso-retries-the-location
(t/async done
(t/testing "a session renewed meanwhile (e.g. in another tab) reloads instead of erroring"
(let [events (atom [])]
(mock/with-mocks
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized true :reason :sso-satisfied})))
rt/get-current-href (constantly workspace-href)
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))}
(fn [done']
(errors/on-error (sso-required-error))
(t/is (= [::rt/reload] (mapv ptk/type @events)))
(done'))
done)))))
(t/deftest ^:async already-satisfied-organization-sso-retries-the-location
(t/testing "a session renewed meanwhile (e.g. in another tab) reloads instead of erroring"
(let [events (atom [])]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized true :reason :sso-satisfied})))
rt/get-current-href (constantly workspace-href)
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))}
(errors/on-error (sso-required-error))
(await (async/settle))
(t/is (= [::rt/reload] (mapv ptk/type @events))))))))
(t/deftest organization-sso-without-usable-provider-shows-the-sso-error-dialog
(t/async done
(t/testing "SSO is required but there is nowhere to go: offer a retry, not a permission error"
(let [assigned* (atom nil)]
(mock/with-mocks
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized false :redirect-uri nil})))
rt/get-current-href (constantly workspace-href)
rt/assign-exception (fn [error]
(reset! assigned* error)
(ptk/data-event ::assigned error))}
(fn [done']
(errors/on-error (sso-required-error))
(t/is (= :sso-error (:type @assigned*)))
(t/is (= organization-id (:organization-id @assigned*)))
(t/is (true? (:is-workspace @assigned*)))
(done'))
done)))))
(t/deftest ^:async organization-sso-without-usable-provider-shows-the-sso-error-dialog
(t/testing "SSO is required but there is nowhere to go: offer a retry, not a permission error"
(let [assigned* (atom nil)]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized false :redirect-uri nil})))
rt/get-current-href (constantly workspace-href)
rt/assign-exception (fn [error]
(reset! assigned* error)
(ptk/data-event ::assigned error))}
(errors/on-error (sso-required-error))
(await (async/settle))
(t/is (= :sso-error (:type @assigned*)))
(t/is (= organization-id (:organization-id @assigned*)))
(t/is (true? (:is-workspace @assigned*))))))))
(t/deftest organization-sso-without-team-access-reports-a-permission-failure
(t/async done
(t/testing "a user who cannot reach the team keeps getting the authentication error"
(let [assigned* (atom nil)]
(mock/with-mocks
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized true :reason :no-team-access})))
rt/get-current-href (constantly workspace-href)
rt/assign-exception (fn [error]
(reset! assigned* error)
(ptk/data-event ::assigned error))}
(fn [done']
(errors/on-error (sso-required-error))
(t/is (= :authentication (:type @assigned*)))
(t/is (= :nitrate-sso-required (:code @assigned*)))
(done'))
done)))))
(t/deftest ^:async organization-sso-without-team-access-reports-a-permission-failure
(t/testing "a user who cannot reach the team keeps getting the authentication error"
(let [assigned* (atom nil)]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized true :reason :no-team-access})))
rt/get-current-href (constantly workspace-href)
rt/assign-exception (fn [error]
(reset! assigned* error)
(ptk/data-event ::assigned error))}
(errors/on-error (sso-required-error))
(await (async/settle))
(t/is (= :authentication (:type @assigned*)))
(t/is (= :nitrate-sso-required (:code @assigned*))))))))
(t/deftest organization-sso-does-not-retry-on-an-unexplained-authorization
(t/async done
(t/testing "reloading on an answer we don't understand would spin on the same rejection"
(let [events (atom [])]
(mock/with-mocks
{rp/cmd! (mock/stub (fn [_command _params] (rx/of {:authorized true})))
rt/get-current-href (constantly workspace-href)
rt/assign-exception (fn [error] (ptk/data-event ::assigned error))
st/async-emit! (fn [& emitted] (swap! events into emitted))}
(fn [done']
(errors/on-error (sso-required-error))
(t/is (= [::assigned] (mapv ptk/type @events)))
(done'))
done)))))
(t/deftest ^:async organization-sso-does-not-retry-on-an-unexplained-authorization
(t/testing "reloading on an answer we don't understand would spin on the same rejection"
(let [events (atom [])]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [_command _params] (rx/of {:authorized true})))
rt/get-current-href (constantly workspace-href)
rt/assign-exception (fn [error] (ptk/data-event ::assigned error))
st/async-emit! (fn [& emitted] (swap! events into emitted))}
(errors/on-error (sso-required-error))
(await (async/settle))
(t/is (= [::assigned] (mapv ptk/type @events))))))))
(t/deftest organization-sso-error-without-context-is-reported-as-it-arrives
(t/async done
(t/testing "with no organization and no team there is nothing to check"
(let [rpc-calls (atom 0)
assigned* (atom nil)]
(mock/with-mocks
{rp/cmd! (mock/stub (fn [_command _params]
(swap! rpc-calls inc)
(rx/empty)))
rt/get-current-href (constantly workspace-href)
rt/assign-exception (fn [error]
(reset! assigned* error)
(ptk/data-event ::assigned error))}
(fn [done']
(errors/on-error {:type :authentication
:code :nitrate-sso-required})
(t/is (zero? @rpc-calls))
(t/is (= :nitrate-sso-required (:code @assigned*)))
(done'))
done)))))
(t/deftest ^:async organization-sso-error-without-context-is-reported-as-it-arrives
(t/testing "with no organization and no team there is nothing to check"
(let [rpc-calls (atom 0)
assigned* (atom nil)]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [_command _params]
(swap! rpc-calls inc)
(rx/empty)))
rt/get-current-href (constantly workspace-href)
rt/assign-exception (fn [error]
(reset! assigned* error)
(ptk/data-event ::assigned error))}
(errors/on-error {:type :authentication
:code :nitrate-sso-required})
(await (async/settle))
(t/is (zero? @rpc-calls))
(t/is (= :nitrate-sso-required (:code @assigned*))))))))
(t/deftest a-resultless-organization-sso-check-does-not-wedge-later-rejections
(t/async done
(t/testing "the one-in-flight guard is released even when no answer arrives"
(let [rpc-calls (atom 0)]
(mock/with-mocks
{rp/cmd! (mock/stub (fn [_command _params]
(swap! rpc-calls inc)
(rx/empty)))
rt/get-current-href (constantly workspace-href)
st/emit! mock/noop}
(fn [done']
(errors/on-error (sso-required-error))
(errors/on-error (sso-required-error))
(t/is (= 2 @rpc-calls))
(done'))
done)))))
(t/deftest ^:async a-resultless-organization-sso-check-does-not-wedge-later-rejections
(t/testing "the one-in-flight guard is released even when no answer arrives"
(let [rpc-calls (atom 0)]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [_command _params]
(swap! rpc-calls inc)
(rx/empty)))
rt/get-current-href (constantly workspace-href)
st/emit! mock/noop}
(errors/on-error (sso-required-error))
(errors/on-error (sso-required-error))
(await (async/settle))
(t/is (= 2 @rpc-calls)))))))
;; A failing check must stay a failing check: the generic handling turns it
;; into a toast, whereas swallowing it would show a permission error for
@ -332,35 +559,31 @@
[error]
(swap! check-failures conj error))
(t/deftest failing-organization-sso-check-is-not-reported-as-missing-access
(t/async done
(t/deftest ^:async failing-organization-sso-check-is-not-reported-as-missing-access
(t/testing "the SSO check fails like a real request (later tick) and the failure stays a failure"
(reset! check-failures [])
(let [assigned* (atom nil)]
(mock/with-mocks
{rp/cmd!
(mock/stub
(fn [_command _params]
(->> (rx/timer 0)
(rx/mapcat (fn [_]
(rx/throw (ex-info "boom" {:type ::test-check-failure})))))))
(await
(mock/with-mocks*
{rp/cmd!
(mock/stub
(fn [_command _params]
(->> (rx/timer 0)
(rx/mapcat (fn [_]
(rx/throw (ex-info "boom" {:type ::test-check-failure})))))))
rt/get-current-href
(constantly workspace-href)
rt/get-current-href
(constantly workspace-href)
rt/assign-exception
(fn [error]
(reset! assigned* error)
(ptk/data-event ::assigned error))}
(fn [done']
(errors/on-error (sso-required-error))
(tm/schedule
50
(fn []
(t/is (= [::test-check-failure] (mapv :type @check-failures)))
(t/is (nil? @assigned*))
(done'))))
done))))
rt/assign-exception
(fn [error]
(reset! assigned* error)
(ptk/data-event ::assigned error))}
(errors/on-error (sso-required-error))
(await (async/wait-for #(= 1 (count @check-failures))
"sso check failure observed"))
(t/is (= [::test-check-failure] (mapv :type @check-failures)))
(t/is (nil? @assigned*)))))))
;; ---------------------------------------------------------------------------
;; :validation / :invalid-sso-config
@ -422,7 +645,7 @@
(t/is (= timeout (get-in state [:notification :timeout])))
(t/is (= :visible (get-in state [:notification :status]))))))))
(t/deftest persistence-notifications-include-an-error-report-download
(t/deftest ^:async persistence-notifications-include-an-error-report-download
(let [scheduled (atom [])
idle-callbacks (atom [])
events (atom [])
@ -430,66 +653,142 @@
revoked (atom [])
report "generated error report"
cause (ex-info "Save failed" {:type :validation})]
(with-redefs [dom/prevent-default (fn [_])
dom/trigger-download-uri (fn [& params]
(swap! downloads conj params))
errors/generate-report (fn [_] report)
errors/submit-report (fn [& _])
;; `tr` is called with one and with two arguments, and its
;; two-argument arity is variadic: the stub exposes both
;; shapes so the compiled static calls resolve.
i18n/tr (fn ([key] (str key ":"))
([key & args]
(str key ":" (first args))))
st/emit! (mock/stub (fn [& emitted]
(swap! events into emitted)))
tm/schedule (mock/stub (fn [callback]
(swap! scheduled conj callback)))
tm/schedule-on-idle (mock/stub (fn [callback]
(swap! idle-callbacks conj callback)))
wapi/create-blob (mock/stub (fn [content media-type]
{:content content :media-type media-type}))
wapi/create-uri (fn [_] "blob:report")
wapi/revoke-uri (fn [uri]
(swap! revoked conj uri))]
(errors/flash-persistence cause)
(doseq [callback @scheduled] (callback))
(let [state (ptk/update (first @events) {})
download (get-in state [:notification :links 0])]
(t/is (= "labels.download:report.txt" (:label download)))
((:callback download) nil)
(t/is (= [["report" "text/plain" "blob:report"]] @downloads))
(doseq [callback @idle-callbacks] (callback))
(t/is (= ["blob:report"] @revoked))))))
(await
(mock/with-mocks*
{dom/prevent-default (fn [_])
dom/trigger-download-uri (fn [& params]
(swap! downloads conj params))
errors/generate-report (fn [_ & _] report)
errors/submit-report (fn [& _])
;; `tr` is called with one and with two arguments, and its
;; two-argument arity is variadic: the stub exposes both
;; shapes so the compiled static calls resolve.
i18n/tr (fn ([key] (str key ":"))
([key & args]
(str key ":" (first args))))
st/emit! (mock/stub (fn [& emitted]
(swap! events into emitted)))
tm/schedule (mock/stub (fn [callback]
(swap! scheduled conj callback)))
tm/schedule-on-idle (mock/stub (fn [callback]
(swap! idle-callbacks conj callback)))
wapi/create-blob (mock/stub (fn [content media-type]
{:content content :media-type media-type}))
wapi/create-uri (fn [_] "blob:report")
wapi/revoke-uri (fn [uri]
(swap! revoked conj uri))}
(errors/flash-persistence cause)
(doseq [callback @scheduled] (callback))
(await (async/settle))
;; The report is emitted first and the toast right after, so the
;; toast carrying the download link is the last event collected.
(let [state (ptk/update (last @events) {})
download (get-in state [:notification :links 0])]
(t/is (= "labels.download:report.txt" (:label download)))
((:callback download) nil)
(t/is (= [["report" "text/plain" "blob:report"]] @downloads))
(doseq [callback @idle-callbacks] (callback))
(t/is (= ["blob:report"] @revoked))
;; Autosave is stopped for the whole session, so the toast also
;; offers the only action that restarts it without the user having
;; to know they could leave the file and come back.
(let [reload (get-in state [:notification :links 1])]
(t/is (= "labels.reload-page:" (:label reload))
"the `tr` stub renders a one-argument key with a trailing colon")
(t/is (fn? (:callback reload)) "the reload link has a callback")))))))
(t/deftest persistence-waiters-do-not-report-an-already-handled-failure
;; Scenario: a save fails terminally. The toast offers the report download
;; and a reload. Proves: the recovery action reaches the user.
;;
;; The reload callback itself is not invoked here: `js/location` does not
;; exist under the test runner, so the link is verified by its label and by
;; being a callable, not by calling it.
(t/deftest ^:async save-failure-toast-offers-a-reload-action
(let [events (atom [])]
(await
(mock/with-mocks*
{errors/generate-report (fn [_ & _] "generated error report")
st/emit! (mock/stub (fn [& emitted]
(swap! events into emitted)))
tm/schedule (mock/stub (fn [callback] (callback)))}
(errors/flash-persistence (ex-info "Save failed"
{:type :validation :hint "Save failed"}))
(await (async/settle))
;; The report is emitted first and the toast right after, so the toast
;; is the last event collected.
(let [state (ptk/update (last @events) {})
links (get-in state [:notification :links])]
;; `tr` is not stubbed here, and the test runner does not load the
;; catalogue, so a key comes back verbatim without its arguments.
(t/is (= ["labels.download" "labels.reload-page"] (mapv :label links))
"the toast carries the report and a reload, download first")
(t/is (every? #(fn? (:callback %)) links)
"both actions are callable")
(t/is (nil? (get-in state [:notification :timeout]))
"the toast stays until the user acts on it"))))))
;; Scenario: a save fails on the transport and the queue keeps trying on
;; the slow cycle. The toast says the changes are kept and offers no reload,
;; which would lose them. Proves: the retrying variant tells the truth.
(t/deftest ^:async retrying-save-failure-toast-offers-no-reload
(let [events (atom [])]
(await
(mock/with-mocks*
{errors/generate-report (fn [_ & _] "generated error report")
st/emit! (mock/stub (fn [& emitted]
(swap! events into emitted)))
tm/schedule (mock/stub (fn [callback] (callback)))}
(errors/flash-persistence (ex-info "Save failed"
{:type :gateway-error :hint "Save failed"})
:retrying true)
(await (async/settle))
(let [state (ptk/update (last @events) {})]
(t/is (= "errors.save-still-retrying" (get-in state [:notification :content])))
(t/is (= ["labels.download"] (mapv :label (get-in state [:notification :links])))
"the toast carries the report and no reload")
(t/is (= errors/persistence-failed-tag (get-in state [:notification :tag]))
"a save that lands can hide it")
(t/is (nil? (get-in state [:notification :timeout]))))))))
(t/deftest ^:async persistence-waiters-do-not-report-an-already-handled-failure
(let [reports (atom [])
rejected (atom [])
pstate (atom {:status :saving})
store (ptk/store {:state {} :on-error errors/on-error})
cause (ex-info "Save failed" {:type :network})]
(with-redefs [refs/persistence pstate
errors/submit-report (fn [& params]
(swap! reports conj (apply hash-map params)))
tm/schedule (mock/stub (fn [_]))]
(try
(ptk/emit! store (#'dps/persistence-failed (uuid/next) cause))
(reset! pstate (:persistence @store))
(dotimes [_ 2]
(->> (dps/wait-persisted-or-error)
(rx/subs! (fn [_] (t/is false "A failed save must still reject"))
(fn [error]
(swap! rejected conj error)
(errors/on-error error)))))
(t/is (= 2 (count @rejected)))
(t/is (= 1 (count @reports)))
;; A standalone timeout and a later save failure are new incidents.
(errors/on-error (ex-info "Save timed out" {:type :persistence :code :save-timeout}))
(t/is (= 2 (count @reports)))
(ptk/emit! store (#'dps/persistence-failed (uuid/next) cause))
(t/is (= 3 (count @reports)))
(finally
(rx/dispose! store))))))
(await
(mock/with-mocks*
{refs/persistence pstate
st/emit! (mock/stub (fn [& emitted]
(swap! reports into
(report-events emitted))))
;; Run the scheduled `flash` body synchronously: the whole flow
;; under test is synchronous except for the deferral.
tm/schedule (mock/stub (fn [f] (f)))}
(try
(ptk/emit! store (#'dps/persistence-failed (uuid/next) cause))
(reset! pstate (:persistence @store))
(dotimes [_ 2]
(->> (dps/wait-persisted-or-error)
(rx/subs! (fn [_] (t/is false "A failed save must still reject"))
(fn [error]
(swap! rejected conj error)
(errors/on-error error)))))
(await (async/settle))
(t/is (= 2 (count @rejected)))
(t/is (= 1 (count @reports)))
;; A standalone timeout and a later save failure are new incidents.
;; The later failure carries a distinct signature: repeating the same
;; one inside the governor window is coalesced by design.
(errors/on-error (ex-info "Save timed out" {:type :persistence :code :save-timeout}))
(await (async/settle))
(t/is (= 2 (count @reports)))
(ptk/emit! store (#'dps/persistence-failed (uuid/next)
(ex-info "Save failed again" {:type :network})))
(await (async/settle))
(t/is (= 3 (count @reports)))
(finally
(rx/dispose! store)))))))
;; ---------------------------------------------------------------------------
;; Save failures that belong to their own handler
@ -512,22 +811,20 @@
(t/is (= :authentication (:type @assigned)))
(t/is (empty? @scheduled) "An expired session shows no save notification")))))
(t/deftest expired-organization-sso-during-save-renews-the-session
(t/async done
(t/testing "an SSO-guarded save failure goes back through the identity provider"
(let [events (atom [])]
(mock/with-mocks
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized false
:redirect-uri "https://idp.example.com/authorize"})))
rt/get-current-href (constantly workspace-href)
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))}
(fn [done']
(errors/flash-persistence (ex-info "SSO required" (sso-required-error)))
(t/is (= [::rt/nav-raw] (mapv ptk/type @events)))
(done'))
done)))))
(t/deftest ^:async expired-organization-sso-during-save-renews-the-session
(t/testing "an SSO-guarded save failure goes back through the identity provider"
(let [events (atom [])]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub
(fn [_command _params]
(rx/of {:authorized false
:redirect-uri "https://idp.example.com/authorize"})))
rt/get-current-href (constantly workspace-href)
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))}
(errors/flash-persistence (ex-info "SSO required" (sso-required-error)))
(await (async/settle))
(t/is (= [::rt/nav-raw] (mapv ptk/type @events))))))))
(t/deftest a-deleted-file-during-save-shows-the-exception-page
(t/testing "a file that no longer exists shows its page, not the save notification"
@ -554,20 +851,86 @@
(t/is (= [::dw/reload-current-file] (mapv ptk/type @events)))
(t/is (empty? @scheduled) "A restored version shows no save notification")))))
(t/deftest other-validation-failures-during-save-keep-the-notification
(t/testing "a validation failure without a recovery of its own is still notified"
(let [events (atom [])
scheduled (atom [])]
(with-redefs [errors/generate-report (fn [_] "generated error report")
errors/submit-report (fn [& _])
st/emit! (mock/stub (fn [& emitted]
(swap! events into emitted)))
tm/schedule (mock/stub (fn [callback]
(swap! scheduled conj callback)))]
(errors/flash-persistence (ex-info "Invalid data" {:type :validation
:code :invalid-data}))
(doseq [callback @scheduled] (callback))
(t/is (= 1 (count @events)))
(let [state (ptk/update (first @events) {})]
(t/is (nil? (get-in state [:notification :timeout])))
(t/is (some? (get-in state [:notification :links 0]))))))))
(t/deftest ^:async save-failure-report-type-follows-the-cause
;; The user still gets the same sticky toast and report link; only the audit
;; event name changes, and that is what decides whether the incident reaches
;; the internal reports and the alerts.
(t/testing "a validation failure is a defect, so it reports unhandled"
(t/is (= ["unhandled-exception"]
(await (report-names {:type :validation :code :invalid-data})))))
(t/testing "the wrapped shape reads the cause, not the wrapper"
;; This is the shape that actually reaches flash-persistence:
;; persistence-failed sets :type :persistence and keeps the real type
;; under :cause-type. Reading :type alone would match the wrapper and
;; leave the cause as handled.
(t/is (= ["unhandled-exception"]
(await (report-names {:type :persistence
:cause-type :validation
:code :invalid-data})))))
(t/testing "environment failures stay handled after the retry budget"
;; They land here once the backoff is spent, and the user's connection is
;; not our bug, so they must not alert.
(doseq [cause-type [:network :offline :bad-gateway :service-unavailable
:gateway-error]]
(t/is (= ["handled-exception"]
(await (report-names {:type :persistence
:cause-type cause-type})))
(str cause-type " is an environment failure, not a defect"))))
(t/testing "responses the backend never wrote stay handled"
(doseq [cause-type [:rate-limit :unexpected-response]]
(t/is (= ["handled-exception"]
(await (report-names {:type :persistence
:cause-type cause-type})))
(str cause-type " comes from a proxy, not from our code"))))
(t/testing "an unclassified failure keeps the handled path"
(t/is (= ["handled-exception"]
(await (report-names {:type :persistence
:cause-type :unknown-thing})))))
(t/testing "a bare :type still classifies, without a wrapper"
(t/is (= ["unhandled-exception"]
(await (report-names {:type :validation})))))
(t/testing "a server-side or internal defect reports unhandled"
(doseq [cause-type [:server-error :internal]]
(t/is (= ["unhandled-exception"]
(await (report-names {:type :persistence
:cause-type cause-type})))
(str cause-type " is our bug")))))
;; ---------------------------------------------------------------------------
;; transport errors
;; ---------------------------------------------------------------------------
(t/deftest ^:async transport-errors-are-handled-without-replacing-the-page
;; Scenario: a rate limit and an error page the backend did not write,
;; through the global handler. Proves: neither replaces the page, each is
;; a handled report followed by one toast.
(doseq [type [:rate-limit :unexpected-response]]
(errors/reset-report-governor!)
(let [events (atom [])
assigned (atom [])
cause (ex-info "http error"
{:type type
:hint "http error"
:status 429
:uri "https://design.penpot.app/api/main/methods/get-teams"})]
(await
(mock/with-mocks*
{st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")
rt/assign-exception (fn [error] (swap! assigned conj error) error)
tm/schedule (mock/stub (fn [f] (f)))
st/format-last-events (mock/stub (fn [& _] "(stub last events)"))}
(errors/on-error cause)
(await (async/settle))
(t/is (empty? @assigned)
(str type " must not replace the page with an error screen"))
(t/is (= ["handled-exception"]
(map (comp ::ev/name deref) (report-events @events)))
(str type " is reported as handled, not unhandled"))
(t/is (= 2 (count @events)) (str type " must show one notification")))))))

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

@ -10,7 +10,9 @@
[frontend-tests.copy-as-svg-test]
[frontend-tests.data.dashboard-test]
[frontend-tests.data.exports-assets-test]
[frontend-tests.data.fix-deleted-fonts-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]
@ -29,6 +31,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]
@ -113,7 +116,9 @@
'frontend-tests.composable-tests.comp.sync-test
'frontend-tests.copy-as-svg-test
'frontend-tests.data.dashboard-test
'frontend-tests.data.fix-deleted-fonts-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
@ -133,6 +138,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

19
frontend/translations/en.po
View File

@ -1535,6 +1535,10 @@ msgstr ""
msgid "errors.comment-error"
msgstr "There was an error with the comment"
#: src/app/main/errors.cljs:499
msgid "errors.connection-error"
msgstr "Cannot reach the server. Check your connection and try again."
#: src/app/main/errors.cljs:414
msgid "errors.deprecated"
msgstr ""
@ -1799,7 +1803,16 @@ msgstr "The registration is currently disabled."
#: src/app/main/errors.cljs:216
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."
"Autosave has stopped for this session, so your changes since the last successful save cannot be saved. Download the report to help us fix it, then reload the page, or leave this file and open it again, to keep editing."
#: src/app/main/data/persistence.cljs:310
msgid "errors.save-retrying"
msgstr "Connection lost. Retrying to save your changes."
#: src/app/main/errors.cljs
msgid "errors.save-still-retrying"
msgstr ""
"Your changes are not saved yet because Penpot cannot reach the server. They are kept, and Penpot will keep trying to save them. Keep this tab open until they are saved."
#: src/app/main/errors.cljs:337
msgid "errors.svg-parser.invalid-svg"
@ -7133,6 +7146,10 @@ msgstr "Unlock guides"
msgid "workspace.header.reset-zoom"
msgstr "Reset"
#: 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.save-error"
msgstr "Error on saving"

7
frontend/translations/es.po
View File

@ -1766,7 +1766,12 @@ msgstr "El registro está actualmente desactivado."
#: src/app/main/errors.cljs:216
msgid "errors.save-failed"
msgstr ""
"El autoguardado se ha detenido debido a un error. Contacta soporte para informar del error y recarga para continuar desde los últimos cambios guardados."
"El autoguardado se ha detenido en esta sesión, así que los cambios desde el último guardado correcto no se podrán guardar. Descarga el informe para ayudarnos a arreglarlo y recarga la página, o sal de este fichero y vuelve a abrirlo, para seguir editando."
#: src/app/main/errors.cljs
msgid "errors.save-still-retrying"
msgstr ""
"Tus cambios aún no se han guardado porque Penpot no puede conectar con el servidor. Se conservan y Penpot seguirá intentando guardarlos. Mantén esta pestaña abierta hasta que se guarden."
#: src/app/main/errors.cljs:337
msgid "errors.svg-parser.invalid-svg"