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

Merge branch 'main' into staging

Browse Source
This commit is contained in:
Andrey Antukh 2026-10-19 20:10:20 +02:00
commit fdd66978fd
54 changed files with 2242 additions and 376 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.agents/README.md
View File

@ -410,6 +410,10 @@ append-only `Review Log` (UTC ISO 8601, one line per entry):
A plan approved with no changes goes `draft` → `done` directly.
A plan is never staged or committed: the `done` status and its
`Review Log` are session bookkeeping, not part of the change. Their
absence from the commit is expected.
## 7. Connecting `gh` CLI with a token
The `create-issue` and `create-pr` flows need an authenticated `gh`

10
.gitignore vendored
View File

@ -16,7 +16,10 @@
.repl
opencode.json
.opencode/package-lock.json
/*.html
/*.jpg
/*.json
!/package.json
/*.md
!CHANGES.md
!CONTRIBUTING.md
@ -92,6 +95,12 @@ opencode.json
/playwright/.cache/
/render-wasm/target/
/render-wasm/.render-wasm-build.lock
# render-wasm build artifacts copied into the exporter (autogenerated)
/exporter/resources/wasm/render-wasm.js
/exporter/resources/wasm/render-wasm.wasm
/exporter/src/app/wasm/shared.js
/media-processor/dist/
/media-processor/target/
/**/node_modules
@ -114,5 +123,6 @@ opencode.json
/.ci-logs
/tmp/
/.codex/
/scripts/__pycache__/
/tools/__pycache__
/scripts/__pycache__

2
.serena/memories/backend/auth-permissions-product-domains.md
View File

@ -13,7 +13,7 @@
- Logout may return an OIDC provider redirect URI when the session claims include provider/session data and the provider has a logout URI.
- Invitation tokens are verified through token issuers and only accepted when the token member id/email matches the authenticated profile; otherwise login proceeds without consuming the invitation.
- When public registration is disabled, invitation-based password registration also requires a matching, non-expired `team_invitation` row; registration revalidates it under a row lock before creating the profile.
- HTTP/session parsing details such as cookie/header precedence and SameSite behavior are in `mem:backend/subtleties`.
- HTTP/session parsing details such as cookie/header precedence, JWT session token versions, and SameSite behavior are in `mem:backend/subtleties`.
## Permission model

2
.serena/memories/backend/core.md
View File

@ -4,7 +4,7 @@ Backend: JVM Clojure; Integrant; PostgreSQL; Redis/Valkey; RPC; HTTP; storage; m
## Focused memories
- Cross-cutting backend subtleties (RPC, DB, workers, cron, CLIMIT, HTTP/sessions, storage, file data): `mem:backend/subtleties`
- Cross-cutting backend subtleties (RPC, DB helpers, workers, cron, CLIMIT, config and HTTP/session middleware, http self-metrics, media processing, and file data persistence): `mem:backend/subtleties`
- Storage abstraction, logical buckets, object lifecycle, deduplication, access, and garbage collection: `mem:backend/storage`.
- Embedded Ladybug graph experiment, projection, incremental sync, console, and risks: `mem:backend/graph-experiment`
- Session lifetime config, token `:exp`, and idle/absolute GC: `mem:backend/session-expiration`.

2
.serena/memories/backend/storage.md
View File

@ -25,7 +25,7 @@
- Existing object values can remain readable until physical deletion.
- `:expired-at` blocks reads after the expiration time.
- `del-object!` sets `deleted_at` on live rows only (`deleted_at IS NULL`): a repeated call returns `false`. It does not remove backend content.
- `storage-gc-deleted` removes the database row and backend content after the deletion delay, streaming the pending rows with `db/plan` inside a read-only transaction and deleting them in chunks of 25, each chunk in its own transaction: a chunk that fails (for example, an object a foreign key still references) is logged and skipped instead of aborting the run. A physical-deletion failure inside a chunk defers its rows one day (`deletion_attempts + 1`) and gives up after 7 attempts, accepting the orphan blob. Deferred rows keep their references until the final give-up. The freeze path re-verifies references under row locks, so a concurrent purge can delay a freeze but never swallow a touch.
- `storage-gc-deleted` removes the database row and backend content after the deletion delay, processing the pending objects in chunks of 25 with keyset pagination (`(deleted_at, id)` cursor, matching the `storage_object(deleted_at, id)` index). Only `status = 'valid'` objects are read: pending ones (still being written, see the status lifecycle) stay untouched even when already marked as deleted. Each chunk is one short read-write transaction: `SELECT ... FOR UPDATE SKIP LOCKED` (so two concurrent runs never take the same chunk; no separate read transaction exists and the run does not block the table vacuum) followed by the database delete and the backend delete grouped by backend. The cursor advances to the `(deleted_at, id)` of the last row read regardless of the deletion result, so a chunk that fails is skipped and not visited again in the same run: the error aborts the transaction (nothing of the chunk is deleted, locks are released), the handler catches it inside the transaction function and rolls it back explicitly — the commit that `tx-run!` performs afterwards is a JDBC-driver no-op on the already-rolled-back connection — and the loop continues with the returned rows. Accepted quirks, both benign and self-healing: (1) with rows of several backends in one chunk, a failure after one group's physical delete leaves those rows pending with already-removed content — pending rows are excluded from reads and the next run finishes them, since the physical delete is idempotent (S3 ignores missing keys, FS uses `deleteIfExists`); (2) rows locked by a concurrent run are skipped via `SKIP LOCKED` and deferred to the next scheduled run, and the `deleted_at <= now` cutoff is sampled per chunk. It emits the `penpot_storage_gc_deleted_objects_total{backend}` counter (one increment per deleted backend group, reported only after the chunk commits, so rolled-back chunks are never counted twice); run duration is covered by the generic `penpot_tasks_timing{name="storage-gc-deleted"}` histogram and chunk failures by the log-derived `penpot_log_events_total`. Every 5000 deleted objects the run pauses 5 seconds (throttle between chunk transactions, never holding one open).
- `storage-gc-touched` finds references before it sets `deleted_at`.
- Orphan watch: `SELECT COALESCE(metadata->>'bucket', metadata->>'~:bucket') AS bucket, count(*) FROM storage_object so WHERE touched_at IS NULL AND deleted_at IS NULL AND status = 'valid' AND NOT EXISTS (SELECT 1 FROM upload_session_chunk usc WHERE usc.object_id = so.id) GROUP BY 1;` Only the `upload-session` row of that output is a leak signal (its rows always have a mapping or a pending touch/deleted mark); other buckets use domain-table references, not this mapping.
- `objects-gc` removes deleted domain rows and touches their storage object IDs. Each proc streams its pending keys with `db/plan` inside a read-only transaction and deletes them in chunks, each chunk in its own transaction with `FOR UPDATE SKIP LOCKED`: a chunk that fails is logged and skipped instead of aborting the run.

11
.serena/memories/backend/subtleties.md
View File

@ -68,6 +68,7 @@
## Storage and media
- The `media-storage-bytes-per-team` quota check on `upload-file-media-object` is TEMPORARILY DISABLED (2026-10-19, kept commented in `app.rpc.commands.media` with its `sql:get-team-id-for-file` lookup still active for the audit props): the quote performs a full `SUM` over `storage_object` per upload and was too slow in production. The `upload-sessions-per-profile` quota is unaffected and stays active. Re-enable only with a cheaper approximation.
- Storage abstraction, backend configuration, logical buckets, object lifecycle, deduplication, access rules, and garbage collection: `mem:backend/storage`.
- SVG validation strips DOCTYPE and uses secure SAX parsing. Basic SVG info falls back to 100x100 dimensions when width/height/viewBox are missing.
- Raster metadata is shell-derived with ImageMagick `identify`, verifies detected MIME against the supplied MIME, and swaps dimensions for EXIF orientations 6/8.
@ -79,4 +80,12 @@
- File data backends are `legacy-db`, `db`, and `storage`. The storage backend keeps encoded file data in storage bucket `file-data`; the DB row stores metadata with `storage-ref-id` and nil data.
- `fdata/upsert!` touches any storage object referenced by incoming metadata before storing the new row/blob.
- Pointer-map fragments are persisted separately as type `fragment`, and only modified pointer maps are written.
- `fdata/realize` combines pointer realization and object-map realization. Use it before operations that need complete in-memory file data instead of pointer placeholders.
- `fdata/realize` combines pointer realization and object-map realization. Use it before operations that need complete in-memory file data instead of pointer placeholders.
- A `file_data` row is one of three classes, told apart by `type`: `main` is the file's current state and carries `id = file_id`; `snapshot` is a point-in-time copy whose `id` is the one its `file_change` row shares; `fragment` is a piece of the pointer-map, referenced from the file's data.
- Their lifecycles differ: `main` and `snapshot` live with the file (dated when it is deleted, undated when it is restored), while a `fragment` carries no date and is collected by `file_gc` once the file stops referencing it. Neither is a session buffer, so do not read a `fragment` as an ephemeral revision.
- File snapshots (versions) keep their metadata row in `file_change` and their payload in `file_data` (`type = 'snapshot'`). With the `db` backend `file_change.data` stays NULL: that column is only written by the `legacy-db` backend, plus the rows written before the 2025-07 file storage refactor.
- Tell a snapshot apart by `label IS NOT NULL` (with `created_by` / `deleted_at` as needed), never by `file_change.data IS NOT NULL`: the label holds with every file data backend, and the payload column stopped meaning "this is a snapshot" when the payload moved out. Queries that identify versions must use the label.
- The version quota counts of `app.rpc.quotes` (`sql:get-snapshots-per-file`, `sql:get-snapshots-per-team`) are served by the partial index `file_change__user_snapshots__idx`, whose predicate mirrors their where clause; changing one without the other drops the index only scan and the count walks the whole table again.
- Revisions live only in `file_change` and have no `file_data` counterpart. They are born already scheduled for deletion one hour later (`app.rpc.commands.files-update`) and the snapshot paths cannot reach one, because they resolve their row through a `label IS NOT NULL` filter.
- A deletion date is assigned once and never moved: `restore-files` (`app.rpc.commands.files`) unmarks only durable history, the `:file` method of `app.tasks.delete-object` dates only rows that have no date yet, and `objects-gc` collects only rows that carry one. Unmarking a revision leaves it invisible to `objects-gc` for ever, because nothing sets that date again.
- Binfile v1/v3 import and the v3 export `get-file` step run inside one long transaction. They raise `idle_in_transaction_session_timeout` to 30 min (`app.binfile.common/transaction-idle-timeout-ms`) instead of disabling it, so a connection left idle while the ZIP is decoded or the file data is realized is bounded; `statement_timeout` stays at 300 s.

5
.serena/memories/clojure/design-rules.md
View File

@ -2,10 +2,11 @@
How to shape a function in this codebase. Each rule came from a review round; do not re-derive from taste.
- **Preconditions belong to the boundary, not to the core.** A function documents what it needs (hints, docstring) and assumes it. Absence checks live where the value enters the system: the caller that resolves optional objects, `ig/init-key`, the request handler. A `(when (and (some? a) (some? b)) ...)` inside a leaf function means the guard is in the wrong place — if you cannot get `a` or `b`, you should not be calling it.
- **Optional-by-design data is guarded where the optionality is born.** Example: `ConnectorStatistics` is nil when the server option is off, so the guard is `when-let [cs (some-> server ...)]` at the entry point and the consumer assumes `cs`.
- **Preconditions belong to the boundary, not to the core.** A function documents what it needs (hints, docstring) and assumes it. Absence checks live where the value enters the system: the caller that resolves optional objects, `ig/init-key`, the request handler — including `nil` that is optional-by-design (`when-let [cs (some-> server ...)]` at the entry point, as with `ConnectorStatistics` when the server option is off). A `(when (and (some? a) (some? b)) ...)` inside a leaf function means the guard is in the wrong place — if you cannot get `a` or `b`, you should not be calling it.
- **A static set of operations is written statically.** With a fixed, small set (four metrics) write the four calls. Do not build a collection and iterate it (`doseq` over a literal vector): it allocates, adds indirection and hides each operation. Use a collection when the set is dynamic (config, registry, input).
- **Default to no `!`; existing `!` is legacy being removed gradually.** Do not introduce new `!` names except the allowed cases documented in `mem:clojure/idioms` (add and justify the special case there first). Allowed: mutating public fns in `app.db` (`insert!`, `update!`, `delete!`, `run!`, `tx-run!`, ...) and fns whose contract is to work over transients (stdlib `conj!`/`assoc!`/`dissoc!`/`persistent!` and custom helpers over them). Existing `!` elsewhere (e.g. `emit!`, `send!`, `submit!`, `validate-file!`) stays until its refactor; keep a family consistent in the meantime. Reporting helpers (log, sample-and-publish) never take `!`: the mutation happens in the `!` API they call.
- **Functions that obtain data start with `get-` or `fetch-`.** A reader must see at a glance that the function reads (`get-file`, `get-snapshot`, `get-file-json`); a bare noun hides it (`file-json` says nothing about reading). New helpers that fetch by id follow this, never a `current-` prefix: the id parameter already says which one it is.
- **`?` marks a predicate, not a data prop.** A var or function that answers a question takes `?` (`export-error?`, `(defn editable? …)`); a map key that names a property does not (`:export-error`, never `:export-error?`), even when its value is a boolean. Existing `?` keys are legacy to remove gradually; do not add a new one.
- **Do not shape production code for tests.** No return values added just to assert them; assert on the observable effect. When preconditions move, move the tests with them.
Reference implementation: the http metrics samplers in `app.http` (`sample-worker-metrics` / `sample-connector-metrics` are guard-free; `sample-http-metrics` guards at the boundary).

2
.serena/memories/critical-info.md
View File

@ -7,7 +7,7 @@ You are working on the GitHub project `penpot/penpot`, a monorepo.
- Edits/stale refs/duplication cleanup: `mem:memory-maintenance`.
- Cross-cutting testing principles, TDD workflow, and anti-patterns: `mem:testing`.
- Verified Clojure language behaviors that contradict common assumptions (e.g. `int?` covers `Long`; `integer?` is the general predicate): `mem:clojure/idioms` — read before assuming stdlib predicate semantics.
- When designing a solution or an API, read `mem:clojure/design-rules` (function shape, boundary checks, naming).
- Read `mem:clojure/design-rules` (function shape, boundary checks, naming) before writing or modifying Clojure/ClojureScript code — not only when designing a solution or an API.
# Development workflow

1
.serena/memories/exporter/core.md
View File

@ -5,6 +5,7 @@
## Layout and commands
- Source: `exporter/src/`; config: `deps.edn`, `shadow-cljs.edn`, `package.json`; runtime helpers/assets: `vendor/`, `scripts/`.
- `exporter/resources/wasm/render-wasm.{js,wasm}` and `exporter/src/app/wasm/shared.js` are generated render-wasm build output, not source: they are gitignored. Never hand-edit or commit them; regenerate by rebuilding render-wasm.
- From `exporter/`: setup `./scripts/setup`; watch `pnpm run watch` or `pnpm run watch:app`; production build `pnpm run build`; test bundle `pnpm run build:test`; tests `pnpm run test` or `pnpm run test:quiet`; lint `pnpm run lint:clj`; format check/fix `pnpm run check-fmt:clj` / `pnpm run fmt:clj`.
- Because exporter consumes `common/`, shared file/shape/model changes may need exporter verification even when the immediate change is not under `exporter/`.
- Cross-cutting testing principles and anti-patterns: `mem:testing`.

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

@ -26,12 +26,15 @@
- 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`.
- Save failures split transient vs terminal (`transient-error?`: the repo retryable types `:network`/`:offline`/`:bad-gateway`/`:service-unavailable`/`:gateway-error`, plus `:invalid-save-response`, plus save-only `busy-server-error?`: `:rate-limit` (429 from rlimit/climit — a save parked on another save's file lock holds the profile's single `:update-file/by-profile` permit, so the user's saves to other files 429 after 60 s) and backend-written 504 `:server-error` with `:statement-timeout`/`:idle-in-transaction-timeout` (Postgres cancels the lock wait at 300 s, before nginx; rolled back, so resend is safe). Kept out of `rp/retryable-types` on purpose so GETs do not retry them; 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.
- `leave-signals` (document `visibilitychange`→hidden, window `blur`) emits `::force-persist` when edits are buffered, so leaving the tab/window sends the 3 s batch at once; tests mock `dps/leave-signals` BEFORE `initialize-persistence` runs. pagehide/beforeunload are too late for an async save.
- Exports and the `.penpot` download call `force-persist-files-and-wait file-ids timeout` (waits only for those files, ends on `:error` or timeout, never raises) and then `unsaved-changes? state file-ids` to warn; it reads `refs/persistence`, so tests mock it with `(l/derived :persistence store)`.
- `persistence-failed` emits a `save-failed` audit event (`:cause-type :code :retrying :queued-commits`) whenever the user is notified (`notify-failure?`, same rule as the toast), including delegated auth/not-found failures.
- 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.

1
.serena/memories/prod-infra/core.md
View File

@ -39,6 +39,7 @@ Production runs the deployed toolbox, not the devenv one:
- **Start from the ids, not from an inventory.** The ids come from the error or the logs. Unbounded queries over tables with tens of millions of rows (`storage_object`, `file_media_object`) do not finish in a reasonable time; bounded to an id list they are index lookups.
- **One query per reference column.** Two columns in one `IN (col_a, col_b)` lose the index and scan the whole table; split them.
- The read-only replica cuts long queries: see `mem:prod-infra/grafana`.
- A migration that builds an index runs inside the migration transaction, so it cannot use `CONCURRENTLY`, and a plain `CREATE INDEX` locks the table against writes for the whole build. On a large table (file saves write to `file_change` on every save) build the index out of band, before deploying, with `CREATE INDEX CONCURRENTLY` on its own (never inside a transaction block); the shipped migration uses `IF NOT EXISTS`, finds it and does nothing. A concurrent build interrupted midway leaves the index invalid: drop it and retry (check `pg_indexes` and `pg_index.indisvalid`).
## See also

10
.serena/memories/prod-infra/grafana.md
View File

@ -6,9 +6,14 @@ Keep this memory free of internal names: no host names, no deployed versions, no
## Datasources
- Metrics — **Prometheus**, uid `xkRmyFBGk`. PromQL. Metric families: `penpot_*` (RPC, task timings, CLIMIT, HTTP, websocket, storage, and the application log events of the backend), `hikaricp_*`, `jvm_*` and `process_*` on the backend (`job="app"`); `pg_*` from the Postgres exporter (`job="postgres"`); `redis_*` from the Redis exporter (`job="redis"`); `node_*` and `container_*` from node-exporter and cAdvisor. Backend histograms are in **milliseconds**.
- Metrics — **Prometheus**, uid `xkRmyFBGk`. PromQL. Metric families: `penpot_*` (RPC, task timings, CLIMIT, HTTP, websocket, storage, and the application log events of the backend), `hikaricp_*`, `jvm_*` and `process_*` on the backend (`job="app"`); `pg_*` from the Postgres exporter (`job="postgres"`); `redis_*` from the Redis exporter (`job="redis"`); `node_*` and `container_*` from node-exporter and cAdvisor. Backend histograms are in **milliseconds**. Tails (ms): requests and waits to 60000, background tasks to 300000, Redis eval to 10000; the sub-7500 buckets are identical everywhere, so old quantiles stay comparable.
- The Postgres exporter scrapes **the primary as well as the read-only replica**, so the primary's `pg_stat_activity`, `pg_settings_*` and `pg_stat_bgwriter_*` are in Prometheus even though the SQL datasource cannot reach them (the replica's views describe the replica, not the primary).
- Per-database data from the exporter is **aggregate only**: `pg_settings_*` (the whole server configuration, so autovacuum, checkpoint and memory parameters are readable from Prometheus), `pg_stat_database_*`, `pg_stat_bgwriter_*`, `pg_stat_activity_*`, and replication/lock counts. It publishes **no per-table series** (`pg_stat_user_tables_*` resolves empty), so dead tuples, per-table reloptions and relation sizes are SQL-only questions.
- It publishes **no `pg_stat_progress_*` collector** and `pg_stat_activity_count` carries no `backend_type` label, so a session is only identifiable by its remaining labels: autovacuum workers are the bucket with `usename` and `application_name` empty plus `state="active"`, and `pg_wait_events_connections{wait_event="AutoVacuumMain"}` is the autovacuum launcher alive (absent on the replica).
- A metric the exporter does not publish itself has to be added as a custom query block in its YAML queries file on the exporter host (that is where `pg_wait_events_connections` comes from), and in this build the file is read at startup: restart the exporter after editing. There is no per-metric flag to turn on.
- Logs — **Loki**, uid `h3CGKhEMk`. LogQL, and filter by the structured metadata `logger`/`level` (`{job="penpot"} | logger="..." | level="ERROR"`). Two things to remember when counting from it: the CLIMIT rejections have their own counters (`penpot_rpc_climit_rejected_total`, by `name` and `reason`) and their `hint="rejected"` line goes out at WARN only when something is left queued behind the call (a lone caller that times out is written at TRACE), so counting lines is not counting rejections -- the same goes for `hint="enqueued"` and `hint="acquired"`; and the only signal that exists nowhere else is the profile behind a queue (`logger="app.rpc.climit"`, whose `id` carries the key), chased there on demand.
- SQL — **Postgres**, uid `y8ea9tfMk`. Panels need `rawQuery: true`, `editorMode: "code"` and `format: "table"`. The `task` table is the only truth about the queue depth. It is a **read-only replica**: it rejects any write, `CREATE TEMP TABLE` included, so queries through it must be plain `SELECT`s. It also cuts long-running queries (the MCP path has a short timeout), so bound them (e.g. a list of ids); an empty answer there is not proof that there is no data.
- The Postgres server also ships its own log (`job="postgresql"`, primary only). Those streams carry just `filename`, `instance`, `job` and `level` — no `environment`/`hostname` — so selectors need `instance=~"$host.$env.*"`. `log_autovacuum_min_duration` is low enough that every autovacuum leaves an `automatic vacuum of table "db.schema.table"` line with pages, tuples, index scans and `elapsed`: a per-table history of **finished** vacuums (retrospective, not a view of what runs now). A day of vacuums is only a couple of hundred lines, so pulling them raw over `query_range` and parsing the table, the pages scanned, `tuples: N removed` and the `removable cutoff` XID age in the client works well — less fighting than making LogQL's `pattern`/`regexp` chew a multi-line message.
- SQL — **Postgres**, uid `y8ea9tfMk`. Panels need `rawQuery: true`, `editorMode: "code"` and `format: "table"`. The `task` table is the only truth about the queue depth. It is a **read-only replica**: it rejects any write, `CREATE TEMP TABLE` included, so queries through it must be plain `SELECT`s. Catalog data (`pg_class`, `pg_partition_tree`, `pg_stats`, and `reloptions`) describes the primary faithfully, because catalogs replicate; the statistics views (`pg_stat_user_tables`, `pg_stat_all_tables`) read as zero there, since statistics are per-instance and are not replicated. It also cuts long-running queries (the MCP path has a short timeout), so bound them (e.g. a list of ids); an empty answer there is not proof that there is no data.
- **Postgres (telemetry)**, uid `9YAUuM_Gz`.
- `$__rate_interval` and `$__interval` are substituted by Grafana; use them instead of fixed windows in graphs.
@ -16,6 +21,7 @@ Keep this memory free of internal names: no host names, no deployed versions, no
- `Production status`, uid `penpot-production-status`. Sections: general state and deploy, `RPC y CLIMIT`, PostgreSQL and pool, Redis/msgbus, tasks, JVM/process. Variables `$env` and `$host` (custom), no auto refresh. Every section opens collapsed except `RPC y CLIMIT`, which is the one read on a normal day.
- Per-host investigation dashboards are separate, and the alert rules deeplink into them.
- The PostgreSQL section ends with a block of vacuum panels: two stats (autovacuum workers active on the primary, and the launcher alive), a Loki timeseries of finished vacuums per interval and table, and then the `Vacuum TXID age` table, which is the last panel of the section. The worker stat is an approximation — it counts the `pg_stat_activity` bucket described above, because the exporter publishes no `backend_type` — and the Loki panel is retrospective by construction. A per-table, in-flight view (table, phase, progress) needs a `pg_stat_progress_vacuum` collector added to the exporter itself.
## Conventions

1
.serena/memories/render-wasm/core.md
View File

@ -25,6 +25,7 @@
- The lock covers setup, Cargo build, and artifact copy. The watch process releases it while waiting for changes. The operating system releases it on success, error, or signal; the file remains.
- The lock only coordinates repository scripts. Manual Cargo commands do not take it.
- Set `RENDER_WASM_LOCK_FILE` to the same path only when separate checkouts intentionally share a `CARGO_TARGET_DIR`.
- Build output is gitignored and stays untracked everywhere it lands: `frontend/resources/public/js/render-wasm.{js,wasm}` and `frontend/src/app/render_wasm/api/shared.js` from `./build`, plus `exporter/resources/wasm/render-wasm.{js,wasm}` and `exporter/src/app/wasm/shared.js`. Never commit generated JS/WASM; rebuild instead.
## Commands

1
.serena/memories/scripts/gh.md
View File

@ -119,6 +119,7 @@ python3 scripts/gh.py advisories GHSA-xvj6-fh9w-gjw7
## Key principles
- `issues --compare` collects every `#NNNN` token in the file regardless of its link target, so a same-numbered reference to another tracker (e.g. `[Taiga #12312](...)`) or an inline prose number falsely marks that GitHub issue as already listed; verify against `changelog.py cross-ref` when a number collides.
- Changelog-specific checks (merge-status verification, milestone-vs-changelog cross-reference, anomaly report) live in `scripts/changelog.py`, which calls this script via subprocess — see `mem:scripts/changelog`.
- All output is JSON — pipe into `jq` or other tools for further processing.

6
.serena/memories/workflow/creating-commits.md
View File

@ -2,6 +2,12 @@
Commit only on explicit request. Before commit: `git status`; exclude unrelated user changes.
**Never stage a plan file.** A plan is session bookkeeping, not part of the
change: the commit carries the code and the tests. The `implement-plan` flow
still closes the plan (`Status: done` plus one `Review Log` line with the issue
URL); that is not a file to ship, and its absence from the commit is correct,
not a missing piece.
Do not guess or hallucinate git author information (Name or Email). Never include the
`--author` flag in git commands unless specifically instructed by the user for a unique
case; assume the local environment is already configured. Allow git commit to

4
CHANGES.md
View File

@ -129,11 +129,15 @@
- Fix file restore leaving its storage objects marked for deletion [#12278](https://github.com/penpot/penpot/issues/12278) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Fix backend workers staying parked forever when nested calls take the same concurrency limits [#12279](https://github.com/penpot/penpot/issues/12279) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Fix one profile's activity blocking the audit events of every other profile [#12280](https://github.com/penpot/penpot/issues/12280) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Fix storage garbage collection blocking database vacuum during long deletions [#12396](https://github.com/penpot/penpot/issues/12396) (PR: [#12397](https://github.com/penpot/penpot/pull/12397))
- Fix saving a version taking seconds and the version quota never counting saved versions [#12404](https://github.com/penpot/penpot/issues/12404) (PR: [#12405](https://github.com/penpot/penpot/pull/12405))
- Fix file_change accumulating revisions that the objects GC never collects [#12418](https://github.com/penpot/penpot/issues/12418) (PR: [#12419](https://github.com/penpot/penpot/pull/12419))
### :sparkles: New features & Enhancements
- Add a graceful instance drain through the /readyz endpoint [#12281](https://github.com/penpot/penpot/issues/12281) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Add an accumulated queue gauge to the CLIMIT metrics [#12282](https://github.com/penpot/penpot/issues/12282) (PR: [#12269](https://github.com/penpot/penpot/pull/12269))
- Expose the backend log events as a metric by logger and level [#12312](https://github.com/penpot/penpot/issues/12312) (PR: [#12313](https://github.com/penpot/penpot/pull/12313))
## 2.18.3

19
backend/scripts/decode-file-data Executable file
View File

@ -0,0 +1,19 @@
#!/usr/bin/env bash
# Decode a file_data blob (app.util.blob) to JSON for inspection with jq.
#
# Offline use (no DB):
# backend/scripts/decode-file-data --input /tmp/blob.bin --format summary | jq .
#
# DB use (backend running, via nREPL):
# ./scripts/nrepl-eval.mjs "(require '[app.scripts.decode-file-data :as dfd] :reload)"
# ./scripts/nrepl-eval.mjs '(dfd/get-file-json sys/system #uuid "..." :format :summary)'
SCRIPT_DIR=$(dirname "$0")
source "$SCRIPT_DIR/_env"
if [ -f "$SCRIPT_DIR/_env.local" ]; then
source "$SCRIPT_DIR/_env.local"
fi
exec clojure -M:dev -m app.scripts.decode-file-data "$@"

24
backend/src/app/binfile/common.clj
View File

@ -708,16 +708,28 @@
library-ids)]
(absorb-unlinked-tokens-source cfg data library-ids)))
(def ^:const import-transaction-timeout-ms
"Ceiling for binfile import transactions (20 minutes). Interpolated
directly into SQL: compile-time constant, never user input."
(* 20 60 1000))
(def transaction-idle-timeout-ms
"Idle-in-transaction guard for the long binfile transactions: 30
minutes. The import and the export of a file run inside one
transaction that can go quiet while the ZIP is decoded and the file
data is realized. The longest operation observed in production is
under 8 minutes, so this leaves room for bigger files and still
aborts a connection that is left idle for half an hour."
1800000)
(defn configure-database-timeouts!
(defn set-transaction-idle-timeout
"Set `idle_in_transaction_session_timeout` for the current
transaction. Must be called inside a transaction: `SET LOCAL` is
scoped to it."
[cfg]
(let [conn (db/get-connection cfg)]
(db/exec-one! conn [(str "SET LOCAL idle_in_transaction_session_timeout = "
import-transaction-timeout-ms)])
transaction-idle-timeout-ms)])))
(defn configure-import-transaction
[cfg]
(set-transaction-idle-timeout cfg)
(let [conn (db/get-connection cfg)]
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])))
(defn process-file

2
backend/src/app/binfile/v1.clj
View File

@ -455,7 +455,7 @@
(defn- read-import-v1
[{:keys [::db/conn ::bfc/project-id ::bfc/profile-id ::bfc/input] :as cfg}]
(bfc/configure-database-timeouts! cfg)
(bfc/configure-import-transaction cfg)
(pu/with-open [input (zstd-input-stream input)
input (io/data-input-stream input)]

5
backend/src/app/binfile/v3.clj
View File

@ -248,6 +248,7 @@
(let [detach? (= export-type :detach-libraries)
embed? (= export-type :merge-libraries)]
(db/tx-run! cfg (fn [cfg]
(bfc/set-transaction-idle-timeout cfg)
(cond-> (bfc/get-file cfg file-id
{:realize? true
:include-deleted? true
@ -1181,7 +1182,7 @@
(defn- import-files*
[{:keys [::manifest] :as cfg}]
(bfc/configure-database-timeouts! cfg)
(bfc/configure-import-transaction cfg)
(vswap! bfc/*state* update :index bfc/update-index (:files manifest) :id)
@ -1249,7 +1250,7 @@
:hint "unable to perform in-place update with binfile containing more than 1 file"
:manifest manifest))
(bfc/configure-database-timeouts! cfg)
(bfc/configure-import-transaction cfg)
(let [ref-file (bfc/get-minimal-file cfg file-id ::db/for-update true)
file (first (get manifest :files))

30
backend/src/app/main.clj
View File

@ -26,7 +26,7 @@
[app.http.session.tasks :as-alias session.tasks]
[app.http.websocket :as http.ws]
[app.loggers.webhooks :as-alias webhooks]
[app.metrics :as-alias mtx]
[app.metrics :as mtx]
[app.metrics.definition :as-alias mdef]
[app.msgbus :as-alias mbus]
[app.redis :as-alias rds]
@ -68,16 +68,25 @@
::mdef/help "A total number of bytes processed by update-file."
::mdef/type :counter}
:update-file-validation-timing
{::mdef/name "penpot_rpc_update_file_validation_timing"
::mdef/help "update-file validation step timings (milliseconds)."
::mdef/labels ["step"]
::mdef/buckets mtx/default-request-histogram-buckets
::mdef/type :histogram}
:rpc-main-timing
{::mdef/name "penpot_rpc_main_timing"
::mdef/help "RPC command method call timing for main"
::mdef/labels ["name"]
::mdef/buckets mtx/default-request-histogram-buckets
::mdef/type :histogram}
:rpc-management-timing
{::mdef/name "penpot_rpc_management_timing"
::mdef/help "RPC command method call timing for management."
::mdef/labels ["name"]
::mdef/buckets mtx/default-request-histogram-buckets
::mdef/type :histogram}
:websocket-active-connections
@ -105,12 +114,20 @@
{::mdef/name "penpot_tasks_timing"
::mdef/help "Background tasks timing (milliseconds)."
::mdef/labels ["name"]
::mdef/buckets mtx/default-tasks-histogram-buckets
::mdef/type :histogram}
:storage-gc-deleted-objects
{::mdef/name "penpot_storage_gc_deleted_objects_total"
::mdef/help "Storage objects permanently deleted by storage-gc-deleted, by backend."
::mdef/labels ["backend"]
::mdef/type :counter}
:redis-eval-timing
{::mdef/name "penpot_redis_eval_timing"
::mdef/help "Redis EVAL commands execution timings (ms)"
::mdef/labels ["name"]
::mdef/buckets mtx/default-redis-histogram-buckets
::mdef/type :histogram}
:rpc-climit-waiting
@ -129,6 +146,7 @@
{::mdef/name "penpot_rpc_climit_timing"
::mdef/help "Summary of the time between queuing and executing on the CLIMIT"
::mdef/labels ["name"]
::mdef/buckets mtx/default-request-histogram-buckets
::mdef/type :histogram}
:audit-http-handler-queue-size
@ -147,6 +165,7 @@
{::mdef/name "penpot_audit_http_handler_timing"
::mdef/help "Summary of the time between queuing and executing on the audit log http handler"
::mdef/labels []
::mdef/buckets mtx/default-request-histogram-buckets
::mdef/type :histogram}
:storage-s3-requests
@ -196,6 +215,7 @@
{::mdef/name "penpot_http_server_dispatch_timing"
::mdef/help "Histogram of dispatch handler"
::mdef/labels []
::mdef/buckets mtx/default-request-histogram-buckets
::mdef/type :histogram}
:http-worker-queue-size
@ -280,7 +300,8 @@
::sto.gc-deleted/handler
{::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)}
::sto/storage (ig/ref ::sto/storage)
::mtx/metrics (ig/ref ::mtx/metrics)}
::sto.gc-touched/handler
{::db/pool (ig/ref ::db/pool)
@ -647,8 +668,9 @@
{:cron #penpot/cron "0 0 0 * * ?" ;; daily
:task :objects-gc}
{:cron #penpot/cron "0 0 0 * * ?" ;; daily
:task :storage-gc-deleted}
;; FIXME: temporary commented
;; {:cron #penpot/cron "0 0 0 * * ?" ;; daily
;; :task :storage-gc-deleted}
{:cron #penpot/cron "0 0 0 * * ?" ;; daily
:task :storage-gc-touched}

19
backend/src/app/metrics.clj
View File

@ -147,6 +147,25 @@
(number? value) (str value)
:else fallback))
;; Tail for request and wait timings (RPC, CLIMIT waits, audit handler,
;; HTTP dispatch): covers the 30s/60s CLIMIT timeouts while keeping the
;; sub-7.5s resolution of the default buckets untouched.
(def default-request-histogram-buckets
[1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500
10000 15000 30000 60000])
;; Tail for background tasks (GC sweeps, file workers): they run until
;; done with no CLIMIT timeout, bounded in practice by the 300s postgres
;; statement timeout.
(def default-tasks-histogram-buckets
[1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500
10000 15000 30000 60000 120000 300000])
;; Tail for Redis eval: sub-second in practice, one extra bucket covers
;; the pathological (timeout) case without adding idle series.
(def default-redis-histogram-buckets
[1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500 10000])
(defmulti run-collector! (fn [mdef _] (::mdef/type mdef)))
(defmulti create-collector ::mdef/type)

8
backend/src/app/migrations.clj
View File

@ -520,7 +520,13 @@
:fn (mg/resource "app/migrations/sql/0153-del-orphan-profile-rels-after-team-leave.sql")}
{:name "0154-del-legacy-file-object-thumbnail-table"
:fn (mg/resource "app/migrations/sql/0154-del-legacy-file-object-thumbnail-table.sql")}])
:fn (mg/resource "app/migrations/sql/0154-del-legacy-file-object-thumbnail-table.sql")}
{:name "0155-add-idx-to-file-change"
:fn (mg/resource "app/migrations/sql/0155-add-idx-to-file-change.sql")}
{:name "0156-reset-pg-storage-defaults"
:fn (mg/resource "app/migrations/sql/0156-reset-pg-storage-defaults.sql")}])
(defn apply-migrations!
[pool name migrations]

38
backend/src/app/migrations/sql/0155-add-idx-to-file-change.sql Normal file
View File

@ -0,0 +1,38 @@
-- Index for the version (snapshot) quota checks of app.rpc.quotes:
-- sql:get-snapshots-per-file and sql:get-snapshots-per-team count the live
-- versions created by a user, and this partial index answers both counts
-- with an index only scan, without walking the whole file_change table.
--
-- The predicate must stay identical to the queries: the planner only uses a
-- partial index when the query where clause implies the index predicate.
-- Versions are told apart by label (every snapshot has one); file_change.data
-- is a legacy column, only written by the legacy-db file data backend.
CREATE INDEX IF NOT EXISTS file_change__user_snapshots__idx
ON file_change (file_id)
WHERE label IS NOT NULL
AND created_by = 'user'
AND deleted_at IS NULL;
-- NOTE: on instances where file_change is large, run the statement above
-- out of band, before deploying, with CONCURRENTLY instead: this migration
-- runs inside a transaction, and a plain CREATE INDEX locks the table
-- against writes for the whole build (in Penpot every file save writes a row
-- here), while CONCURRENTLY does not. Run it on its own, not inside a
-- transaction block:
--
-- CREATE INDEX CONCURRENTLY IF NOT EXISTS file_change__user_snapshots__idx
-- ON file_change (file_id)
-- WHERE label IS NOT NULL
-- AND created_by = 'user'
-- AND deleted_at IS NULL;
--
-- A CONCURRENTLY build interrupted midway leaves the index INVALID: drop it
-- and retry. Verify with:
--
-- SELECT indexdef FROM pg_indexes
-- WHERE indexname = 'file_change__user_snapshots__idx';
-- SELECT indisvalid FROM pg_index
-- WHERE indexrelid = 'file_change__user_snapshots__idx'::regclass;
--
-- Once the index exists, this migration finds it and does nothing.

129
backend/src/app/migrations/sql/0156-reset-pg-storage-defaults.sql Normal file
View File

@ -0,0 +1,129 @@
-- Reset explicit `STORAGE EXTERNAL` settings back to the PostgreSQL defaults.
--
-- Those were set when PostgreSQL ran on top of ZFS with transparent
-- compression (see 0041-mod-pg-storage-options.sql and the per-table
-- migrations that followed it): skipping the TOAST compression done by
-- PostgreSQL made sense there. On regular filesystems it only wastes
-- space and I/O bandwidth, so restore the default storage strategy of
-- each column type (EXTENDED for every column below: text, text[],
-- jsonb and bytea).
--
-- This only touches the catalog, it does not rewrite the tables:
-- already stored TOAST values keep their strategy until the row is
-- rewritten, new writes use the default.
--
-- NOTE: DEFAULT restores the storage mode of the column's data type
-- (EXTENDED for every column below: text, text[], jsonb and bytea). It
-- requires PostgreSQL 16 or newer, which is the minimum version the
-- project supports (see the database section of the technical guide).
-- RESET STORAGE is not valid syntax for a column.
ALTER TABLE access_token
ALTER COLUMN name SET STORAGE DEFAULT,
ALTER COLUMN perms SET STORAGE DEFAULT,
ALTER COLUMN token SET STORAGE DEFAULT;
ALTER TABLE audit_log
ALTER COLUMN context SET STORAGE DEFAULT,
ALTER COLUMN name SET STORAGE DEFAULT,
ALTER COLUMN props SET STORAGE DEFAULT,
ALTER COLUMN source SET STORAGE DEFAULT,
ALTER COLUMN type SET STORAGE DEFAULT;
ALTER TABLE comment
ALTER COLUMN content SET STORAGE DEFAULT;
ALTER TABLE comment_thread
ALTER COLUMN page_name SET STORAGE DEFAULT,
ALTER COLUMN participants SET STORAGE DEFAULT;
ALTER TABLE file
ALTER COLUMN data SET STORAGE DEFAULT,
ALTER COLUMN data_backend SET STORAGE DEFAULT,
ALTER COLUMN features SET STORAGE DEFAULT,
ALTER COLUMN name SET STORAGE DEFAULT;
ALTER TABLE file_change
ALTER COLUMN changes SET STORAGE DEFAULT,
ALTER COLUMN data SET STORAGE DEFAULT,
ALTER COLUMN features SET STORAGE DEFAULT,
ALTER COLUMN label SET STORAGE DEFAULT;
ALTER TABLE file_data_fragment
ALTER COLUMN metadata SET STORAGE DEFAULT;
ALTER TABLE file_media_object
ALTER COLUMN mtype SET STORAGE DEFAULT,
ALTER COLUMN name SET STORAGE DEFAULT;
ALTER TABLE file_thumbnail
ALTER COLUMN data SET STORAGE DEFAULT,
ALTER COLUMN props SET STORAGE DEFAULT;
ALTER TABLE global_complaint_report
ALTER COLUMN content SET STORAGE DEFAULT,
ALTER COLUMN type SET STORAGE DEFAULT;
ALTER TABLE profile
ALTER COLUMN auth_backend SET STORAGE DEFAULT,
ALTER COLUMN email SET STORAGE DEFAULT,
ALTER COLUMN fullname SET STORAGE DEFAULT,
ALTER COLUMN lang SET STORAGE DEFAULT,
ALTER COLUMN password SET STORAGE DEFAULT,
ALTER COLUMN props SET STORAGE DEFAULT,
ALTER COLUMN theme SET STORAGE DEFAULT;
ALTER TABLE profile_complaint_report
ALTER COLUMN content SET STORAGE DEFAULT,
ALTER COLUMN type SET STORAGE DEFAULT;
ALTER TABLE project
ALTER COLUMN name SET STORAGE DEFAULT;
ALTER TABLE scheduled_task
ALTER COLUMN cron_expr SET STORAGE DEFAULT,
ALTER COLUMN id SET STORAGE DEFAULT;
ALTER TABLE server_error_report
ALTER COLUMN content SET STORAGE DEFAULT;
ALTER TABLE server_prop
ALTER COLUMN content SET STORAGE DEFAULT,
ALTER COLUMN id SET STORAGE DEFAULT;
ALTER TABLE storage_object
ALTER COLUMN backend SET STORAGE DEFAULT,
ALTER COLUMN metadata SET STORAGE DEFAULT;
ALTER TABLE task
ALTER COLUMN error SET STORAGE DEFAULT,
ALTER COLUMN label SET STORAGE DEFAULT,
ALTER COLUMN name SET STORAGE DEFAULT,
ALTER COLUMN props SET STORAGE DEFAULT,
ALTER COLUMN queue SET STORAGE DEFAULT,
ALTER COLUMN status SET STORAGE DEFAULT;
ALTER TABLE team
ALTER COLUMN name SET STORAGE DEFAULT;
ALTER TABLE team_font_variant
ALTER COLUMN font_family SET STORAGE DEFAULT,
ALTER COLUMN font_style SET STORAGE DEFAULT;
ALTER TABLE team_invitation
ALTER COLUMN email_to SET STORAGE DEFAULT,
ALTER COLUMN role SET STORAGE DEFAULT;
ALTER TABLE usage_quote
ALTER COLUMN target SET STORAGE DEFAULT;
ALTER TABLE webhook
ALTER COLUMN error_code SET STORAGE DEFAULT,
ALTER COLUMN mtype SET STORAGE DEFAULT,
ALTER COLUMN secret_key SET STORAGE DEFAULT,
ALTER COLUMN uri SET STORAGE DEFAULT;
ALTER TABLE webhook_delivery
ALTER COLUMN error_code SET STORAGE DEFAULT,
ALTER COLUMN req_data SET STORAGE DEFAULT,
ALTER COLUMN rsp_data SET STORAGE DEFAULT;

10
backend/src/app/rpc/commands/files.clj
View File

@ -1336,8 +1336,16 @@
WHERE file_id = ANY(?::uuid[])")
(def ^:private sql:restore-file-changes
;; Only durable history comes back: a snapshot (carries `label`) or a legacy
;; payload row (carries `data`, the column the new model replaces with
;; `file_data`). Revisions have neither and are deliberately left alone: they
;; are born already scheduled for deletion one hour later, and the collector
;; only looks at rows that carry a date, so unmarking one here would keep it
;; in the table for ever. The `data` half is a guard for the rows still
;; pending migration, not a dependency: drop it with the last one.
"UPDATE file_change SET deleted_at = null
WHERE file_id = ANY(?::uuid[])")
WHERE file_id = ANY(?::uuid[])
AND (label IS NOT NULL OR data IS NOT NULL)")
(def ^:private sql:restore-file-data
"UPDATE file_data SET deleted_at = null

119
backend/src/app/rpc/commands/files_update.clj
View File

@ -168,7 +168,8 @@
(assoc :file file)
(assoc :changes changes))
cfg (assoc cfg ::timestamp (ct/now))
cfg (assoc cfg ::timestamp (ct/now)
::validation-timings (atom {}))
tpoint (ct/tpoint)]
@ -209,9 +210,39 @@
(binding [l/*context* (some-> (meta params)
(get :app.http/request)
(errors/request->context))]
(-> (update-file* cfg params)
(rph/with-defer #(let [elapsed (tpoint)]
(l/trace :hint "update-file" :time (ct/format-duration elapsed))))))))
(try
(-> (update-file* cfg params)
(rph/with-defer #(let [elapsed (tpoint)
timings @(::validation-timings cfg)]
(l/dbg :hint "update-file"
:file-id (str (:id file))
:project-id (str (:project-id file))
:team-id (str (:team-id file))
:status "success"
:time (ct/format-duration elapsed)
:resolve-libs-ms (get timings :resolve-libs-ms)
:process-changes-ms (get timings :process-changes-ms)
:soft-validate-affected-ms (get timings :soft-validate-affected-ms)
:soft-validate-schema-ms (get timings :soft-validate-schema-ms)
:validate-affected-ms (get timings :validate-affected-ms)
:validate-schema-ms (get timings :validate-schema-ms)))))
(catch Throwable cause
;; NOTE: `with-defer` hooks only run on the success path
;; (`handle-response`), so timings collected before a hard
;; validation failure would be lost without this inline log.
(let [timings @(::validation-timings cfg)]
(l/dbg :hint "update-file"
:file-id (str (:id file))
:project-id (str (:project-id file))
:team-id (str (:team-id file))
:status "error"
:resolve-libs-ms (get timings :resolve-libs-ms)
:process-changes-ms (get timings :process-changes-ms)
:soft-validate-affected-ms (get timings :soft-validate-affected-ms)
:soft-validate-schema-ms (get timings :soft-validate-schema-ms)
:validate-affected-ms (get timings :validate-affected-ms)
:validate-schema-ms (get timings :validate-schema-ms)))
(throw cause))))))
(defn- update-file*
"Internal function, part of the update-file process, that encapsulates
@ -385,6 +416,16 @@
(catch Throwable cause
(l/error :hint "file schema validation error" :cause cause))))
(defn- record-validation-timing
[cfg step-key step-label elapsed-ms]
(when-let [metrics (::mtx/metrics cfg)]
(when (mtx/metrics? metrics)
(mtx/run! metrics {:id :update-file-validation-timing
:labels [step-label]
:val (double elapsed-ms)})))
(when-let [timings (::validation-timings cfg)]
(swap! timings assoc step-key elapsed-ms)))
(defn- soft-validate-file!
[file libs changes]
(try
@ -395,11 +436,21 @@
(defn- process-changes-and-validate
[cfg file changes skip-validate]
(let [libs
(when (and (or (contains? cf/flags :file-validation)
(contains? cf/flags :soft-file-validation))
(not skip-validate))
(bfc/get-resolved-file-libraries cfg file))
(let [should-resolve-libs?
(and (or (contains? cf/flags :file-validation)
(contains? cf/flags :soft-file-validation))
(not skip-validate))
tlibs
(ct/tpoint)
libs
(try
(when should-resolve-libs?
(bfc/get-resolved-file-libraries cfg file))
(finally
(when should-resolve-libs?
(record-validation-timing cfg :resolve-libs-ms "resolve-libs" (inst-ms (tlibs))))))
;; The main purpose of this atom is provide a contextual state
;; for the changes subsystem where optionally some hints can
@ -409,32 +460,56 @@
state
(atom {})
file
(binding [cpc/*state* state]
(-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes)
(update :data d/without-nils)))
tproc
(ct/tpoint)
file
(if-let [media-refs (-> @state :media-refs not-empty)]
(bfc/update-media-references! cfg file media-refs)
file)]
(try
(let [file
(binding [cpc/*state* state]
(-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes)
(update :data d/without-nils)))
file
(if-let [media-refs (-> @state :media-refs not-empty)]
(bfc/update-media-references! cfg file media-refs)
file)]
file)
(finally
(record-validation-timing cfg :process-changes-ms "process-changes" (inst-ms (tproc)))))]
(binding [pmap/*tracked* nil]
(when (contains? cf/flags :soft-file-validation)
(soft-validate-file! file libs changes))
(let [t (ct/tpoint)]
(try
(soft-validate-file! file libs changes)
(finally
(record-validation-timing cfg :soft-validate-affected-ms "soft-validate-affected" (inst-ms (t)))))))
(when (contains? cf/flags :soft-file-schema-validation)
(soft-validate-file-schema! file))
(let [t (ct/tpoint)]
(try
(soft-validate-file-schema! file)
(finally
(record-validation-timing cfg :soft-validate-schema-ms "soft-validate-schema" (inst-ms (t)))))))
(when (and (contains? cf/flags :file-validation)
(not skip-validate))
(val/validate-file-affected! file libs changes))
(let [t (ct/tpoint)]
(try
(val/validate-file-affected! file libs changes)
(finally
(record-validation-timing cfg :validate-affected-ms "validate-affected" (inst-ms (t)))))))
(when (and (contains? cf/flags :file-schema-validation)
(not skip-validate))
(val/validate-file-schema! file)))
(let [t (ct/tpoint)]
(try
(val/validate-file-schema! file)
(finally
(record-validation-timing cfg :validate-schema-ms "validate-schema" (inst-ms (t))))))))
file))

17
backend/src/app/rpc/commands/media.clj
View File

@ -40,6 +40,9 @@
(declare create-file-media-object)
;; TEMPORARILY DISABLED (2026-10-19): the media-storage-bytes-per-team
;; quote check that used this lookup is disabled below. Kept active
;; because the audit props of the upload still report the team id.
(def ^:private sql:get-team-id-for-file
"SELECT p.team_id
FROM file AS f
@ -66,11 +69,15 @@
(media.v/validate-media-size! content)
(let [team-id (:team-id (db/exec-one! pool [sql:get-team-id-for-file file-id]))]
(quotes/check! cfg {::quotes/id ::quotes/media-storage-bytes-per-team
::quotes/profile-id profile-id
::quotes/team-id team-id
::quotes/incr (:size content)})
;; TEMPORARILY DISABLED (2026-10-19): media-storage-bytes-per-team
;; quote performs a full SUM over storage_object per upload (3-12s in
;; prod on a 3.5TB DB, ~34 slow executions/hour). Disabled until we
;; land a cheaper approximation (cached counter / rewritten query).
;; TODO: re-enable with the new implementation.
;; (quotes/check! cfg {::quotes/id ::quotes/media-storage-bytes-per-team
;; ::quotes/profile-id profile-id
;; ::quotes/team-id team-id
;; ::quotes/incr (:size content)})
(db/run! cfg (fn [{:keys [::db/conn] :as cfg}]
;; We get the minimal file for proper checking if
;; file is not already deleted

4
backend/src/app/rpc/quotes.clj
View File

@ -427,7 +427,7 @@
WHERE fc.file_id = ?
AND fc.created_by = 'user'
AND fc.deleted_at IS NULL
AND fc.data IS NOT NULL")
AND fc.label IS NOT NULL")
(defmethod check-quote ::snapshots-per-file
[{:keys [::profile-id ::file-id ::team-id ::project-id ::target] :as quote}]
@ -460,7 +460,7 @@
WHERE p.team_id = ?
AND fc.created_by = 'user'
AND fc.deleted_at IS NULL
AND fc.data IS NOT NULL")
AND fc.label IS NOT NULL")
(defmethod check-quote ::snapshots-per-team
[{:keys [::profile-id ::team-id ::target] :as quote}]

300
backend/src/app/scripts/decode_file_data.clj Normal file
View File

@ -0,0 +1,300 @@
;; 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
(ns app.scripts.decode-file-data
"Decode a file's `file_data` binary blob to `jq`-readable JSON.
The content of `file_data.data` (and `file.data` on the `legacy-db`
backend, or the `file-data` object on storage) is not text: it is a blob
encoded with `app.util.blob` (versions 1, 3, 4 and 5; transit+json or
fressian plus lz4/zstd). That is why it cannot be inspected with SQL
directly.
Two uses:
1. Offline (no DB, just the blob): dump the `bytea` to a file with
`psql` (`\\copy ...` or `encode(data, 'base64')`) and pass it with `--input`.
Needs no system and no `file_data` read permissions.
backend/scripts/decode-file-data --input /tmp/blob.bin --format summary | jq .
backend/scripts/decode-file-data --input /tmp/blob.b64 --from-base64 --format pages | jq .
2. Inside the penpot context (nREPL with the backend running, where
`sys/system` already exists): call `get-file-json` or `get-snapshot-json`.
They resolve the backend (`legacy-db`, `db`, `storage`), realize the
pointer-maps and objects-maps and return JSON.
(require '[app.scripts.decode-file-data :as dfd] :reload)
(spit \"/tmp/maquette.json\"
(dfd/get-file-json sys/system #uuid \"9e056cfe-f83f-81f8-8008-cc885732f00d\"
:format :full))
(spit \"/tmp/snap-518.json\"
(dfd/get-snapshot-json sys/system #uuid \"9e056cfe-f83f-81f8-8008-cc885732f00d\"
#uuid \"<snapshot-id>\" :format :summary))
Then filter with `jq`: `.pages`, `.data[\"pages-index\"] | keys`,
`[.data[\"pages-index\"][] | {id, name}]`, etc."
(:require
[app.binfile.common :as bfc]
[app.common.json :as json]
[app.db :as db]
[app.features.file-snapshots :as fsnap]
[app.util.blob :as blob]
[app.util.objects-map :as omap-legacy]
[app.util.pointer-map :as pmap]
[clojure.java.io :as io]
[clojure.string :as str])
(:import
java.util.Base64))
(set! *warn-on-reflection* true)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; JSON sanitization
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- sanitize-key
[k]
(cond
(keyword? k) (subs (str k) 1)
(symbol? k) (str k)
(uuid? k) (str k)
:else (str k)))
(declare sanitize)
(defn- sanitize-map
[m]
(persistent!
(reduce-kv (fn [acc k v]
(assoc! acc (sanitize-key k) (sanitize v)))
(transient {})
m)))
(defn sanitize
"Convert a blob-decoded value to plain JSON-ready data.
- Unrealized pointers become `{\"$pointer\": \"<uuid>\"}`.
- `objects-map` instances are materialized to a plain map.
- Bytes become `{\"$bytes\": \"<base64>\"}`.
- UUIDs, instants, keywords and symbols become strings."
[x]
(cond
(nil? x) nil
(string? x) x
(boolean? x) x
(number? x)
(if (ratio? x) (double x) x)
(keyword? x) (subs (str x) 1)
(symbol? x) (str x)
(uuid? x) (str x)
(inst? x) (str x)
(bytes? x)
{"$bytes" (.encodeToString (Base64/getEncoder) ^bytes x)}
(pmap/pointer-map? x)
{"$pointer" (str (pmap/get-id x))}
(omap-legacy/objects-map? x)
(sanitize (into {} x))
(map? x)
(sanitize-map x)
(set? x)
(mapv sanitize x)
(coll? x)
(mapv sanitize x)
:else
(str x)))
(defn data->json
"Encode sanitizable data to a JSON string."
[data]
(json/encode (sanitize data)))
(defn blob->json
"Decode a `file_data` blob (`app.util.blob`) and return it as JSON."
[^bytes blob-bytes]
(data->json (blob/decode blob-bytes)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; jq-oriented investigation summary
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn summarize-data
"Small, stable summary for `jq`: pages (in `:pages` order) with object
counts, plus component, color and typography counters. Takes the already
decoded `:data` (not the JSON)."
[data]
(let [pages (:pages data)
pages-index (:pages-index data)
page-entry (fn [pid]
{:id (str pid)
:name (get-in pages-index [pid :name])
:objects (count (get-in pages-index [pid :objects]))})]
{:pages (mapv page-entry (or pages []))
:stats {:pages (count (or pages []))
:components (count (:components data))
:colors (count (:colors data))
:typographies (count (:typographies data))}}))
(defn file-data-summary-json
[data]
(data->json (summarize-data data)))
(defn file-data-pages-json
[data]
(data->json (:pages (summarize-data data))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DB access (for use from nREPL with the backend running)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- write-output
[^String payload output]
(if output
(do (spit output payload) output)
(print payload))
payload)
(defn get-file-json
"Return a file as JSON (realized). For nREPL.
`format` can be `:full` (whole file), `:data` (`:data` only),
`:summary` or `:pages`. With `:output` it also writes it to a file."
[system file-id & {:keys [format output] :or {format :full}}]
(let [file (db/run! system bfc/get-file file-id :realize? true)
data (case format
:full file
:data (:data file)
:summary (summarize-data (:data file))
:pages (:pages (summarize-data (:data file))))]
(write-output (data->json data) output)))
(defn get-snapshot-json
"Return a snapshot as JSON (realized). For nREPL.
Takes the same `format` and `output` as `get-file-json`."
[system file-id snapshot-id & {:keys [format output] :or {format :full}}]
(let [snapshot (db/run! system
(fn [cfg]
(fsnap/get-snapshot cfg file-id snapshot-id)))
data (case format
:full snapshot
:data (:data snapshot)
:summary (summarize-data (:data snapshot))
:pages (:pages (summarize-data (:data snapshot))))]
(write-output (data->json data) output)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Offline CLI: decode a file holding the blob
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private cli-usage
(str "Usage: decode-file-data --input PATH [--output PATH] [--format full|data|summary|pages]\n"
" [--from-base64|--from-hex]\n"
"\n"
"Decode a file_data blob (app.util.blob) to JSON for inspection with jq.\n"
"\n"
"Examples:\n"
" psql -c \"\\\\copy (select data from file_data where file_id='...' and id='...') to '/tmp/blob.bin' with binary\"\n"
" decode-file-data --input /tmp/blob.bin --format summary | jq .\n"
" decode-file-data --input /tmp/blob.b64 --from-base64 --format pages | jq .\n"))
(defn- parse-args
[args]
(loop [args args
opts {:format "full"}]
(if (empty? args)
opts
(let [[a b & rest-args] args]
(cond
(contains? #{"-h" "--help"} a)
(assoc opts :help true)
(= a "--input")
(recur rest-args (assoc opts :input b))
(= a "--output")
(recur rest-args (assoc opts :output b))
(= a "--format")
(recur rest-args (assoc opts :format b))
(= a "--from-base64")
(recur (cons b rest-args) (assoc opts :from :base64))
(= a "--from-hex")
(recur (cons b rest-args) (assoc opts :from :hex))
:else
(assoc opts :error (str "unknown argument: " a)))))))
(defn- hex->bytes
[^String s]
(let [s (str/trim s)
s (cond
(str/starts-with? s "\\x") (subs s 2)
(str/starts-with? s "0x") (subs s 2)
:else s)
s (str/replace s #"\s+" "")
n (/ (count s) 2)
out (byte-array n)]
(dotimes [i n]
(aset-byte out i (unchecked-byte (Integer/parseInt (subs s (* i 2) (+ (* i 2) 2)) 16))))
out))
(defn- read-input-bytes
[{:keys [input from]}]
(cond
(nil? input)
(throw (ex-info "missing --input" {}))
(= from :base64)
(.decode (Base64/getDecoder) ^String (str/trim (slurp (io/file input))))
(= from :hex)
(hex->bytes (slurp (io/file input)))
:else
(java.nio.file.Files/readAllBytes (.toPath (io/file input)))))
(defn -main
[& args]
(let [{:keys [help error input format output] :as opts} (parse-args (vec args))]
(cond
help
(do (print cli-usage) nil)
error
(do (binding [*out* *err*] (println error) (println cli-usage)) (System/exit 2))
(nil? input)
(do (binding [*out* *err*] (println "missing --input") (println cli-usage)) (System/exit 2))
(not (contains? #{"full" "data" "summary" "pages"} (or format "full")))
(do (binding [*out* *err*] (println (str "unknown format: " format))) (System/exit 2))
:else
(let [blob-bytes (read-input-bytes opts)
decoded (blob/decode blob-bytes)
payload (case format
"full" decoded
"data" (:data decoded (:data decoded decoded))
"summary" (summarize-data (:data decoded decoded))
"pages" (:pages (summarize-data (:data decoded decoded))))
;; NOTE: the file_data blob already IS the file's :data; but if
;; someone dumps the whole serialized row, tolerate both.
out (data->json payload)]
(if output
(spit output out)
(println out))))))

290
backend/src/app/storage/gc_deleted.clj
View File

@ -17,178 +17,168 @@
[app.common.logging :as l]
[app.common.time :as ct]
[app.db :as db]
[app.metrics :as mtx]
[app.storage :as sto]
[app.storage.impl :as impl]
[clojure.set :as set]
[integrant.core :as ig]))
(def ^:private max-attempts
"Maximum number of deletion attempts before giving up and accepting
the orphan blob."
7)
(def ^:private chunk-size
"Pending objects deleted in each transaction."
25)
(def ^:private sql:lock-sobjects
"SELECT id FROM storage_object
WHERE id = ANY(?::uuid[])
FOR UPDATE
SKIP LOCKED")
(defn- lock-ids
"Perform a select before delete for proper object locking and
prevent concurrent operations and we proceed only with successfully
locked objects."
[conn ids]
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-sobjects ids])
(into #{} (map :id))
(not-empty))))
(def ^:private sql:delete-sobjects
"DELETE FROM storage_object
WHERE id = ANY(?::uuid[])")
(defn- delete-sobjects
[conn ids]
(let [ids (db/create-array conn "uuid" ids)]
(-> (db/exec-one! conn [sql:delete-sobjects ids])
(db/get-update-count))))
(defn- delete-by-backend
"Deletes the locked objects of one backend group: the database rows and
their backend content. Runs inside the caller's transaction. Returns the
number of deleted rows; reporting it (metrics) is the caller's job, once
the transaction has committed."
[{:keys [::db/conn ::sto/storage]} backend-id ids]
(let [ids-array (db/create-array conn "uuid" ids)
total (-> (db/exec-one! conn [sql:delete-sobjects ids-array])
(db/get-update-count))]
(-> (impl/resolve-backend storage backend-id)
(impl/del-objects-in-bulk ids))
(def ^:private sql:increment-attempts-and-defer
"UPDATE storage_object
SET deletion_attempts = deletion_attempts + 1,
deleted_at = NOW() + INTERVAL '1 day'
WHERE id = ANY(?::uuid[])")
(defn- increment-attempts-and-defer
[conn ids]
(let [ids (db/create-array conn "uuid" ids)]
(db/exec-one! conn [sql:increment-attempts-and-defer ids])))
(def ^:private sql:delete-give-up
"DELETE FROM storage_object
WHERE id = ANY(?::uuid[])
AND deletion_attempts >= ?")
(defn- delete-give-up
[conn ids]
(let [ids (db/create-array conn "uuid" ids)]
(db/exec-one! conn [sql:delete-give-up ids max-attempts])))
(defn- process-chunk
"Attempt to delete a chunk of storage objects from a specific backend.
This function runs inside the chunk's own transaction (see
`delete-in-bulk`) — it does NOT open its own transaction. The rows are
locked via FOR UPDATE SKIP LOCKED before deleting.
Returns the number of successfully deleted objects, or 0 if no rows
could be locked."
[conn storage backend-id ids]
(if-let [locked-ids (lock-ids conn ids)]
(let [fail-ids (try
(-> (impl/resolve-backend storage backend-id)
(impl/del-objects-in-bulk locked-ids))
(catch Throwable cause
(l/err :hint "error on physical deletion, will retry"
:ids locked-ids
:cause cause)
locked-ids))
ok-ids (set/difference locked-ids fail-ids)]
(doseq [id ok-ids]
(l/dbg :hint "permanently delete storage object"
:id (str id)
:backend (name backend-id)))
(when (seq ok-ids)
;; NOTE: rows arrive here with no live references (the mark-time
;; scan in gc-touched owns that check, also for the upload-session
;; bucket). If a NO ACTION reference still exists, this DELETE
;; aborts the chunk loud instead of breaking anyone silently.
(delete-sobjects conn ok-ids))
(when (seq fail-ids)
;; NOTE: deferred rows keep both their row and their references
;; (upload-session mappings included) until the final give-up, so
;; a backend outage does not break live sessions.
(increment-attempts-and-defer conn fail-ids)
(let [given-up (delete-give-up conn fail-ids)]
(when (pos? (db/get-update-count given-up))
(l/wrn :hint "giving up on orphan blob after max attempts"
:ids fail-ids
:max-attempts max-attempts))))
(count ok-ids))
0))
(defn- delete-in-bulk
[cfg backend-id ids]
;; Each chunk runs in its own transaction, on its own connection: a chunk
;; that fails (for example, an object that a foreign key still references) is
;; logged and skipped, and it cannot poison the cursor that feeds the rest.
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::sto/storage]}]
(process-chunk conn storage backend-id ids)))
(catch Throwable cause
(l/err :hint "unexpected error on bulk deletion, skipping chunk"
:ids ids
:cause cause)
0)))
(doseq [id ids]
(l/dbg :hint "permanently delete storage object"
:id (str id)
:backend (name backend-id)))
total))
(defn- group-by-backend
[items]
(d/group-by (comp keyword :backend) :id #{} items))
[rows]
(d/group-by (comp keyword :backend) :id #{} rows))
(defn- process-chunk-deletion
"Deletes the locked rows of one chunk, grouped by backend. Runs inside the
caller's transaction: any failure here aborts it, so the whole chunk is
rolled back (nothing is deleted and the locks are released) and skipped by
the caller. Returns a map of backend id to deleted row count."
[tx rows]
(->> (group-by-backend rows)
(map (fn [[backend-id ids]]
[backend-id (delete-by-backend tx backend-id ids)]))
(into {})))
(def ^:private sql:get-deleted-sobjects
"SELECT id, backend
FROM storage_object
WHERE deleted_at IS NOT NULL
AND deleted_at <= ?
AND status = 'valid'
ORDER BY deleted_at ASC")
"SELECT s.id, s.backend, s.deleted_at
FROM storage_object AS s
WHERE s.deleted_at IS NOT NULL
AND s.deleted_at <= ?
AND s.status = 'valid'
AND (s.deleted_at, s.id) > (?, ?)
ORDER BY s.deleted_at ASC, s.id ASC
LIMIT ?
FOR UPDATE SKIP LOCKED")
(defn- pending-row
"Takes the columns the GC needs from a `db/plan` row.
(def ^:private sql:get-first-deleted-sobjects
"SELECT s.id, s.backend, s.deleted_at
FROM storage_object AS s
WHERE s.deleted_at IS NOT NULL
AND s.deleted_at <= ?
AND s.status = 'valid'
ORDER BY s.deleted_at ASC, s.id ASC
LIMIT ?
FOR UPDATE SKIP LOCKED")
A plan row is a view over the open result set, valid only while the reduction
is running, so it cannot be stored for later: this has to happen inside the
reducing function."
[row]
{:id (:id row)
:backend (:backend row)})
(def ^:private chunk-size
"Pending objects read, locked and deleted in each transaction."
25)
(def ^:private throttle-every
"Deleted objects between throttle pauses."
5000)
(def ^:private throttle-ms
"Pause applied every `throttle-every` deleted objects, letting the
database (and its replicas) breathe on huge backlogs."
5000)
(defn- throttle
"Sleeps `throttle-ms` when the deleted count crosses a `throttle-every`
boundary. Runs between chunk transactions, never holding one open."
[prev-total new-total]
(when (> (quot new-total throttle-every)
(quot prev-total throttle-every))
(l/inf :hint "throttling storage gc"
:deleted new-total
:pause-ms throttle-ms)
(Thread/sleep (long throttle-ms))))
(defn- fetch-and-lock-chunk
"Reads and locks one chunk of pending objects in `(deleted_at, id)` order.
Objects already locked by another process are skipped, so two concurrent
runs never take the same chunk. Runs inside the caller's transaction."
[conn last-deleted-at last-id]
(let [[sql params] (if (some? last-deleted-at)
[sql:get-deleted-sobjects
[(ct/now) last-deleted-at last-id chunk-size]]
[sql:get-first-deleted-sobjects
[(ct/now) chunk-size]])]
(db/exec! conn (into [sql] params))))
(defn- clean-deleted
"Walks the pending objects with `db/plan`, a server-side cursor that streams
the rows instead of materialising them, and deletes them chunk by chunk.
"Processes the pending objects chunk by chunk with keyset pagination: each
chunk is one short transaction that reads and locks the next `chunk-size`
objects after the `(deleted_at, id)` cursor and deletes them (database rows
and backend content). Only `valid` objects are read: pending ones (still
being written, see the status lifecycle) stay untouched even when already
marked as deleted.
The rows are read in their own read-only transaction and every chunk of
`chunk-size` objects is deleted in its own one (see `delete-in-bulk`), so a
chunk that fails is logged and skipped instead of aborting the whole run, and
the work of the previous chunks is already committed. A physical-deletion
failure inside a chunk defers its rows one day and gives up after
`max-attempts` attempts (see `process-chunk`)."
[cfg]
(let [xform (comp (map pending-row)
(partition-all chunk-size)
(mapcat group-by-backend))
rf (fn
([total] total)
([total [backend-id ids]]
(+ total (or (delete-in-bulk cfg backend-id ids) 0))))]
(db/tx-run! (assoc cfg ::db/read-only true)
(fn [{:keys [::db/conn]}]
(transduce xform rf 0
(db/plan conn [sql:get-deleted-sobjects (ct/now)]))))))
A chunk that fails aborts its transaction: nothing of the chunk is deleted,
its locks are released, and it is logged and skipped. The cursor advances
to the `(deleted_at, id)` of the last row of each read chunk regardless of
the deletion result, so a failed chunk is not visited again in the same
run. There is no long-lived read transaction: each transaction lives only
as long as one chunk, letting the vacuum proceed between chunks. Rows
locked by a concurrent run are skipped and deferred to the next run; a
chunk that fails after a partial backend delete self-heals on the next
run (physical deletes are idempotent). Every `throttle-every` deleted
objects the run pauses `throttle-ms` (see `throttle`)."
[{:keys [::mtx/metrics] :as cfg}]
(loop [total 0
last-deleted-at nil
last-id nil]
(let [[rows counts]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as tx}]
(let [rows (fetch-and-lock-chunk conn last-deleted-at last-id)]
(try
[rows (process-chunk-deletion tx rows)]
(catch Throwable cause
;; Explicit rollback, then return normally (do
;; not rethrow): the caller needs `rows` to
;; advance the keyset cursor past the failed
;; chunk. The commit that `tx-run!` performs
;; afterwards is a JDBC no-op on the already
;; rolled-back connection.
(db/rollback! conn)
(l/err :hint "unexpected error on chunk deletion"
:ids (map :id rows)
:cause cause)
[rows {}])))))]
;; Reported only after the chunk commits: a rolled-back chunk leaves
;; an empty count map, so retried rows are never counted twice.
(doseq [[backend-id n] counts]
(mtx/run! metrics
:id :storage-gc-deleted-objects
:inc n
:labels [(name backend-id)]))
(if-let [cursor (peek rows)]
(let [new-total (+ total (reduce + 0 (vals counts)))]
(throttle total new-total)
(recur new-total
(:deleted-at cursor)
(:id cursor)))
total))))
(defmethod ig/assert-key ::handler
[_ params]
(assert (sto/valid-storage? (::sto/storage params)) "expect valid storage")
(assert (db/pool? (::db/pool params)) "expect valid db pool"))
(assert (db/pool? (::db/pool params)) "expect valid storage")
(assert (mtx/metrics? (::mtx/metrics params)) "expect valid metrics instance"))
(defmethod ig/init-key ::handler
[_ cfg]

8
backend/src/app/tasks/delete_object.clj
View File

@ -85,10 +85,14 @@
:file-id id
:cause cause))))
;; Mark file change to be deleted
;; Mark file change to be deleted, but only the rows that do not carry a
;; date yet. A revision is born already scheduled for deletion one hour
;; later, and rewriting its date here would push it out to the trash
;; lifetime; the collector would still take it, just much later than it
;; should.
(db/update! conn :file-change
{:deleted-at deleted-at}
{:file-id id}
{:file-id id :deleted-at nil}
{::db/return-keys false})
;; Mark file data fragment to be deleted

40
backend/test/backend_tests/binfile_test.clj
View File

@ -2645,24 +2645,28 @@
(t/is (= :validation (:type out)))
(t/is (= :max-file-size-reached (:code out))))))
(t/deftest import-configures-finite-transaction-idle-timeout
;; The binfile import transaction must set a finite ceiling for
;; idle_in_transaction_session_timeout (20 min) instead of disabling
;; it entirely: a stalled import must not retain a pool connection
;; without any upper bound. The ceiling must be scoped with SET
;; LOCAL: once the transaction ends, the pool session default must
;; be restored for subsequent transactions.
(let [pg-setting-sql ["SELECT setting FROM pg_settings WHERE name = 'idle_in_transaction_session_timeout'"]
in-tx (db/tx-run! th/*system*
(fn [cfg]
(bfc/configure-database-timeouts! cfg)
(:setting (db/exec-one! cfg pg-setting-sql))))
;; SET LOCAL must not leak past the transaction boundary
after (db/tx-run! th/*system*
(fn [cfg]
(:setting (db/exec-one! cfg pg-setting-sql))))]
(t/is (= "1200000" in-tx))
(t/is (= "300000" after))))
(def ^:private sql:current-idle-timeout
"SELECT current_setting('idle_in_transaction_session_timeout')::interval
= interval '30 minutes' AS ok")
(t/deftest binfile-transactions-use-a-finite-idle-timeout
;; The binfile import and export transactions must set a finite
;; ceiling for idle_in_transaction_session_timeout (30 min) instead
;; of disabling it entirely: a stalled transaction must not retain a
;; pool connection without any upper bound. The ceiling is scoped
;; with SET LOCAL: once the transaction ends, the pool session
;; default is restored for subsequent transactions.
(db/tx-run! th/*system*
(fn [{::db/keys [conn] :as cfg}]
(t/testing "export transaction"
(bfc/set-transaction-idle-timeout cfg)
(t/is (true? (-> (db/exec-one! conn [sql:current-idle-timeout])
:ok))))
(t/testing "import transaction"
(bfc/configure-import-transaction cfg)
(t/is (true? (-> (db/exec-one! conn [sql:current-idle-timeout])
:ok)))))))
(def ^:private index-test-file-id "22222222-2222-2222-2222-222222222222")
(def ^:private index-test-page-id "44444444-4444-4444-4444-444444444444")

1
backend/test/backend_tests/climit_test.clj
View File

@ -663,7 +663,6 @@
(fn []
(#'climit/republish-waiting (th/metrics-stub) counters)
(t/is (= [3] (waiting-value-of name)))))))
(t/deftest halting-the-component-stops-the-republisher
;; The republisher is a daemon thread started with the component: halting it
;; has to stop the thread, or every restart leaves another one running.

209
backend/test/backend_tests/file_change_retention_test.clj Normal file
View File

@ -0,0 +1,209 @@
;; 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 backend-tests.file-change-retention-test
"Retention of `file_change` rows through the file lifecycle.
A file has two kinds of row. Durable history: the snapshots, which a restore
brings back. And ephemeral revisions: the xlog of an edit, born already
scheduled for deletion one hour later, which nobody needs once the sessions
that were going to read them are gone.
The invariant under test is that a deletion date is assigned once and never
moved: restoring a file must not unmark a revision, and deleting a file must
not push a revision's date out to the trash lifetime. When either happens the
revision becomes invisible to `objects-gc`, which only looks at rows that
carry a date, and it stays in the table for ever."
(:require
[app.common.time :as ct]
[app.common.uuid :as uuid]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as files]
[app.util.blob :as blob]
[backend-tests.helpers :as th]
[clojure.test :as t]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(def ^:private test-now
"The instant every test pins the clock to. Whole seconds on purpose: a value
with a sub-second part does not survive the round trip through the database,
and the test could not compare it for equality."
(ct/inst "2026-10-01T00:00:00Z"))
(def ^:private revision-lifetime
"The lifetime the `update-file` flow gives a revision when it inserts it."
(ct/duration {:hours 1}))
(defn- create-file
[i]
(let [profile (th/create-profile* i {:is-active true})]
[profile (th/create-file* i {:profile-id (:id profile)
:project-id (:default-project-id profile)})]))
(defn- insert-change
"Inserts a `file_change` row directly, so the test builds the exact shape it
needs. The row class is decided by what the caller passes: a revision carries
only `changes`, a snapshot carries `label`, and a legacy payload row carries
`data` without a label. Returns the new row id."
[file-id {:keys [label data changes created-at deleted-at created-by]}]
(let [created-at (or created-at (ct/now))
id (uuid/next)]
(th/db-insert! :file-change
{:id id
:file-id file-id
:created-at created-at
:updated-at created-at
:deleted-at deleted-at
:revn 1
:version 0
:created-by (or created-by "system")
:label label
:data data
:changes changes}
{::db/return-keys false})
id))
(defn- insert-revision
"A revision exactly as the `update-file` flow writes it: no label, no data and
`changes` filled, already scheduled for deletion one hour after creation."
[file-id created-at]
(insert-change file-id {:created-at created-at
:changes (blob/encode {:foo "bar"})
:deleted-at (ct/plus created-at revision-lifetime)}))
(defn- find-change
[id]
(th/db-get :file-change {:id id} {::db/remove-deleted false}))
(defn- find-file
[id]
(th/db-get :file {:id id} {::db/remove-deleted false}))
(defn- restore-file
[file-id]
(db/tx-run! th/*system*
(fn [{:keys [::db/conn]}]
(#'files/restore-files conn [file-id]))))
(t/deftest restoring-a-file-leaves-the-revision-schedule-alone
(binding [ct/*clock* (ct/fixed-clock test-now)]
(let [[_ file] (create-file 1)
file-id (:id file)
trash-at (ct/in-future {:days 7})
old-at (ct/in-past {:hours 2})
revision-id (insert-revision file-id old-at)
revision-at (:deleted-at (find-change revision-id))
snapshot-id (insert-change file-id {:created-at old-at
:created-by "user"
:label "a snapshot"
:deleted-at trash-at})
legacy-id (insert-change file-id {:created-at old-at
:data (blob/encode {:legacy true})
:deleted-at trash-at})]
(restore-file file-id)
(t/testing "the revision keeps the schedule it was born with"
(t/is (= revision-at (:deleted-at (find-change revision-id)))))
(t/testing "the snapshot comes back"
(t/is (nil? (:deleted-at (find-change snapshot-id)))))
(t/testing "the legacy payload row comes back"
(t/is (nil? (:deleted-at (find-change legacy-id))))))))
(t/deftest deleting-a-file-does-not-push-the-revision-schedule-out
(binding [ct/*clock* (ct/fixed-clock test-now)]
(let [[_ file] (create-file 1)
file-id (:id file)
trash-at (ct/in-future {:days 7})
old-at (ct/in-past {:hours 2})
system-at (ct/in-future {:days 2})
revision-id (insert-revision file-id old-at)
revision-at (:deleted-at (find-change revision-id))
snapshot-id (insert-change file-id {:created-at old-at
:created-by "user"
:label "a snapshot"})
system-id (insert-change file-id {:created-at old-at
:label "internal/snapshot/1"
:deleted-at system-at})]
(th/run-task! :delete-object {:object :file
:deleted-at trash-at
:id file-id})
(t/testing "the revision keeps the schedule it was born with"
(t/is (= revision-at (:deleted-at (find-change revision-id)))))
(t/testing "the snapshot takes the file's deletion date"
(t/is (= (:deleted-at (find-file file-id))
(:deleted-at (find-change snapshot-id)))))
(t/testing "the system snapshot keeps the date it already had"
(t/is (= system-at (:deleted-at (find-change system-id))))))))
(t/deftest updating-a-snapshot-cannot-reach-a-revision
;; The snapshot paths clear the deletion mark of the row they touch, which is
;; only legitimate for durable history. They reach a row through
;; `sql:snapshots`, which filters `label IS NOT NULL`, and a revision never
;; carries one. This test pins that: the row has to keep the date it was born
;; with, and the RPC has to reject the id. If a future change loosens that
;; read filter, this goes red instead of the revision losing its date in
;; silence.
(binding [ct/*clock* (ct/fixed-clock test-now)]
(let [[profile file] (create-file 1)
file-id (:id file)
revision-id (insert-revision file-id (ct/in-past {:hours 2}))
revision-at (:deleted-at (find-change revision-id))
out (th/command! {::th/type :update-file-snapshot
::rpc/profile-id (:id profile)
:id revision-id
:label "renamed"})]
(t/testing "the RPC rejects the id"
(t/is (th/ex-info? (:error out)))
(t/is (= :not-found (:type (ex-data (:error out))))))
(t/testing "and the revision keeps the date it was born with"
(t/is (= revision-at (:deleted-at (find-change revision-id))))))))
(t/deftest a-deleted-then-restored-file-does-not-leak-its-revisions
;; The lifecycle that leaked 358,517 rows in production: a file is edited, it
;; ends up in the trash, it comes back, and the revisions that were scheduled
;; to die an hour after they were written have to die anyway.
(binding [ct/*clock* (ct/fixed-clock test-now)]
(let [[_ file] (create-file 1)
file-id (:id file)
revision-id (insert-revision file-id (ct/in-past {:hours 2}))
revision-at (:deleted-at (find-change revision-id))]
(th/run-task! :delete-object {:object :file
:deleted-at (ct/in-future {:days 7})
:id file-id})
(t/testing "deleting the file leaves the revision schedule alone"
(t/is (= revision-at (:deleted-at (find-change revision-id)))))
(restore-file file-id)
(t/testing "restoring the file leaves it alone too"
(t/is (= revision-at (:deleted-at (find-change revision-id)))))
(th/run-task! :objects-gc {})
(t/testing "so the collector takes it"
(t/is (nil? (find-change revision-id)))))))

128
backend/test/backend_tests/files_update_validation_timing_test.clj Normal file
View File

@ -0,0 +1,128 @@
;; 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 backend-tests.files-update-validation-timing-test
(:require
[app.binfile.common :as bfc]
[app.common.files.validate :as val]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.main :as main]
[app.metrics :as mtx]
[app.metrics.definition :as-alias mdef]
[app.rpc.commands.files-update :as files-update]
[clojure.test :as t]
[integrant.core :as ig])
(:import
io.prometheus.client.CollectorRegistry))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helpers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- bucket-value
[metrics mname label-names label-values le]
(.getSampleValue ^CollectorRegistry (mtx/get-registry metrics)
(str mname "_bucket")
(into-array String (conj (vec label-names) "le"))
(into-array String (conj (vec label-values) le))))
(defn- test-file
[]
{:id (uuid/next)
:revn 0
:version 0
:data {}})
(defn- test-cfg
[metrics]
{::mtx/metrics metrics
::files-update/validation-timings (atom {})})
(def ^:private all-flags
#{:file-validation
:file-schema-validation
:soft-file-validation
:soft-file-schema-validation})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tests
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest validation-timing-metric-uses-request-buckets
(t/is (= mtx/default-request-histogram-buckets
(get-in main/default-metrics [:update-file-validation-timing ::mdef/buckets])))
(t/is (= "penpot_rpc_update_file_validation_timing"
(get-in main/default-metrics [:update-file-validation-timing ::mdef/name]))))
(t/deftest process-changes-and-validate-records-all-steps
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
cfg (test-cfg metrics)]
(binding [cf/flags all-flags]
(with-redefs [bfc/get-resolved-file-libraries (fn [_ _] {})
val/validate-file-affected! (fn [_ _ _] nil)
val/validate-file-schema! (fn [_] nil)]
(let [file (@#'files-update/process-changes-and-validate cfg (test-file) [] nil)
timings @(::files-update/validation-timings cfg)]
(t/is (map? file))
(t/is (number? (:resolve-libs-ms timings)))
(t/is (number? (:process-changes-ms timings)))
(t/is (number? (:soft-validate-affected-ms timings)))
(t/is (number? (:soft-validate-schema-ms timings)))
(t/is (number? (:validate-affected-ms timings)))
(t/is (number? (:validate-schema-ms timings)))
(doseq [step ["resolve-libs" "process-changes"
"soft-validate-affected" "soft-validate-schema"
"validate-affected" "validate-schema"]]
(t/is (= 1.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing"
["step"] [step] "60000.0"))
(str "expected one sample for step " step))))))))
(t/deftest process-changes-and-validate-skips-when-skip-validate
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
cfg (test-cfg metrics)]
(binding [cf/flags all-flags]
(with-redefs [bfc/get-resolved-file-libraries (fn [_ _]
(throw (ex-info "must not resolve libs" {})))
val/validate-file-affected! (fn [_ _ _]
(throw (ex-info "must not validate" {})))
val/validate-file-schema! (fn [_]
(throw (ex-info "must not validate schema" {})))]
;; soft validations still run: they only check flags, not skip-validate
(let [file (@#'files-update/process-changes-and-validate cfg (test-file) [] true)
timings @(::files-update/validation-timings cfg)]
(t/is (map? file))
(t/is (nil? (:resolve-libs-ms timings)))
(t/is (number? (:process-changes-ms timings)))
(t/is (number? (:soft-validate-affected-ms timings)))
(t/is (number? (:soft-validate-schema-ms timings)))
(t/is (nil? (:validate-affected-ms timings)))
(t/is (nil? (:validate-schema-ms timings)))
(t/is (= 1.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing"
["step"] ["process-changes"] "60000.0"))))))))
(t/deftest process-changes-and-validate-records-timing-on-error
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
cfg (test-cfg metrics)]
(binding [cf/flags all-flags]
(with-redefs [bfc/get-resolved-file-libraries (fn [_ _] {})
val/validate-file-affected! (fn [_ _ _]
(throw (ex-info "bad file" {:code :referential-integrity})))
val/validate-file-schema! (fn [_] nil)]
(let [timings-atom (::files-update/validation-timings cfg)]
(t/is (thrown? clojure.lang.ExceptionInfo
(@#'files-update/process-changes-and-validate cfg (test-file) [] nil)))
;; the failing step still recorded its timing via finally
(t/is (number? (:validate-affected-ms @timings-atom)))
(t/is (number? (:resolve-libs-ms @timings-atom)))
(t/is (number? (:process-changes-ms @timings-atom))))))))
(t/deftest record-validation-timing-tolerates-missing-collaborators
;; production code must not blow up when called without metrics
;; (e.g. scripts) or without the timings collector.
(let [record @#'files-update/record-validation-timing]
(t/is (nil? (record {} :resolve-libs-ms "resolve-libs" 12)))
(t/is (nil? (record {::mtx/metrics nil} :resolve-libs-ms "resolve-libs" 12)))))

70
backend/test/backend_tests/metrics_test.clj
View File

@ -6,6 +6,7 @@
(ns backend-tests.metrics-test
(:require
[app.main :as main]
[app.metrics :as mtx]
[app.metrics.definition :as-alias mdef]
[clojure.test :as t]
@ -145,3 +146,72 @@
(finally
(px/shutdown-now sampler)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HISTOGRAM BUCKETS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(t/deftest histogram-bucket-tails-extend-past-7-5s
;; The sub-7.5s prefix stays identical, so p50/p90 resolution and the
;; history remain comparable; only the tail grows, per latency profile.
(t/is (= mtx/default-histogram-buckets
(subvec mtx/default-request-histogram-buckets 0 14)))
(t/is (= mtx/default-histogram-buckets
(subvec mtx/default-tasks-histogram-buckets 0 14)))
(t/is (= mtx/default-histogram-buckets
(subvec mtx/default-redis-histogram-buckets 0 14)))
(t/is (= [10000 15000 30000 60000]
(subvec mtx/default-request-histogram-buckets 14)))
(t/is (= [10000 15000 30000 60000 120000 300000]
(subvec mtx/default-tasks-histogram-buckets 14)))
(t/is (= [10000]
(subvec mtx/default-redis-histogram-buckets 14))))
(t/deftest default-metrics-wire-bucket-tails-per-profile
;; Requests and waits cover the 30s/60s CLIMIT timeouts, tasks run
;; until done (300s postgres statement timeout), Redis only needs the
;; pathological case covered.
(doseq [id [:rpc-main-timing :rpc-management-timing :rpc-climit-timing
:audit-http-handler-timing :http-server-dispatch-timing
:update-file-validation-timing]]
(t/is (= mtx/default-request-histogram-buckets
(get-in main/default-metrics [id ::mdef/buckets]))
(str "request buckets on " id)))
(t/is (= mtx/default-tasks-histogram-buckets
(get-in main/default-metrics [:tasks-timing ::mdef/buckets])))
(t/is (= mtx/default-redis-histogram-buckets
(get-in main/default-metrics [:redis-eval-timing ::mdef/buckets]))))
(defn- bucket-value
"Cumulative count of the `le` bucket of a histogram, read from the
registry. Nil when that boundary does not exist."
[metrics mname label-names label-values le]
(.getSampleValue ^CollectorRegistry (mtx/get-registry metrics)
(str mname "_bucket")
(into-array String (conj (vec label-names) "le"))
(into-array String (conj (vec label-values) le))))
(t/deftest histogram-tails-are-registered
;; A 9s observation must land in the new tail instead of piling up in
;; +Inf: every histogram used to stop at 7500.
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})]
(mtx/run! metrics :id :rpc-main-timing :val 9000 :labels (into-array String ["update-file"]))
(t/is (= 0.0 (bucket-value metrics "penpot_rpc_main_timing" ["name"] ["update-file"] "7500.0")))
(t/is (= 1.0 (bucket-value metrics "penpot_rpc_main_timing" ["name"] ["update-file"] "10000.0")))
(t/is (nil? (bucket-value metrics "penpot_rpc_main_timing" ["name"] ["update-file"] "120000.0")))
(mtx/run! metrics :id :tasks-timing :val 200000 :labels (into-array String ["file-gc"]))
(t/is (= 0.0 (bucket-value metrics "penpot_tasks_timing" ["name"] ["file-gc"] "60000.0")))
(t/is (= 1.0 (bucket-value metrics "penpot_tasks_timing" ["name"] ["file-gc"] "300000.0")))
(mtx/run! metrics :id :redis-eval-timing :val 9000 :labels (into-array String ["claim"]))
(t/is (= 1.0 (bucket-value metrics "penpot_redis_eval_timing" ["name"] ["claim"] "10000.0")))
(t/is (nil? (bucket-value metrics "penpot_redis_eval_timing" ["name"] ["claim"] "15000.0")))
(mtx/run! metrics :id :http-server-dispatch-timing :val 45000)
(t/is (= 1.0 (bucket-value metrics "penpot_http_server_dispatch_timing" [] [] "60000.0")))
(mtx/run! metrics :id :update-file-validation-timing :val 9000 :labels (into-array String ["validate-affected"]))
(t/is (= 0.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing" ["step"] ["validate-affected"] "7500.0")))
(t/is (= 1.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing" ["step"] ["validate-affected"] "10000.0")))))

105
backend/test/backend_tests/rpc_quotes_test.clj
View File

@ -442,6 +442,7 @@
(t/is (true? true) "deduped storage counted once, under quota"))))
(t/deftest media-upload-enforces-storage-quote
;; TEMPORARILY DISABLED (2026-10-19), see body.
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-media-storage-bytes-per-team 100})}]
@ -466,9 +467,101 @@
out (th/multipart-command! params)]
;; 312043 bytes > 100 byte limit → should be rejected
(t/is (not (th/success? out)))
(let [error (:error out)]
(t/is (= :restriction (th/ex-type error)))
(t/is (= :max-quote-reached (th/ex-code error)))
(t/is (= "media-storage-bytes-per-team" (:target (ex-data error))))))))
;; TEMPORARILY DISABLED (2026-10-19): upload path no longer checks
;; media-storage-bytes-per-team, so even over quota the upload
;; succeeds. TODO: restore rejection with cheaper implementation.
(t/is (th/success? out)))))
;; --- SNAPSHOTS (VERSIONS) QUOTES
(defn- check-snapshot-ok
"Save a version of the file and check that it was created."
[profile file label]
(let [out (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id (:id file)
:label label})]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (= label (get-in out [:result :label])))
out))
(defn- check-snapshot-ko
"Try to save a version of the file and check that the quota refused it."
[profile file label target]
(let [out (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id (:id file)
:label label})
error (:error out)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(t/is (= :restriction (th/ex-type error)))
(t/is (= :max-quote-reached (th/ex-code error)))
(t/is (= target (:target (ex-data error))))
out))
(t/deftest snapshots-per-file-quote
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-snapshots-per-file 2
:quotes-snapshots-per-team 1000})}]
(let [profile (th/create-profile* 1)
project (th/create-project* 1 {:profile-id (:id profile)
:team-id (:default-team-id profile)})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)
:is-shared false})]
(check-snapshot-ok profile file "version1")
(check-snapshot-ok profile file "version2")
(check-snapshot-ko profile file "version3" "snapshots-per-file"))))
(t/deftest snapshots-per-team-quote
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-snapshots-per-file 1000
:quotes-snapshots-per-team 3})}]
(let [profile (th/create-profile* 1)
project (th/create-project* 1 {:profile-id (:id profile)
:team-id (:default-team-id profile)})
file-1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)
:is-shared false})
file-2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id project)
:is-shared false})]
;; the quota adds up the versions of every file of the team
(check-snapshot-ok profile file-1 "version1")
(check-snapshot-ok profile file-2 "version2")
(check-snapshot-ok profile file-1 "version3")
(check-snapshot-ko profile file-2 "version4" "snapshots-per-team"))))
(t/deftest snapshots-quote-freed-on-delete
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-snapshots-per-file 2
:quotes-snapshots-per-team 1000})}]
(let [profile (th/create-profile* 1)
project (th/create-project* 1 {:profile-id (:id profile)
:team-id (:default-team-id profile)})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)
:is-shared false})
snapshot (:result (check-snapshot-ok profile file "version1"))]
(check-snapshot-ok profile file "version2")
(check-snapshot-ko profile file "version3" "snapshots-per-file")
;; deleting a version takes it out of the count right away
(let [out (th/command! {::th/type :delete-file-snapshot
::rpc/profile-id (:id profile)
:id (:id snapshot)})]
(t/is (nil? (:error out)))
(t/is (true? (:result out)))
(check-snapshot-ok profile file "version4")))))

82
backend/test/backend_tests/scripts_decode_file_data_test.clj Normal file
View File

@ -0,0 +1,82 @@
;; 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
(ns backend-tests.scripts-decode-file-data-test
(:require
[app.common.json :as json]
[app.common.uuid :as uuid]
[app.scripts.decode-file-data :as dfd]
[app.util.blob :as blob]
[clojure.java.io :as io]
[clojure.test :as t])
(:import
java.util.Base64))
(defn- sample-file-data
[]
(let [p1 (uuid/next)
p2 (uuid/next)]
{:pages [p1 p2]
:pages-index
{p1 {:id p1 :name "Accueil1" :objects {:a 1 :b 2}}
p2 {:id p2 :name "Contact" :objects {:c 3}}}
:components {(uuid/next) {:name "comp"}}
:colors {(uuid/next) {:name "red"}}
:typographies {}}))
(t/deftest sanitize-converts-special-types
(let [id (uuid/next)
out (dfd/sanitize {:id id
:kw :pages-index
:when (java.util.Date. 0)
:tags #{:a :b}
:raw (.getBytes "hi" "UTF-8")})]
(t/is (= (str id) (get out "id")))
(t/is (= "pages-index" (get out "kw")))
(t/is (string? (get out "when")))
(t/is (= ["a" "b"] (sort (get out "tags"))))
(t/is (= {"$bytes" (.encodeToString (Base64/getEncoder) (.getBytes "hi" "UTF-8"))}
(get out "raw")))))
(t/deftest sanitize-keeps-integers-as-integers
(t/is (= 2 (dfd/sanitize 2)))
(t/is (= 2.5 (dfd/sanitize 2.5))))
(t/deftest blob-roundtrip-all-versions-to-json
(doseq [version [1 3 4 5]]
(let [data (sample-file-data)
encoded (blob/encode data {:version version})
payload (dfd/blob->json encoded)
parsed (json/decode payload)]
(t/is (map? parsed) (str "version " version " produces a JSON map"))
(t/is (= 2 (count (get parsed "pages"))) (str "version " version " keeps pages")))))
(t/deftest summary-lists-pages-in-order-with-object-counts
(let [data (sample-file-data)
summary (dfd/summarize-data data)
pages (:pages summary)]
(t/is (= 2 (count pages)))
(t/is (= ["Accueil1" "Contact"] (mapv :name pages)))
(t/is (= [2 1] (mapv :objects pages)))
(t/is (= {:pages 2 :components 1 :colors 1 :typographies 0}
(:stats summary)))
(let [pages-json (json/decode (dfd/file-data-pages-json data))]
(t/is (= ["Accueil1" "Contact"] (mapv #(get % "name") pages-json))))))
(t/deftest cli-decodes-blob-file-to-json
(let [data (sample-file-data)
tmp-in (java.io.File/createTempFile "blob" ".bin")
tmp-out (java.io.File/createTempFile "out" ".json")
_ (.deleteOnExit tmp-in)
_ (.deleteOnExit tmp-out)
_ (with-open [os (io/output-stream tmp-in)]
(.write os ^bytes (blob/encode data {:version 5})))
_ (dfd/-main "--input" (.getAbsolutePath tmp-in)
"--output" (.getAbsolutePath tmp-out)
"--format" "summary")
parsed (json/decode (slurp tmp-out))]
(t/is (== 2 (get-in parsed ["stats" "pages"])))
(t/is (= ["Accueil1" "Contact"] (mapv #(get % "name") (get parsed "pages"))))))

64
backend/test/backend_tests/storage_gc_deleted_test.clj
View File

@ -10,6 +10,7 @@
[app.common.uuid :as uuid]
[app.db :as db]
[app.storage :as sto]
[app.storage.impl :as impl]
[backend-tests.helpers :as th]
[clojure.test :as t]))
@ -91,3 +92,66 @@
(t/testing "the object of the next chunk is gone"
(t/is (nil? (find-object last-id))))))
(t/deftest failed-batch-is-not-visited-again-in-the-same-run
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)})
;; A full first batch of deletable objects.
batch1 (mapv (fn [_] (put-object! (ct/in-past "30m"))) (range chunk-size))
;; The blocked object leads a second full batch, in `deleted_at` order
;; after the first one: the whole batch fails and must be skipped, and
;; the cursor must not come back to any of its objects.
blocked (blocked-object! (:id file))
fillers (mapv (fn [_] (put-object! (ct/in-past "20m"))) (range (dec chunk-size)))
;; Objects after the failed batch: the next read batch starts right
;; after the `(deleted_at, id)` of the last row of the failed one.
batch3 (mapv (fn [_] (put-object! (ct/in-past "5m"))) (range 5))
result (th/run-task! :storage-gc-deleted {})]
(t/testing "the first and the last batches are fully deleted"
(t/is (= (+ (count batch1) (count batch3)) (:deleted result))))
(t/testing "the objects of the first batch are gone"
(t/is (every? #(nil? (find-object (:id %))) batch1)))
(t/testing "the objects of the failed batch are still pending"
(t/is (some? (find-object (:id blocked))))
(t/is (every? #(some? (find-object (:id %))) fillers)))
(t/testing "the objects after the failed batch are gone"
(t/is (every? #(nil? (find-object (:id %))) batch3)))))
(t/deftest physical-failure-rolls-back-the-chunk-and-continues
"Pins the chunk rollback semantics: the physical delete of the first
chunk fails (mocked) after its rows were already deleted inside the
transaction, so the transaction must roll back (the rows stay pending)
while the run skips the failed chunk and deletes the rest."
(let [;; A full first chunk of deletable objects, older in
;; `deleted_at` order than the rest, so the failing physical
;; delete hits exactly this chunk.
old (mapv (fn [_] (put-object! (ct/in-past "30m"))) (range chunk-size))
recent (mapv (fn [_] (put-object! (ct/in-past "5m"))) (range 5))
failing (atom true)
orig impl/del-objects-in-bulk
result (with-redefs [impl/del-objects-in-bulk
(fn [backend ids]
(if @failing
(do (reset! failing false)
(throw (ex-info "simulated backend failure" {})))
(orig backend ids)))]
(th/run-task! :storage-gc-deleted {}))]
(t/testing "the run finishes and only the objects after the failed chunk are deleted"
(t/is (= (count recent) (:deleted result))))
(t/testing "the objects of the failed chunk are still pending"
(t/is (every? #(some? (find-object (:id %))) old)))
(t/testing "the objects after the failed chunk are gone"
(t/is (every? #(nil? (find-object (:id %))) recent)))))

44
backend/test/backend_tests/storage_test.clj
View File

@ -924,25 +924,6 @@
(:id object)])]
(t/is (= 1 (:count row))))))
(t/deftest gc-deleted-gives-up-after-max-attempts
(let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend))
content (sto/content "content")
object (sto/put-object! storage {::sto/content content
:content-type "text/plain"})]
(th/db-update! :storage-object {:deleted-at (ct/in-past {:minutes 1})
:deletion_attempts 6}
{:id (:id object)})
(with-mocks [_mock {:target 'app.storage.impl/del-objects-in-bulk
:return (fn [_ ids] (set ids))}]
(let [res (th/run-task! :storage-gc-deleted {})]
(t/is (= 0 (:deleted res)))))
(let [row (th/db-exec-one! ["select count(*) from storage_object where id = ?" (:id object)])]
(t/is (= 0 (:count row))))))
(t/deftest dedup-reuses-existing-blob-with-touch
(let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend))
@ -1232,10 +1213,13 @@
(t/is (= 1 (:count (th/db-exec-one! ["select count(*) from upload_session_chunk where session_id = ?"
session-id]))))))
(t/deftest upload-session-deferred-keeps-mapping
;; A physical-deletion failure defers the row; the session mapping is
;; kept so the session survives the backend outage and the blob is
;; retried the next day.
(t/deftest upload-session-mapping-blocks-gc-deleted
;; A live upload-session chunk mapping references its object with a NO
;; ACTION foreign key: gc-deleted cannot purge that object while the
;; session is intact. The blocked chunk fails and is skipped, and both
;; the object row and the mapping stay in place, so the stalled session
;; stays retryable; objects-gc owns purging the mapping before the
;; object (see upload-session-consumed-purge below).
(let [prof (th/create-profile* 1)
_ (th/create-project* 1 {:profile-id (:id prof)
:team-id (:default-team-id prof)})
@ -1258,17 +1242,13 @@
object-id (:object-id (th/db-exec-one! ["select object_id from upload_session_chunk where session_id = ?"
session-id]))]
(t/is (nil? (:error out)))
(th/db-exec! ["update storage_object set deleted_at = ? where id = ?" (ct/now) object-id])
(th/db-exec! ["update storage_object set deleted_at = ? where id = ?" (ct/in-past {:minutes 5}) object-id])
(with-mocks [_mock {:target 'app.storage.impl/del-objects-in-bulk
:return (fn [_ ids] (set ids))}]
(let [res (th/run-task! :storage-gc-deleted {})]
(t/is (= 0 (:deleted res)))))
(th/run-task! :storage-gc-deleted {})
;; row kept and deferred one day
(let [row (th/db-exec-one! ["select deletion_attempts, touched_at from storage_object where id = ?" object-id])]
(t/is (= 1 (:deletion-attempts row)))
(t/is (some? (:touched-at row))))
;; the object row survives the run: the mapping blocks its deletion
(t/is (= 1 (:count (th/db-exec-one! ["select count(*) from storage_object where id = ?"
object-id]))))
;; mapping kept: the session is intact for the retry
(t/is (= 1 (:count (th/db-exec-one! ["select count(*) from upload_session_chunk where session_id = ?"
session-id]))))))

2
docs/technical-guide/configuration.md
View File

@ -697,7 +697,7 @@ flags, and by whether `PENPOT_PUBLIC_URI` is served over HTTPS. See
### Database
Penpot only supports PostgreSQL and we highly recommend >=13 version. If you are using official
Penpot only supports PostgreSQL and we highly recommend >=16 version. If you are using official
docker images this is already solved for you.
Essential database configuration:

198
frontend/src/app/main/data/exports/assets.cljs
View File

@ -12,11 +12,14 @@
[app.main.data.exports.wasm :as wasm.exports]
[app.main.data.helpers :as dsh]
[app.main.data.modal :as modal]
[app.main.data.notifications :as ntf]
[app.main.data.persistence :as dwp]
[app.main.errors :as errors]
[app.main.features :as features]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.dom :as dom]
[app.util.i18n :refer [tr]]
[app.util.websocket :as ws]
[beicon.v2.core :as rx]
[cuerdas.core :as str]
@ -24,6 +27,68 @@
(def default-timeout 5000)
;; Longest wait for the pending changes of the exported files to be saved.
(def save-wait-timeout-ms 10000)
(defn- export-file-ids
[exports]
(into #{} (keep :file-id) exports))
(defn- warn-unsaved-changes
"Warns that the export may miss the changes of `file-ids` not saved yet."
[file-ids]
(ptk/reify ::warn-unsaved-changes
ptk/WatchEvent
(watch [_ state _]
(when (dwp/unsaved-changes? state file-ids)
(rx/of (ntf/show {:content (tr "workspace.export.unsaved-changes")
:type :toast
:level :warning
:timeout 8000}))))))
(defn- export-failed
"Shows an export failure as a toast, keeping the workspace open: the
failure is never raised to the global error handler, which would
replace the workspace with an error page."
[cause]
(ptk/reify ::export-failed
ptk/EffectEvent
(effect [_ _ _]
(errors/flash :cause cause
:type (if (#{:server-error :internal} (:type (ex-data cause)))
:unhandled
:handled)
:hint (tr "errors.export-failed")))))
(defn- export-widget-failed
"Reports a failure that happened before the export ever started: the
widget settles instead of waiting for progress that will never arrive,
and the toast says what happened. Nothing is raised to the global
error handler, which would replace the workspace with an error page."
[exports cmd cause]
(ptk/reify ::export-widget-failed
ptk/UpdateEvent
(update [_ state]
(assoc state :export {:in-progress false
:widget-visible true
:detail-visible true
:healthy? true
:progress 0
:total (count exports)
:exports exports
:cmd cmd
:error (or (ex-message cause) true)
:error-code (:code (ex-data cause))
:last-update (ct/now)}))
ptk/EffectEvent
(effect [_ _ _]
(errors/flash :cause cause
:type (if (#{:server-error :internal} (:type (ex-data cause)))
:unhandled
:handled)
:hint (tr "errors.export-failed")))))
(defn normalize-export
[{:keys [object-id name] :as export}]
(assoc export :name (if (str/blank? name)
@ -200,29 +265,6 @@
(when (= status "ended")
(dom/trigger-download-uri filename mtype resource-uri)))))
;; The exporter is at capacity. Not a crash: the widget says so and the user
;; retries, instead of the generic error dialog.
(def ^:private saturation-codes #{:queue-full})
(defn- export-failed
"Reports a failure that happened before the export ever started, so the widget
settles instead of waiting for progress that will never arrive."
[exports cmd cause]
(ptk/reify ::export-failed
ptk/UpdateEvent
(update [_ state]
(assoc state :export {:in-progress false
:widget-visible true
:detail-visible true
:healthy? true
:progress 0
:total (count exports)
:exports exports
:cmd cmd
:error (or (ex-message cause) true)
:error-code (:code (ex-data cause))
:last-update (ct/now)}))))
(defn cancel-export
"Stops the running export. Only reachable on the job API path, where the
exporter can actually abort the work.
@ -295,16 +337,16 @@
:wait true
:is-wasm (wasm-export-enabled? state)})]
(rx/concat
(dwp/force-persist-and-wait 400)
(dwp/force-persist-files-and-wait (export-file-ids [export]) save-wait-timeout-ms)
(rx/of (warn-unsaved-changes (export-file-ids [export])))
(->> (rp/cmd! :export params)
(rx/map (fn [{:keys [filename mtype uri]}]
(dom/trigger-download-uri filename mtype uri)
(clear-export-state uuid/zero)))
(rx/catch (fn [cause]
(rx/concat
(rx/of (clear-export-state uuid/zero))
(rx/throw cause))))))))))))
(rx/of (clear-export-state uuid/zero)
(export-failed cause))))))))))))
(defn request-multiple-export
[{:keys [exports cmd name]
@ -315,6 +357,8 @@
ptk/WatchEvent
(watch [_ state _]
(let [resource-id (volatile! nil)
;; Emits when the export request fails.
failed-s (rx/subject)
profile-id (:profile-id state)
ws-conn (:ws-conn state)
params (cond->
@ -332,67 +376,67 @@
(rx/map :payload)
(rx/filter #(= :export-update (:type %)))
(rx/filter #(= @resource-id (:resource-id %)))
(rx/take-until failed-s)
(rx/share))
stopper
(rx/filter #(or (= "ended" (:status %))
(= "error" (:status %))
(= "cancelled" (:status %)))
progress-stream)]
progress-stream)
file-ids
(export-file-ids exports)]
(swap! st/ongoing-tasks conj :export)
(rx/merge
;; Force that all data is persisted; best effort.
(rx/of ::dwp/force-persist)
(rx/concat
(dwp/force-persist-files-and-wait file-ids save-wait-timeout-ms)
(rx/of (warn-unsaved-changes file-ids))
(rx/merge
;; Updates the export state with each progress message, until
;; shortly after the export ends or fails.
(->> progress-stream
(rx/map update-export-status)
(rx/take-until (rx/delay 500 stopper))
(rx/finalize (fn []
(swap! st/ongoing-tasks disj :export))))
;; Launch the exportation process and stores the resource id
;; locally. With wasm export active the job API is used instead: it
;; answers with the exporter's own object count and gives a handle
;; to cancel.
(->> (if (wasm-export-enabled? state)
(->> (rp/cmd! :create-export-job params)
(rx/map (fn [{job-id :id :keys [total] :as job}]
(vreset! resource-id (:resource-id job))
(initialize-export-status exports cmd
{:id (:resource-id job)}
{:job-id job-id
:total total
:status (:state job)
:backend (:backend job)}))))
(->> (rp/cmd! :export params)
(rx/map (fn [{:keys [id] :as resource}]
(vreset! resource-id id)
(initialize-export-status exports cmd resource nil)))))
(rx/catch (fn [cause]
;; Saturation is an answer, not a fault.
(if (contains? saturation-codes (:code (ex-data cause)))
(rx/of (export-failed exports cmd cause))
(rx/concat
(rx/of (export-failed exports cmd cause))
(rx/throw cause))))))
;; Clears the export state a while after the export ends or is
;; cancelled.
(->> progress-stream
(rx/filter #(or (= "ended" (:status %))
(= "cancelled" (:status %))))
(rx/take 1)
(rx/delay default-timeout)
(rx/map #(clear-export-state @resource-id))
(rx/take-until (rx/delay 6000 stopper)))
;; We proceed to update the export state with incoming
;; progress updates. We delay the stopper for give some time
;; to update the status with ended or errored status before
;; close the stream.
(->> progress-stream
(rx/map update-export-status)
(rx/take-until (rx/delay 500 stopper))
(rx/finalize (fn []
(swap! st/ongoing-tasks disj :export))))
;; We hide need to hide the ui elements of the export after
;; some interval. We also delay a little bit more the stopper
;; for ensure that after some security time, the stream is
;; completely closed.
(->> progress-stream
(rx/filter #(or (= "ended" (:status %))
(= "cancelled" (:status %))))
(rx/take 1)
(rx/delay default-timeout)
(rx/map #(clear-export-state @resource-id))
(rx/take-until (rx/delay 6000 stopper)))))))))
;; Launches the exportation process and stores the resource id
;; locally. With wasm export active the job API is used instead:
;; it answers with the exporter's own object count and gives a
;; handle to cancel. It goes last so a failure reaches the
;; progress listeners above: the push to `failed-s` releases the
;; leave-page warning even though no progress message will ever
;; arrive, and nothing is raised to the global error handler,
;; which would replace the workspace with an error page.
(->> (if (wasm-export-enabled? state)
(->> (rp/cmd! :create-export-job params)
(rx/map (fn [{job-id :id :keys [total] :as job}]
(vreset! resource-id (:resource-id job))
(initialize-export-status exports cmd
{:id (:resource-id job)}
{:job-id job-id
:total total
:status (:state job)
:backend (:backend job)}))))
(->> (rp/cmd! :export params)
(rx/map (fn [{:keys [id] :as resource}]
(vreset! resource-id id)
(initialize-export-status exports cmd resource nil)))))
(rx/catch (fn [cause]
(rx/push! failed-s cause)
(rx/of (export-widget-failed exports cmd cause))))))))))))
(defn request-export
[{:keys [exports] :as params}]

40
frontend/src/app/main/data/exports/files.cljs
View File

@ -11,6 +11,7 @@
[app.common.schema :as sm]
[app.main.data.event :as ev]
[app.main.data.modal :as modal]
[app.main.data.persistence :as dps]
[app.main.repo :as rp]
[app.util.sse :as sse]
[beicon.v2.core :as rx]
@ -36,9 +37,25 @@
(def check-export-files
(sm/check-fn schema:export-files))
;; Longest wait for the pending changes of the downloaded files to be saved.
(def save-wait-timeout-ms 10000)
(defn- show-export-dialog
"Opens the download dialog, flagging whether the files have changes not
saved yet."
[team-id files]
(ptk/reify ::show-export-dialog
ptk/WatchEvent
(watch [_ state _]
(rx/of (modal/show {:type ::export-files
:team-id team-id
:files files
:unsaved (dps/unsaved-changes? state (into #{} (map :id) files))})))))
(defn open-export-dialog
[files]
(let [files (check-export-files files)]
(let [files (check-export-files files)
file-ids (into #{} (map :id) files)]
(ptk/reify ::export-files
ptk/WatchEvent
(watch [_ state _]
@ -48,16 +65,17 @@
::ev/origin "dashboard"
:format "binfile-v3"
:num-files (count files)}))
(->> (rx/from files)
(rx/mapcat
(fn [file]
(->> (rp/cmd! :has-file-libraries {:file-id (:id file)})
(rx/map #(assoc file :has-libraries %)))))
(rx/reduce conj [])
(rx/map (fn [files]
(modal/show {:type ::export-files
:team-id team-id
:files files}))))))))))
;; The download is built from the server copy: send the pending
;; changes first.
(rx/concat
(dps/force-persist-files-and-wait file-ids save-wait-timeout-ms)
(->> (rx/from files)
(rx/mapcat
(fn [file]
(->> (rp/cmd! :has-file-libraries {:file-id (:id file)})
(rx/map #(assoc file :has-libraries %)))))
(rx/reduce conj [])
(rx/map (partial show-export-dialog team-id))))))))))
(defn export-files
"Start files exportation process"

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

@ -14,6 +14,7 @@
[app.common.uuid :as uuid]
[app.main.data.changes :as dch]
[app.main.data.common :as-alias dc]
[app.main.data.event :as ev]
[app.main.data.helpers :as dsh]
[app.main.data.notifications :as ntf]
[app.main.data.workspace :as-alias dw]
@ -108,6 +109,30 @@
([timeout-ms]
(rx/concat (rx/of ::force-persist) (wait-persisted timeout-ms))))
(defn- files-queued?
"True when the queue in `pstate` still holds changes of any of `file-ids`."
[{:keys [queue index]} file-ids]
(boolean (some #(contains? file-ids (get-in index [% :file-id])) queue)))
(defn unsaved-changes?
"True when any of `file-ids` has changes the server does not have yet."
[state file-ids]
(files-queued? (:persistence state) file-ids))
(defn force-persist-files-and-wait
"Sends the pending changes and waits until no change of `file-ids` is
queued, saving fails, or `timeout-ms` passes. Never raises; check
`unsaved-changes?` afterwards."
[file-ids timeout-ms]
(rx/concat
(rx/of ::force-persist)
(->> (rx/from-atom refs/persistence {:emit-current-value? true})
(rx/filter #(or (= :error (:status %))
(not (files-queued? % file-ids))))
(rx/take 1)
(rx/ignore)
(rx/timeout timeout-ms (rx/empty)))))
(defn- next-status
"Refuses downgrades: a save in progress stays :saving, a failed save
stays :error until persistence is resumed, and a retrying episode stays
@ -138,17 +163,31 @@
(#{:error :saved} status)
(dissoc :run-id :last-progress-at :stall-reported))))))))
(def ^:private busy-server-codes
"Server error codes for a database timeout that rolled the save back."
#{:statement-timeout :idle-in-transaction-timeout})
(defn- busy-server-error?
"True when the backend was too busy to apply the save: it refused it
(429) or a database timeout rolled it back. Resending it is safe."
[{:keys [type cause-type code]}]
(let [type (or cause-type type)]
(or (= :rate-limit type)
(and (= :server-error type)
(contains? busy-server-codes code)))))
(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
nothing about the edits themselves), a busy backend, 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]}]
[{:keys [type cause-type code] :as error}]
(boolean
(or (contains? rp/retryable-types type)
(contains? rp/retryable-types cause-type)
(busy-server-error? error)
(= :invalid-save-response code))))
(def ^:private retry-delays-ms
@ -299,6 +338,23 @@
(update :queue #(into (empty %) (remove dropped) %))
(update :index #(apply dissoc % dropped)))))))
(defn- notify-failure?
"False for a failed attempt of the slow cycle: it repeats a failure the
user was already told about."
[pstate]
(not (and (:recovering pstate)
(slow-retry-pending? pstate))))
(defn- save-failed-event
"Audit event for a save failure the user is told about, so failed saves
can be counted."
[{:keys [error queue] :as pstate}]
(ev/event {::ev/name "save-failed"
:cause-type (:cause-type error)
:code (:code error)
:retrying (slow-retry-pending? pstate)
:queued-commits (count queue)}))
(defn- persistence-failed
[commit-id cause]
(ptk/reify ::persistence-failed
@ -322,14 +378,16 @@
ptk/WatchEvent
(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)]
(let [pstate (:persistence state)]
(rx/merge
;; The terminal toast replaces the reconnect notice, hidden by tag.
(rx/of (ptk/data-event ::error cause)
(ntf/hide :tag reconnecting-tag))
(if (notify-failure? pstate)
(rx/of (save-failed-event pstate))
(rx/empty))
;; A transport failure that outlasts the backoff can still pass, so
;; the queue keeps trying at a slow pace.
(if (and (not (:suspended pstate))
(slow-retry-pending? pstate))
(slow-retry-cycle stream)
@ -337,13 +395,10 @@
ptk/EffectEvent
(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.
;; Notifies without the global handlers, which may reload the file or
;; navigate away and lose the retained changes.
(let [pstate (:persistence state)]
(when-not (and (:recovering pstate)
(slow-retry-pending? pstate))
(when (notify-failure? pstate)
(errors/flash-persistence cause :retrying (slow-retry-pending? pstate)))))))
(defn- persistence-transient-failure
@ -783,6 +838,17 @@
(swap! st/ongoing-tasks conj :persistence)
(swap! st/ongoing-tasks disj :persistence)))))
(defn leave-signals
"Emits when the tab is hidden or the window loses focus: another tab or
app, a plugin iframe, a closed laptop. Empty outside the browser."
[]
(if (and (exists? js/window) (exists? js/document))
(rx/merge
(->> (rx/from-event js/document "visibilitychange")
(rx/filter #(= "hidden" (.-visibilityState js/document))))
(rx/from-event js/window "blur"))
(rx/empty)))
(defn initialize-persistence
[]
(ptk/reify ::initialize-persistence
@ -841,6 +907,12 @@
(rx/map #(ptk/data-event ::persistence-notification))
(rx/take-until stoper-s))
;; Sends the buffered edits when the user leaves the tab or window.
(->> (leave-signals)
(rx/filter (fn [_] @buffered?))
(rx/map (fn [_] ::force-persist))
(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).

10
frontend/src/app/main/ui/exports/files.cljs
View File

@ -19,6 +19,7 @@
[app.main.ui.ds.foundations.typography :as t]
[app.main.ui.ds.foundations.typography.heading :refer [heading*]]
[app.main.ui.ds.foundations.typography.text :refer [text*]]
[app.main.ui.ds.notifications.context-notification :refer [context-notification*]]
[app.main.ui.ds.product.loader :refer [loader*]]
[app.main.ui.notifications.context-notification :refer [context-notification]]
[app.util.dom :as dom]
@ -79,7 +80,7 @@
{::mf/register modal/components
::mf/register-as ::fexp/export-files
::mf/props :obj}
[{:keys [team-id files]}]
[{:keys [team-id files unsaved]}]
(let [state* (mf/use-state (partial initialize-state files))
has-libs? (some :has-libraries files)
export-types (cond-> fexp/valid-types
@ -142,6 +143,13 @@
:on-click on-cancel
:class (stl/css :modal-close-btn)
:icon i/close}]]
(when unsaved
[:> context-notification* {:level :warning
:appearance :ghost
:class (stl/css :unsaved-warning)}
(tr "files-download-modal.unsaved-changes")])
(cond
(= status :prepare)
[:*

4
frontend/src/app/main/ui/exports/files.scss
View File

@ -39,6 +39,10 @@
max-block-size: calc(10 * px2rem(80));
}
.unsaved-warning {
margin-block-end: var(--sp-xxl);
}
.modal-content {
display: flex;
flex-direction: column;

108
frontend/test/frontend_tests/data/exports_assets_test.cljs
View File

@ -9,12 +9,15 @@
[app.common.uuid :as uuid]
[app.main.data.exports.assets :as de]
[app.main.data.persistence :as dwp]
[app.main.errors :as errors]
[app.main.repo :as repo]
[app.main.store :as st]
[app.util.dom :as dom]
[app.util.i18n :as i18n]
[app.util.websocket :as ws]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[frontend-tests.helpers.async :as async]
[frontend-tests.helpers.events :as the]
[frontend-tests.helpers.mock :as mock]
[potok.v2.core :as ptk]))
@ -55,7 +58,7 @@
(rx/of {:filename "export.png"
:mtype "image/png"
:uri "blob:export"})))
dwp/force-persist-and-wait (mock/stub (fn [_] (rx/of ::force-persisted)))
dwp/force-persist-files-and-wait (mock/stub (fn [_ _] (rx/of ::force-persisted)))
dom/trigger-download-uri (mock/stub (fn [& _] nil))}
(fn [done']
(let [completed (fn [_state]
@ -97,3 +100,106 @@
(de/request-multiple-export {:exports exports})
:the/end)))
done))))
(defn- export-store
"A store for the export tests that records store errors in `store-errors`."
[state store-errors]
(ptk/store {:state state :on-error #(swap! store-errors conj %)}))
(defn- unsaved-state
"Test state whose save queue still holds a change of `file-id`."
[file-id]
(let [commit-id (uuid/next)]
(assoc (test-state)
:persistence {:queue (conj #queue [] commit-id)
:index {commit-id {:id commit-id :file-id file-id}}})))
;; Scenario: the exporter fails a single export. Proves: the user gets a
;; toast and stays in the workspace; the failure is not raised to the global
;; error handler, which would replace the workspace with an error page.
(t/deftest ^:async failed-simple-export-shows-a-toast-instead-of-raising
(let [store-errors (atom [])
flashed (atom [])
store (export-store (test-state) store-errors)]
(await
(mock/with-mocks*
{repo/cmd! (mock/stub (fn [_ _]
(rx/throw (ex-info "exporter failed"
{:type :server-error
:code :unhandled}))))
dwp/force-persist-files-and-wait (mock/stub (fn [_ _] (rx/empty)))
errors/flash (fn [& {:keys [hint type]}]
(swap! flashed conj [hint type]))
i18n/tr (mock/stub #(str "translated:" %))}
(ptk/emit! store (de/request-simple-export {:export export}))
(await (async/wait-for #(seq @flashed) "the failure is shown"))
(await (async/settle))
(t/is (= [["translated:errors.export-failed" :unhandled]] @flashed)
"an exporter defect reports as unhandled")
(t/is (empty? @store-errors) "nothing reaches the global error handler")
(t/is (nil? (:export @store)) "the export state is cleared")))))
;; Scenario: the export request of a multiple export fails. Proves: the user
;; gets a toast, and the leave-page warning the export turned on is released
;; even though no progress message will ever arrive.
(t/deftest ^:async failed-multiple-export-shows-a-toast-and-releases-the-leave-warning
(let [store-errors (atom [])
flashed (atom [])
tasks (atom #{})
store (export-store (test-state) store-errors)]
(await
(mock/with-mocks*
{repo/cmd! (mock/stub (fn [_ _]
(rx/throw (ex-info "exporter failed"
{:type :server-error}))))
dwp/force-persist-files-and-wait (mock/stub (fn [_ _] (rx/empty)))
ws/get-rcv-stream (mock/stub (fn [_] (rx/subject)))
st/ongoing-tasks tasks
errors/flash (fn [& {:keys [hint]}] (swap! flashed conj hint))
i18n/tr (mock/stub #(str "translated:" %))}
(ptk/emit! store (de/request-multiple-export {:exports [(assoc export :enabled true)]}))
(await (async/wait-for #(seq @flashed) "the failure is shown"))
(await (async/wait-for #(not (contains? @tasks :export))
"the leave-page warning is released"))
(t/is (= ["translated:errors.export-failed"] @flashed))
(t/is (empty? @store-errors) "nothing reaches the global error handler")))))
;; Scenario: an export starts while its file has a change not saved yet.
;; Proves: the user is warned that the export may miss it, and the export
;; runs anyway.
(t/deftest ^:async export-warns-when-the-file-has-unsaved-changes
(let [file-id (uuid/next)
downloaded (atom false)
store (export-store (unsaved-state file-id) (atom []))]
(await
(mock/with-mocks*
{repo/cmd! (mock/stub (fn [_ _]
(rx/of {:filename "export.png"
:mtype "image/png"
:uri "blob:export"})))
dwp/force-persist-files-and-wait (mock/stub (fn [_ _] (rx/empty)))
dom/trigger-download-uri (mock/stub (fn [& _] (reset! downloaded true)))
i18n/tr (mock/stub #(str "translated:" %))}
(ptk/emit! store (de/request-simple-export {:export (assoc export :file-id file-id)}))
(await (async/wait-for #(true? @downloaded) "the export runs anyway"))
(t/is (= "translated:workspace.export.unsaved-changes"
(get-in @store [:notification :content])))
(t/is (= :warning (get-in @store [:notification :level])))))))
;; Scenario: an export starts with every change of its file saved. Proves:
;; no warning is shown.
(t/deftest ^:async export-shows-no-warning-when-the-file-is-saved
(let [downloaded (atom false)
store (export-store (test-state) (atom []))]
(await
(mock/with-mocks*
{repo/cmd! (mock/stub (fn [_ _]
(rx/of {:filename "export.png"
:mtype "image/png"
:uri "blob:export"})))
dwp/force-persist-files-and-wait (mock/stub (fn [_ _] (rx/empty)))
dom/trigger-download-uri (mock/stub (fn [& _] (reset! downloaded true)))}
(ptk/emit! store (de/request-simple-export {:export (assoc export :file-id (uuid/next))}))
(await (async/wait-for #(true? @downloaded) "the export runs"))
(await (async/settle))
(t/is (nil? (:notification @store)))))))

72
frontend/test/frontend_tests/data/exports_files_test.cljs Normal file
View File

@ -0,0 +1,72 @@
;; 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.exports-files-test
"Tests for opening the `.penpot` download dialog: the pending changes are
sent first, and the dialog is told when some are still not saved."
(:require
[app.common.uuid :as uuid]
[app.main.data.exports.files :as fexp]
[app.main.data.modal :as modal]
[app.main.data.persistence :as dps]
[app.main.repo :as rp]
[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- file-param
[file-id]
{:id file-id :name "File" :project-id (uuid/next) :is-shared false})
(defn- with-queued-change
"Adds to `state` a save queue that still holds a change of `file-id`."
[state file-id]
(let [commit-id (uuid/next)]
(assoc state :persistence {:queue (conj #queue [] commit-id)
:index {commit-id {:id commit-id :file-id file-id}}})))
(defn- ^:async dialog-props
"Opens the download dialog for `file-id` from `state` and returns the
props the dialog is shown with, plus the file ids the save wait got."
[state file-id]
(let [store (ptk/store {:state state :on-error #(t/is false (str %))})
waited (atom nil)]
(await
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [_ _] (rx/of false)))
dps/force-persist-files-and-wait (mock/stub (fn [file-ids _]
(reset! waited file-ids)
(rx/empty)))}
(ptk/emit! store (fexp/open-export-dialog [(file-param file-id)]))
(await (async/wait-for #(some? (get-in @store [::modal/modal :props]))
"the dialog opens"))))
(assoc (get-in @store [::modal/modal :props]) ::waited @waited)))
;; Scenario: the user downloads a file whose changes are all saved. Proves:
;; the pending changes of that file are sent first, and the dialog shows no
;; warning.
(t/deftest ^:async download-of-a-saved-file-has-no-warning
(let [file-id (uuid/next)
props (await (dialog-props {} file-id))]
(t/is (= #{file-id} (::waited props)) "the save wait covers the downloaded file")
(t/is (false? (:unsaved props)))))
;; Scenario: the file still has a change the server does not have after the
;; wait. Proves: the dialog is told, so it can warn that the download will
;; not include it.
(t/deftest ^:async download-of-a-file-with-unsaved-changes-warns
(let [file-id (uuid/next)
props (await (dialog-props (with-queued-change {} file-id) file-id))]
(t/is (true? (:unsaved props)))))
;; Scenario: another file has unsaved changes. Proves: only the downloaded
;; file's changes count.
(t/deftest ^:async unsaved-changes-of-another-file-do-not-warn
(let [file-id (uuid/next)
props (await (dialog-props (with-queued-change {} (uuid/next)) file-id))]
(t/is (false? (:unsaved props)))))

62
frontend/test/frontend_tests/data/persistence_retry_test.cljs
View File

@ -199,6 +199,68 @@
(t/deftest ^:async cloudflare-origin-timeout-save-is-retried
(await (check-gateway-response-retries 524)))
(defn- check-busy-server-response-retries
"Answers the first send with `response`, a refusal the backend wrote
because it was busy, built by the real `rp/handle-response`, and the retry
with a valid revision. The save was never applied, so it must take the
retry path and land, never halt in `:error`."
[response]
(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 busy " (:status response) " is retried and the save lands")))
(t/is (= 2 (count @requests)) "the busy answer plus one retry")
(t/is (empty? @failures) "a retried busy answer never reaches the failure toast"))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rp/handle-response (assoc response :uri "https://penpot.example.com/api/main/methods/update-file"))
(rx/of {:revn 1}))))))
;; Variant: the save waited too long for a concurrency slot (no body).
(t/deftest ^:async concurrency-limit-save-is-retried
(await (check-busy-server-response-retries {:status 429 :body nil})))
;; Variant: the database cancelled the save while it waited for the file lock.
(t/deftest ^:async statement-timeout-save-is-retried
(await (check-busy-server-response-retries
{:status 504
:body {:type :server-error
:code :statement-timeout
:hint "The operation took too long and was cancelled"}})))
;; Variant: the database ended the save's transaction after it sat idle.
(t/deftest ^:async idle-transaction-timeout-save-is-retried
(await (check-busy-server-response-retries
{:status 504
:body {:type :server-error
:code :idle-in-transaction-timeout
:hint "The transaction was idle too long and was cancelled"}})))
;; Scenario: the backend fails the save for any other reason. Proves: only
;; the busy-server codes retry; a server defect stops saving at once.
(t/deftest ^:async other-server-errors-stay-terminal
(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 #(= :error (get-in @store [:persistence :status]))
"the save fails"))
(t/is (= :server-error (get-in @store [:persistence :error :cause-type])))
(t/is (= 1 (count @requests)) "no retry"))))
(fn [_ _]
(rp/handle-response {:status 500
:body {:type :server-error :code :unhandled}
:uri "https://penpot.example.com/api/main/methods/update-file"})))))
;; 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

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

@ -21,10 +21,12 @@
[app.common.types.shape :as cts]
[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.data.render-wasm :as drw]
[app.main.data.workspace :as dw]
[app.main.errors :as errors]
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.i18n :as i18n]
@ -32,6 +34,7 @@
[cljs.test :as t :include-macros true]
[frontend-tests.helpers.async :as async]
[frontend-tests.helpers.mock :as mock]
[okulary.core :as l]
[potok.v2.core :as ptk]))
(t/deftest reopening-restores-only-the-retained-edits-of-the-loaded-file
@ -693,6 +696,19 @@
(t/is (not (dps/transient-error? {:type :persistence :code :save-permission-denied})))
(t/is (not (dps/transient-error? {}))))
;; A busy backend refused or rolled back the save, so it is safe to resend:
;; a rate or concurrency limit, or a database timeout. Any other server
;; error stays terminal.
(t/deftest busy-server-classification
(t/is (dps/transient-error? {:type :rate-limit}))
(t/is (dps/transient-error? {:type :persistence :cause-type :rate-limit :code :rate-limited}))
(t/is (dps/transient-error? {:type :server-error :code :statement-timeout}))
(t/is (dps/transient-error? {:type :persistence :cause-type :server-error :code :statement-timeout}))
(t/is (dps/transient-error? {:type :persistence :cause-type :server-error :code :idle-in-transaction-timeout}))
(t/is (not (dps/transient-error? {:type :server-error})))
(t/is (not (dps/transient-error? {:type :persistence :cause-type :server-error :code :unhandled})))
(t/is (not (dps/transient-error? {:type :persistence :cause-type :validation :code :statement-timeout}))))
;; The transient set is owned by `repo/retryable-types`: every transport
;; type retryable at the HTTP layer must also be transient for the save
;; pipeline, in both the direct and the wrapped (`persistence-failed`)
@ -988,3 +1004,135 @@
(await (async/wait-for #(not (contains? @tasks :persistence))
"the release turns the guard off"))
(t/is (= :saved (get-in @store [:persistence :status])))))))
;; Scenario: an edit waits in the 3 s buffer and the user switches tabs or
;; windows. Proves: leaving sends the buffered edit at once, well before
;; the buffer would (the bounded `wait-for` gives up long before 3 s).
(t/deftest ^:async leaving-the-tab-sends-buffered-edits-at-once
(let [leave-s (rx/subject)]
(await
(mock/with-mocks*
{dps/leave-signals (fn [] leave-s)}
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(ptk/emit! store (local-commit file-id))
(await (async/settle))
(t/is (empty? @requests) "the edit waits in the buffer")
(rx/push! leave-s :hidden)
(await (async/wait-for #(= 1 (count @requests))
"leaving sends the edit at once"))
(t/is (= 1 (count @requests))))))))))
;; Scenario: nothing is buffered when the user leaves. Proves: a leave
;; signal alone sends nothing.
(t/deftest ^:async leaving-with-nothing-buffered-sends-nothing
(let [leave-s (rx/subject)]
(await
(mock/with-mocks*
{dps/leave-signals (fn [] leave-s)}
(await
(with-persistence
(^:async fn [{:keys [requests store]}]
(rx/push! leave-s :hidden)
(await (async/settle))
(t/is (empty? @requests))
(t/is (nil? (get-in @store [:persistence :status]))))))))))
(defn- wait-files-saved
"Emits into `store` an event that runs `force-persist-files-and-wait` for
`file-ids` and then flips `done`."
[store file-ids timeout-ms done]
(ptk/emit! store
(ptk/reify ::wait-files-saved
ptk/WatchEvent
(watch [_ _ _]
(rx/concat
(dps/force-persist-files-and-wait file-ids timeout-ms)
(rx/of (ptk/reify ::files-saved
ptk/EffectEvent
(effect [_ _ _] (reset! done true)))))))))
;; Scenario: an edit waits in the buffer when an export asks for its file
;; to be saved. Proves: the wait sends the edit and only ends once the save
;; lands.
(t/deftest ^:async waiting-for-a-file-sends-and-waits-for-its-edits
(let [done (atom false)]
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{refs/persistence (l/derived :persistence store)}
(ptk/emit! store (local-commit file-id))
(wait-files-saved store #{file-id} 60000 done)
(await (async/wait-for #(= 1 (count @requests)) "the edit is sent at once"))
(await (async/settle))
(t/is (false? @done) "the wait holds while the save is in flight")
(rx/push! response {:revn 1})
(await (async/wait-for #(true? @done) "the landed save ends the wait"))
(t/is (not (dps/unsaved-changes? @store #{file-id}))))))))))
;; Scenario: a save of one file hangs while another file is exported.
;; Proves: the wait only covers the exported files.
(t/deftest ^:async waiting-for-a-file-ignores-other-files
(let [done (atom false)]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{refs/persistence (l/derived :persistence store)}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the other file's save hangs"))
(wait-files-saved store #{(uuid/next)} 60000 done)
(await (async/wait-for #(true? @done) "the wait ends at once")))))))))
;; Scenario: the file's save hangs past the wait. Proves: the wait gives up
;; without raising, and the file still reports unsaved changes.
(t/deftest ^:async waiting-for-a-file-gives-up-after-the-timeout
(let [done (atom false)]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{refs/persistence (l/derived :persistence store)}
(ptk/emit! store (local-commit file-id))
(wait-files-saved store #{file-id} 1 done)
(await (async/wait-for #(true? @done) "the wait times out"))
(t/is (= 1 (count @requests)))
(t/is (dps/unsaved-changes? @store #{file-id})))))))))
(defn- save-failed-events
"Starts collecting the `save-failed` audit events that `store` processes."
[store]
(let [events (atom [])]
(->> (ptk/input-stream store)
(rx/filter #(= ::ev/event (ptk/type %)))
(rx/map deref)
(rx/filter #(= "save-failed" (::ev/name %)))
(rx/subs! #(swap! events conj %)))
events))
;; Scenario: the backend rejects a save as invalid data. Proves: the user's
;; failure toast comes with one `save-failed` audit event that records why.
(t/deftest ^:async a-failed-save-emits-one-save-failed-event
(await
(with-persistence
(^:async fn [{:keys [file-id store]}]
(let [events (save-failed-events store)]
(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/wait-for #(seq @events) "the event is emitted"))
(await (async/settle))
(t/is (= 1 (count @events)))
(t/is (= {:cause-type :validation
:code :referential-integrity
:retrying false
:queued-commits 1}
(select-keys (first @events)
[:cause-type :code :retrying :queued-commits])))))
(fn [_ _]
(rx/throw (ex-info "invalid" {:type :validation :code :referential-integrity}))))))

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

@ -13,6 +13,7 @@
[frontend-tests.data.dashboard-test]
[frontend-tests.data.event-test]
[frontend-tests.data.exports-assets-test]
[frontend-tests.data.exports-files-test]
[frontend-tests.data.fix-deleted-fonts-test]
[frontend-tests.data.modal-test]
[frontend-tests.data.nitrate-test]
@ -166,6 +167,7 @@
'frontend-tests.data.repo-test
'frontend-tests.data.store-test
'frontend-tests.data.exports-assets-test
'frontend-tests.data.exports-files-test
'frontend-tests.data.svg-upload-test
'frontend-tests.data.uploads-test
'frontend-tests.data.viewer-test

16
frontend/translations/en.po
View File

@ -1582,7 +1582,11 @@ msgstr "The email «%s» has many permanent bounce reports."
msgid "errors.email-spam-or-permanent-bounces"
msgstr "The email «%s» has been reported as spam or permanently bounce."
#: src/app/main/errors.cljs:828
#: src/app/main/data/exports/assets.cljs
msgid "errors.export-failed"
msgstr "The export failed. Try again in a moment."
#: src/app/main/errors.cljs:974
msgid "errors.feature-mismatch"
msgstr ""
"Looks like you are opening a file that has the feature '%s' enabled but the "
@ -2141,6 +2145,10 @@ msgstr "Your file will be exported with library asset merged into the local libr
msgid "files-export-modal.options.merge-libraries.title"
msgstr "Embed library assets in the file"
#: src/app/main/ui/exports/files.cljs
msgid "files-download-modal.unsaved-changes"
msgstr "Some of your latest changes are not saved yet, so this download will not include them."
#: src/app/main/ui/settings/password.cljs:45
msgid "generic.error"
msgstr "An error has occurred"
@ -6431,7 +6439,11 @@ msgstr "Remove guide"
msgid "workspace.debug.title"
msgstr "Debugging tools"
#: src/app/main/ui/workspace/sidebar/layers.cljs:885
#: src/app/main/data/exports/assets.cljs
msgid "workspace.export.unsaved-changes"
msgstr "Some of your latest changes are not saved yet, so this export may not include them."
#: src/app/main/ui/workspace/sidebar/layers.cljs:907
msgid "workspace.focus.focus-mode"
msgstr "Focus mode"

16
frontend/translations/es.po
View File

@ -1592,7 +1592,11 @@ msgstr "El correo electrónico «%s» tiene varios reportes de rebote permanente
msgid "errors.email-spam-or-permanent-bounces"
msgstr "El email «%s» tiene reportes de spam o de rebote permanente."
#: src/app/main/errors.cljs:828
#: src/app/main/data/exports/assets.cljs
msgid "errors.export-failed"
msgstr "La exportación ha fallado. Inténtalo de nuevo en un momento."
#: src/app/main/errors.cljs:974
msgid "errors.feature-mismatch"
msgstr ""
"Parece que está abriendo un archivo que tiene la función '%s' habilitada, "
@ -2167,6 +2171,10 @@ msgstr ""
msgid "files-export-modal.options.merge-libraries.title"
msgstr "Incluir librerias compartidas dentro de las librerias del fichero"
#: src/app/main/ui/exports/files.cljs
msgid "files-download-modal.unsaved-changes"
msgstr "Algunos de tus últimos cambios aún no se han guardado, así que esta descarga no los incluirá."
#: src/app/main/ui/settings/password.cljs:45
msgid "generic.error"
msgstr "Ha ocurrido un error"
@ -6493,7 +6501,11 @@ msgstr "Eliminar guía"
msgid "workspace.debug.title"
msgstr "Herramientas de depuración"
#: src/app/main/ui/workspace/sidebar/layers.cljs:885
#: src/app/main/data/exports/assets.cljs
msgid "workspace.export.unsaved-changes"
msgstr "Algunos de tus últimos cambios aún no se han guardado, así que puede que esta exportación no los incluya."
#: src/app/main/ui/workspace/sidebar/layers.cljs:907
msgid "workspace.focus.focus-mode"
msgstr "Modo foco"