⚡ Compact automatic file snapshots in a background task

An automatic snapshot taken by update-file stores the file data bytes as
they are, instead of realizing every objects-map and encoding the whole
file inside the request. When the data holds objects-maps, the new
compact-file-snapshot task, queued in the same transaction, rewrites the
snapshot with plain maps later. On the legacy-db backend the snapshot is
compacted inline.

fsnap/create! runs its writes in its own transaction, so callers that pass
only a pool (the restore backup) can queue the task. Whether stored bytes
hold objects-maps comes from the decoded data, not from the file features,
and compaction leaves pages behind a pointer unloaded.

.serena/memories/backend/subtleties.md

@@ -90,4 +90,5 @@
 - 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.
-- `update-file` with `:changes-with-metadata` groups that all carry `:commit-id` is partial: fast path applies and validates everything once; on a change failure it bisects the commits for the longest prefix that applies and validates (each attempt applies a prefix from the original data and runs referential integrity + file schema; ~log2 K attempts, none for a single commit, the first attempt's error reused), keeping that prefix (a commit that repairs an earlier one can keep both) and answering 200 with `:rejected {:commit-ids :failed-commit-id :error}`. Only accepted changes reach `file_change`, persistence and the msgbus; a fully rejected request writes and broadcasts nothing (revn unchanged). Flat `:changes` or groups without ids stay all-or-nothing. Before each attempt (`apply-prefix`, which returns `{:file :tracked :refs}` or the cause) `pmap/*tracked*` and the `cpc/*state*` atom are reset to their pre-attempt values (at the end `apply-commits` sets those of the kept prefix): a pointer map already `modified?` keeps its id when changed again, so the failed version would be persisted. DB/IO/interrupt errors and `:not-found` fragments (`change-failure?`) fail the whole request, never reject a commit. With a schema check running (hard schema validation without skip-validate, or soft) and 2+ commits, the touched pages' objects are decoded on the original file first (`decode-objects`; referential validation alone reads few objects, so no pre-decode then): objects-map caches decoded values per instance and a derived map copies the cache, so otherwise every attempt re-decodes the page (~260 ms at 10k shapes). Validation step timings (`with-validation-timing`, upstream `penpot_rpc_update_file_validation_timing` + the `update-file` debug log) come from the first attempt only (retries run with a cfg without metrics and timings); the whole bisection is one `retry` step sample, and the rejection log carries `:attempts`/`:elapsed`.
+- Automatic snapshots (`take-snapshot?`, every `auto-file-snapshot-every` revns or after `auto-file-snapshot-timeout`): `attach-snapshot` keeps the stored bytes as they are (pointers present → `realize-pointers` only, migrated → the migrated file) and flags `::objects-map` (passed to `fsnap/create!` as `:objects-map`) from the decoded data, never from `:features` (`update-file*` merges team and request features first, so they can name objects-map/pointer-map the data lacks). `fsnap/create!` runs in its own `tx-run!` (callers such as `restore-file-snapshot` pass a pool-only cfg); data with objects-maps is stored as it is and it queues `compact-file-snapshot` in that tx, which locks the `file_data` row and rewrites it with plain objects (`fsnap/compact!` via `fdata/realize-page-objects`, which skips pages behind a pointer since the task binds no `*load-fn*`; keeps backend/metadata/dates; no-op if gone or already plain; storage backend uploads a new object and touches the old one for gc). legacy-db compacts inline. Readers (preview, restore, file-gc) read both formats. Tests enable `fdata/pointer-map` for teams, so a saved file ends up behind pointers: test the raw-bytes path with files created without pointer-map, or call `fsnap/create!` directly.
+- `update-file` with `:changes-with-metadata` groups that all carry `:commit-id` is partial: fast path applies and validates everything once; on a change failure it bisects the commits for the longest prefix that applies and validates (each attempt applies a prefix from the original data and runs referential integrity + file schema; ~log2 K attempts, none for a single commit, the first attempt's error reused), keeping that prefix (a commit that repairs an earlier one can keep both) and answering 200 with `:rejected {:commit-ids :failed-commit-id :error}`. Only accepted changes reach `file_change`, persistence and the msgbus; a fully rejected request writes and broadcasts nothing (revn unchanged). Flat `:changes` or groups without ids stay all-or-nothing. Before each attempt (`apply-prefix`, which returns `{:file :tracked :refs}` or the cause) `pmap/*tracked*` and the `cpc/*state*` atom are reset to their pre-attempt values (at the end `apply-commits` sets those of the kept prefix): a pointer map already `modified?` keeps its id when changed again, so the failed version would be persisted. DB/IO/interrupt errors and `:not-found` fragments (`change-failure?`) fail the whole request, never reject a commit. A rejection whose ex-info has no `:type` reports `:internal :unexpected-error`. `app.http.errors` answers 503 (`:server-error` + code) for transient SQLSTATEs (classes 08/53, 57P01–3, 40001, 40P01), `SQLTransientException`, `IOException` and `InterruptedException`, which the client's save retries; other SQL errors stay 500. With the `:debug-save-faults` flag, a `:set-plugin-data` file change in namespace `:penpot-debug` keyed `save-fault:<kind>` raises that fault in `apply-changes` (used by `debug.failNextSave`/`commitInvalidChange`). With a schema check running (hard schema validation without skip-validate, or soft) and 2+ commits, the touched pages' objects are decoded on the original file first (`decode-objects`; referential validation alone reads few objects, so no pre-decode then): objects-map caches decoded values per instance and a derived map copies the cache, so otherwise every attempt re-decodes the page (~260 ms at 10k shapes). Validation step timings (`with-validation-timing`, upstream `penpot_rpc_update_file_validation_timing` + the `update-file` debug log) come from the first attempt only (retries run with a cfg without metrics and timings); the whole bisection is one `retry` step sample, and the rejection log carries `:attempts`/`:elapsed`.

.serena/memories/frontend/workspace-state-persistence-subtleties.md

@@ -22,12 +22,12 @@
 - Applying a remote commit first rolls back the pending local commits of its own file (`pcm/pending-commits`: queued entries, then `[:persistence :buffer]`; other files' commits never touch its data), applies the remote changes, then replays pending local redo changes. Index updates are emitted for undo, remote redo, and replayed redo paths. Leaving the buffer out makes a remote change to the same attr win locally but lose on the server.
 - Local commits are independently consumed by undo, persistence, WASM model updates, thumbnail/library watchers, and text position-data recalculation.
 - Persistence buffers local commits in the store (`buffer-commit` → `[:persistence :buffer]`, stamped with `:remote-seq`): status becomes pending after about 200ms; the 3s debounce or `::force-persist` emits `flush-buffer`, which merges the buffer per file into `append-commit`s, and each append removes its own commits from the buffer (a commit arriving mid-flush stays). `initialize-persistence-state` flushes a leftover buffer. Queue entries (`pcm/queue-entry`) hold the entry keys of the first commit (id, created-at, origin, features, file-id/revn/vern) and `:commits` (id, origin, undo-group, redo/undo changes, remote-seq of each merged commit), no merged change lists; every reader goes through `:commits`. The save sends `:changes-with-metadata`, one group per commit with `:commit-id`, never flat `:changes`.
-- A save answered with `:rejected` (backend kept the commits before the first failing one, see `mem:backend/subtleties`) is not a failure: `rollback-rejected` runs before `commit-persisted`. The unit is the undo group (one user action, which can commit to several files, e.g. `update-component` writes the copy's file and the library, and `component-changed` syncs inherit the edit's group; multi-file actions must share a non-nil group): the pure bookkeeping lives in `app.main.data.persistence.commits` (`pcm`): `pcm/rollback-plan` reverts, in the saved file, the pending commits from the first rejected one on, and in any file the pending commits from the first one of a reverted group on, iterating until no new group appears; other files' unrelated commits stay. `pcm/without-rolled-back` drops pending reverted commits from queue entries (partial entries trimmed, empty ones leave the queue) and the buffer; saved commits of a reverted group (the head's kept ones, and `:saved`, which `keep-saved-commits` fills on `discard-commit` with saved commits whose group a pending commit still shares) are undone by a new `save-undo? false` commit (`compensate-commits`, flushed like any edit); for a file whose data is not loaded the undo goes straight to the queue as an entry, nothing applied locally. Per file, `dch/rebase-commits` undoes every pending commit newest first, re-applies the remote changes kept since the oldest pending commit, and redoes the pending commits that stay. Undo changes hold absolute values from commit time, so undoing only the rejected commits would overwrite a peer's later change to the same attr. Remote changes are numbered (`record-remote-changes`, `[:persistence :remote-seq]`) and kept per file under `:remote-changes` only while the file has pending commits; `prune-remote-changes` (discard, release) forgets those at or below the oldest pending stamp, since re-applying them would undo saved edits. Then `dwu/forget-undo-groups` (cut history before the first entry of a reverted commit's undo-group; no match clears it; open transaction emptied), selection pruned and edition mode left when the edited shape is gone (`prune-removed-shapes`; `v2-update-text-shape-content` also skips a missing shape, so the editor's exit commits nothing), `errors/flash` `:unhandled` sticky toast tagged `:persistence-rejected`. `rebase-commits` is not a commit (not saved/broadcast/undoable, commit watchers such as thumbnails do not see it) and falls back to `::dw/reload-current-file` if applying throws. `debug.commitInvalidChange({kind, before, after})` forces such a rejection live.
+- A save answered with `:rejected` (backend kept the commits before the first failing one, see `mem:backend/subtleties`) is not a failure: `rollback-rejected` runs before `commit-persisted`. The unit is the undo group (one user action, which can commit to several files, e.g. `update-component` writes the copy's file and the library, and `component-changed` syncs inherit the edit's group; multi-file actions must share a non-nil group): the pure bookkeeping lives in `app.main.data.persistence.commits` (`pcm`): `pcm/rollback-plan` reverts, in the saved file, the pending commits from the first rejected one on, and in any file the pending commits from the first one of a reverted group on, iterating until no new group appears; other files' unrelated commits stay. `pcm/without-rolled-back` drops pending reverted commits from queue entries (partial entries trimmed, empty ones leave the queue) and the buffer; saved commits of a reverted group (the head's kept ones, and `:saved`, which `keep-saved-commits` fills on `discard-commit` with saved commits whose group a pending commit still shares) are undone by a new `save-undo? false` commit (`compensate-commits`, flushed like any edit); for a file whose data is not loaded the undo goes straight to the queue as an entry, nothing applied locally. Per file, `dch/rebase-commits` undoes every pending commit newest first, re-applies the remote changes kept since the oldest pending commit, and redoes the pending commits that stay. Undo changes hold absolute values from commit time, so undoing only the rejected commits would overwrite a peer's later change to the same attr. Remote changes are numbered (`record-remote-changes`, `[:persistence :remote-seq]`) and kept per file under `:remote-changes` only while the file has pending commits; `prune-remote-changes` (discard, release) forgets those at or below the oldest pending stamp, since re-applying them would undo saved edits. Then `dwu/forget-undo-groups` (cut history before the first entry of a reverted commit's undo-group; no match clears it; open transaction emptied), selection pruned and edition mode left when the edited shape is gone (`prune-removed-shapes`; `v2-update-text-shape-content` also skips a missing shape, so the editor's exit commits nothing), `errors/flash` `:unhandled` toast tagged `:persistence-rejected`, hidden after `rejected-timeout-ms` (10 s). It ends with `(ptk/data-event ::rolled-back {:file-ids})`: `dwl/sync-file` waits for it or `wait-persisted` and marks the library synced only on a landed save (on rollback it restores `:synced-at` and re-checks updates after the rollback's own save). `update-status` ignores `:pending` when buffer and queue are empty (`nothing-to-save?`): a dropped commit's 200 ms pending debounce would otherwise leave the status stuck and `wait-persisted-or-error` waiting forever. `prune-removed-shapes` also closes a `:colorpicker` modal. `rebase-commits` is not a commit (not saved/broadcast/undoable, commit watchers such as thumbnails do not see it) and falls back to `::dw/reload-current-file` if applying throws. `debug.commitInvalidChange({kind, before, after})` forces such a rejection live.
 - Persistence sends revn as the max of the commit revn and locally tracked latest revn; remote commits update that revn tracker.
 - Persistence is skipped in version preview/read-only mode or without edit permission.
 - A terminal failure halts the queue on purpose: the edits stay queued so `wait-persisted-or-error` keeps rejecting, and `workspace/versions.cljs` relies on that to avoid snapshotting a file whose edits were never saved. `recover-persistence` lifts the halt when a file is opened again or the role changes. A transport failure still inside its retry window (`slow-retry-pending?`) is resent once (`resume-persistence true`), never released; any other halt emits `release-failed-file` (drops every queued commit of the file that failed) then `resume-persistence`. Opening a file also replays the queued, then buffered, 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** (a backend without commit-id groups still answers an invalid batch with a terminal `:validation`). 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.
+- **Every non-transport terminal save failure is permanent** (a backend without commit-id groups still answers an invalid batch with a terminal `:validation`). 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 a save's `:not-found` is a terminal save error that keeps the workspace open (`errors/delegated-persistence-types` is only `#{:authentication}`; a missing data fragment answers it too). So `:save-permission-denied` (a client-side `can-edit` check) must never be resumed: release it. Its toast `errors.save-permission-lost` is plural over `:unsaved-commits` (`count-unsaved-commits`); plural keys need `(tr k (i18n/c n))`, a bare number renders the fallback text.
 - 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.
@@ -36,7 +36,8 @@
 - `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 reads `[:persistence :buffer]` and `:queue` and syncs on `::buffer-commit`, `::append-commit`, `::discard-commit` and `::release-failed-file` (every buffer and 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 `persist-buffered`, which forces a save when `[:persistence :buffer]` is not empty, 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.
+- `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 failures.
+- `start-undo-transaction` stamps the transaction with a fresh `:commit-group` (dropped from the history entry); `commit-changes` uses `(or undo-group (:undo-group tx) (:commit-group tx) (uuid/next))`, so all commits of one transaction are one rollback unit. Pre-setting `:undo-group` instead breaks entries whose group is set later (sync transactions).
 - 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.

backend/src/app/features/fdata.clj

@@ -26,6 +26,11 @@
 ;; OBJECTS-MAP
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn- objects-map?
+  [objects]
+  (or (omap/objects-map? objects)
+      (omap.legacy/objects-map? objects)))
+
 (defn process-objects
   "Apply a function to all objects-map on the file. Usualy used for convert
   the objects-map instances to plain maps"
@@ -35,12 +40,33 @@
             (fn [page]
               (update page :objects
                       (fn [objects]
-                        (if (or (omap/objects-map? objects)
-                                (omap.legacy/objects-map? objects))
+                        (if (objects-map? objects)
                           (update-fn objects)
                           objects)))))
     fdata))
 
+(defn- page-with-objects-map?
+  "True when `page` is not behind a pointer and keeps its objects in an
+  objects-map."
+  [page]
+  (and (not (pmap/pointer-map? page))
+       (objects-map? (:objects page))))
+
+(defn has-objects-map?
+  "True when a page of `fdata` not behind a pointer keeps its objects in
+  an objects-map."
+  [fdata]
+  (some page-with-objects-map? (vals (:pages-index fdata))))
+
+(defn realize-page-objects
+  "Turns into plain maps the objects-maps of the pages of `fdata` not
+  behind a pointer. Never loads a pointer."
+  [fdata]
+  (d/update-when fdata :pages-index d/update-vals
+                 (fn [page]
+                   (cond-> page
+                     (page-with-objects-map? page)
+                     (update :objects (partial into {}))))))
 
 (defn realize-objects
   "Process a file and remove all instances of objects map realizing them

backend/src/app/features/file_snapshots.clj

@@ -164,7 +164,7 @@
    [:id ::sm/uuid]
    [:revn :int]
    [:vern :int]
-   [:data :map]
+   [:data [:or :map bytes?]]
    [:version :int]
    [:features ::cfeat/features]
    [:migrations [::sm/set :string]]])
@@ -205,20 +205,43 @@
    [:label {:optional true} ::sm/text]
    [:session-id {:optional true} ::sm/uuid]
    [:modified-at {:optional true} ::ct/inst]
-   [:deleted-at {:optional true} ::ct/inst]])
+   [:deleted-at {:optional true} ::ct/inst]
+   [:objects-map {:optional true} :boolean]])
 
 (def ^:private check-create-params
   (sm/check-fn schema:create-params))
 
+(defn- compact-data
+  "Encodes file `data` with plain maps in place of its objects-maps."
+  [data]
+  (-> data
+      (fdata/realize-page-objects)
+      (blob/encode)))
+
 (defn create!
-  "Create a file snapshot; expects a non-encoded file"
+  "Creates a snapshot of `file`. Its data is decoded, or encoded with
+  `:objects-map` telling whether it holds objects-maps. Data with
+  objects-maps is compacted by the `compact-file-snapshot` task, or here
+  on the legacy-db backend."
   [cfg file & {:as params}]
-  (let [{:keys [label created-by deleted-at profile-id session-id]}
+  (let [{:keys [label created-by deleted-at profile-id session-id objects-map]}
         (check-create-params params)
 
         file
         (check-decoded-file file)
 
+        data
+        (:data file)
+
+        compact?
+        (if (bytes? data)
+          (boolean objects-map)
+          (boolean (fdata/has-objects-map? data)))
+
+        compact-later?
+        (and compact?
+             (not= "legacy-db" (cf/get :file-data-backend)))
+
         created-by
         (or created-by "system")
 
@@ -255,26 +278,65 @@
           :always
           (check-snapshot))]
 
-    (db/insert! cfg :file-change
-                (-> snapshot
-                    (update :features into-array)
-                    (update :migrations into-array)
-                    (assoc :updated-at created-at)
-                    (assoc :profile-id profile-id)
-                    (assoc :session-id session-id)
-                    (dissoc :modified-at))
-                {::db/return-keys false})
+    (db/tx-run! cfg
+                (fn [cfg]
+                  (db/insert! cfg :file-change
+                              (-> snapshot
+                                  (update :features into-array)
+                                  (update :migrations into-array)
+                                  (assoc :updated-at created-at)
+                                  (assoc :profile-id profile-id)
+                                  (assoc :session-id session-id)
+                                  (dissoc :modified-at))
+                              {::db/return-keys false})
 
-    (fdata/upsert! cfg
-                   {:id snapshot-id
-                    :file-id (:id file)
-                    :type "snapshot"
-                    :data (blob/encode (:data file))
-                    :created-at created-at
-                    :deleted-at deleted-at})
+                  (fdata/upsert! cfg
+                                 {:id snapshot-id
+                                  :file-id (:id file)
+                                  :type "snapshot"
+                                  :data (cond
+                                          (and compact? (not compact-later?))
+                                          (compact-data (cond-> data (bytes? data) blob/decode))
+
+                                          (bytes? data)
+                                          data
+
+                                          :else
+                                          (blob/encode data))
+                                  :created-at created-at
+                                  :deleted-at deleted-at})
+
+                  (when compact-later?
+                    (wrk/submit! {::db/conn (db/get-connection cfg)
+                                  ::wrk/task :compact-file-snapshot
+                                  ::wrk/params {:file-id (:id file)
+                                                :id snapshot-id}}))))
 
     snapshot))
 
+(def ^:private sql:get-snapshot-data-for-update
+  "SELECT *
+     FROM file_data
+    WHERE file_id = ?
+      AND id = ?
+      AND type = 'snapshot'
+      FOR UPDATE")
+
+(defn compact!
+  "Rewrites the data of snapshot `id` of `file-id` with plain maps in
+  place of its objects-maps, keeping the rest of the row. Returns true
+  when it rewrites the data."
+  [cfg file-id id]
+  (when-let [row (some-> (db/exec-one! cfg [sql:get-snapshot-data-for-update file-id id])
+                         (d/without-nils)
+                         (d/update-when :metadata fdata/decode-metadata))]
+    (let [data (-> (fdata/resolve-file-data cfg row)
+                   (get :data)
+                   (blob/decode))]
+      (when (fdata/has-objects-map? data)
+        (fdata/upsert! cfg (assoc row :data (compact-data data)))
+        true))))
+
 (def ^:private schema:update-params
   [:map {:title "SnapshotUpdateParams"}
    [:id ::sm/uuid]

backend/src/app/main.clj

@@ -517,6 +517,8 @@
      :audit-log-archive  (ig/ref :app.loggers.audit.archive-task/handler)
      :audit-log-gc       (ig/ref :app.loggers.audit.gc-task/handler)
 
+     :compact-file-snapshot
+     (ig/ref :app.tasks.compact-file-snapshot/handler)
      :delete-object
      (ig/ref :app.tasks.delete-object/handler)
      :demo-purge
@@ -570,6 +572,10 @@
    {::db/pool     (ig/ref ::db/pool)
     ::sto/storage (ig/ref ::sto/storage)}
 
+   :app.tasks.compact-file-snapshot/handler
+   {::db/pool     (ig/ref ::db/pool)
+    ::sto/storage (ig/ref ::sto/storage)}
+
    :app.tasks.telemetry/handler
    {::db/pool            (ig/ref ::db/pool)
     ::http.client/client (ig/ref ::http.client/client)

backend/src/app/rpc/commands/files_update.clj

@@ -353,14 +353,16 @@
         (let [snapshot-file (or snapshot
                                 (fdata/realize cfg (:original repair)))]
           (fsnap/create! cfg snapshot-file
-                         {:label (str "internal/repair/" revn)
+                         {:objects-map (boolean (::objects-map snapshot-file))
+                          :label (str "internal/repair/" revn)
                           :created-by "system"
                           :deleted-at snapshot-deleted-at
                           :profile-id profile-id
                           :session-id repair-session-id}))
         (when snapshot
           (fsnap/create! cfg snapshot
-                         {:label (str "internal/snapshot/" revn)
+                         {:objects-map (boolean (::objects-map snapshot))
+                          :label (str "internal/snapshot/" revn)
                           :created-by "system"
                           :deleted-at snapshot-deleted-at
                           :profile-id profile-id
@@ -467,10 +469,22 @@
                     (rds/del conn key)))))
 
 (defn- attach-snapshot
-  "Attach snapshot data to the file. This should be called before the
-  upcoming file operations are applied to the file."
-  [cfg migrated? file]
-  (let [snapshot (if migrated? file (fdata/realize cfg file))]
+  "Attaches to `file` the snapshot of its state before the changes. The
+  snapshot keeps `data`, the data as stored, except for a migrated file
+  (the migrated data) or one with pointers (the data with its pointers
+  realized). Stored data comes with `::objects-map`."
+  [cfg migrated? data file]
+  (let [snapshot (cond
+                   migrated?
+                   file
+
+                   (seq (fdata/get-used-pointer-ids (:data file)))
+                   (fdata/realize-pointers cfg file)
+
+                   :else
+                   (assoc file
+                          :data data
+                          ::objects-map (boolean (fdata/has-objects-map? (:data file)))))]
     (assoc file ::snapshot snapshot)))
 
 (defn- update-file-data!
@@ -482,7 +496,7 @@
   This function is not responsible of saving the file. It only saves
   fdata/pointer-map modified fragments."
 
-  [cfg {:keys [id] :as file} update-fn & args]
+  [cfg {:keys [id data] :as file} update-fn & args]
   (let [file (update file :data (fn [data]
                                   (-> data
                                       (blob/decode)
@@ -509,7 +523,7 @@
           (fmg/migrate-file libs)
 
           take-snapshot?
-          (->> (attach-snapshot cfg need-migration?)))]
+          (->> (attach-snapshot cfg need-migration? data)))]
 
     (apply update-fn cfg file args)))
 

backend/src/app/tasks/compact_file_snapshot.clj

@@ -0,0 +1,29 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS SUBSIDIARY SL
+
+(ns app.tasks.compact-file-snapshot
+  "Rewrites a file snapshot with plain maps in place of its objects-maps."
+  (:require
+   [app.common.logging :as l]
+   [app.db :as db]
+   [app.features.file-snapshots :as fsnap]
+   [app.storage :as sto]
+   [integrant.core :as ig]))
+
+(defmethod ig/assert-key ::handler
+  [_ params]
+  (assert (db/pool? (::db/pool params)) "expected a valid database pool")
+  (assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided"))
+
+(defmethod ig/init-key ::handler
+  [_ cfg]
+  (fn [{:keys [props] :as task}]
+    (let [{:keys [file-id id]} props
+          compacted? (db/tx-run! cfg fsnap/compact! file-id id)]
+      (l/trc :hint "compact file snapshot"
+             :file-id (str file-id)
+             :id (str id)
+             :compacted (boolean compacted?)))))

backend/test/backend_tests/helpers.clj

@@ -17,6 +17,7 @@
    [app.common.spec :as us]
    [app.common.time :as ct]
    [app.common.transit :as tr]
+   [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
@@ -337,6 +338,21 @@
                                                      :session-id session-id
                                                      :profile-id profile-id})))))))
 
+(defn add-rect-change
+  "A change that adds a 10x10 rect `id` to the root of `page-id`."
+  [page-id id]
+  {:type :add-obj
+   :page-id page-id
+   :id id
+   :parent-id uuid/zero
+   :frame-id uuid/zero
+   :obj (cts/setup-shape {:id id
+                          :type :rect
+                          :name "rect"
+                          :x 0 :y 0 :width 10 :height 10
+                          :parent-id uuid/zero
+                          :frame-id uuid/zero})})
+
 (declare command!)
 
 (defn update-file! [& {:keys [profile-id file-id changes revn] :or {revn 0}}]

backend/test/backend_tests/rpc_file_snapshot_test.clj

@@ -6,6 +6,7 @@
 
 (ns backend-tests.rpc-file-snapshot-test
   (:require
+   [app.binfile.common :as bfc]
    [app.common.features :as cfeat]
    [app.common.pprint :as pp]
    [app.common.thumbnails :as thc]
@@ -15,9 +16,13 @@
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
+   [app.features.fdata :as fdata]
+   [app.features.file-snapshots :as fsnap]
    [app.http :as http]
    [app.rpc :as-alias rpc]
    [app.storage :as sto]
+   [app.util.blob :as blob]
+   [app.util.pointer-map :as pmap]
    [backend-tests.helpers :as th]
    [clojure.test :as t]
    [cuerdas.core :as str]))
@@ -220,3 +225,201 @@
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
         (t/is (true? (:result out)))))))
+
+(defn- create-edited-file
+  "Creates a file with objects-map, with or without `pointer-map?`, and saves
+  a rect on it; the save takes a snapshot of the file before the rect."
+  [& {:keys [pointer-map?]}]
+  (let [profile (th/create-profile* 1 {:is-active true})
+        file    (th/create-file* 1 {:profile-id (:id profile)
+                                    :project-id (:default-project-id profile)
+                                    :is-shared false
+                                    :features (-> (cfeat/get-enabled-features cf/flags)
+                                                  (conj "fdata/objects-map")
+                                                  (cond-> (not pointer-map?) (disj "fdata/pointer-map")))})
+        page-id (-> file :data :pages first)
+        rect-id (uuid/next)]
+    (update-file! :file-id (:id file)
+                  :profile-id (:id profile)
+                  :changes [(th/add-rect-change page-id rect-id)])
+    {:profile-id (:id profile)
+     :file-id (:id file)
+     :page-id page-id
+     :rect-id rect-id
+     :snapshot-id (-> (th/db-query :file-change {:file-id (:id file) :label "internal/snapshot/0"}
+                                   {::db/remove-deleted false})
+                      first
+                      :id)}))
+
+(defn- snapshot-row
+  [{:keys [file-id snapshot-id]}]
+  (th/db-get :file-data {:file-id file-id :id snapshot-id :type "snapshot"}
+             {::db/remove-deleted false}))
+
+(defn- snapshot-data
+  [ctx]
+  (-> (snapshot-row ctx) :data blob/decode))
+
+(defn- compaction-tasks
+  []
+  (th/db-exec! ["select * from task where name = 'compact-file-snapshot' and status = 'new'"]))
+
+(t/deftest update-file-snapshot-is-compacted-later
+  (let [{:keys [page-id rect-id] :as ctx} (create-edited-file)
+        before (snapshot-row ctx)
+        data   (snapshot-data ctx)]
+
+    (t/testing "the save stores the data as it was, objects-map included"
+      (t/is (uuid? (:snapshot-id ctx)))
+      (t/is (fdata/has-objects-map? data))
+      (t/is (not (contains? (get-in data [:pages-index page-id :objects]) rect-id))))
+
+    (t/testing "the save queues the compaction"
+      (t/is (= [{:file-id (:file-id ctx) :id (:snapshot-id ctx)}]
+               (mapv #(-> % :props db/decode-transit-pgobject) (compaction-tasks)))))
+
+    (th/run-pending-tasks!)
+
+    (t/testing "the task stores the same data with plain objects"
+      (let [after (snapshot-row ctx)]
+        (t/is (not (fdata/has-objects-map? (snapshot-data ctx))))
+        (t/is (= (fdata/process-objects data (partial into {}))
+                 (snapshot-data ctx)))
+        (t/is (= (:deleted-at before) (:deleted-at after)))
+        (t/is (= (:modified-at before) (:modified-at after)))))
+
+    (t/testing "a second compaction does nothing"
+      (t/is (nil? (db/tx-run! th/*system* fsnap/compact! (:file-id ctx) (:snapshot-id ctx)))))))
+
+(t/deftest compaction-keeps-a-snapshot-pinned-before-it
+  (let [{:keys [profile-id snapshot-id] :as ctx} (create-edited-file)
+        out (th/command! {::th/type :update-file-snapshot
+                          ::rpc/profile-id profile-id
+                          :id snapshot-id
+                          :label "pinned"})]
+    (t/is (nil? (:error out)))
+    (th/run-pending-tasks!)
+    (t/is (nil? (:deleted-at (snapshot-row ctx))))
+    (t/is (not (fdata/has-objects-map? (snapshot-data ctx))))
+    (t/is (= "pinned" (:label (th/db-get :file-change {:id snapshot-id}))))))
+
+(defn- run-compaction
+  "Runs the compaction task handler on snapshot `snapshot-id`."
+  [{:keys [file-id snapshot-id]}]
+  (let [handler (get th/*system* :app.tasks.compact-file-snapshot/handler)]
+    (handler {:props {:file-id file-id :id snapshot-id}})))
+
+(t/deftest compaction-of-a-missing-snapshot-does-nothing
+  (let [{:keys [file-id snapshot-id] :as ctx} (create-edited-file)]
+    (th/db-delete! :file-data {:file-id file-id :id snapshot-id :type "snapshot"})
+    (t/is (nil? (db/tx-run! th/*system* fsnap/compact! file-id snapshot-id)))
+    (run-compaction ctx)
+    (t/is (nil? (snapshot-row ctx)))))
+
+(defn- get-file
+  [file-id]
+  (db/run! th/*system* #(bfc/get-file % file-id)))
+
+(t/deftest snapshot-with-objects-map-can-be-taken-outside-a-transaction
+  (let [{:keys [profile-id file-id] :as ctx} (create-edited-file)
+        file     (assoc (get-file file-id) :data (snapshot-data ctx))
+        snapshot (fsnap/create! th/*system* file {:profile-id profile-id})
+        ctx      (assoc ctx :snapshot-id (:id snapshot))]
+    (t/is (fdata/has-objects-map? (snapshot-data ctx)))
+    (t/is (some #(= (:id snapshot) (-> % :props db/decode-transit-pgobject :id))
+                (compaction-tasks)))
+    (run-compaction ctx)
+    (t/is (not (fdata/has-objects-map? (snapshot-data ctx))))))
+
+(t/deftest compaction-leaves-pages-behind-a-pointer-unloaded
+  (let [{:keys [profile-id file-id page-id] :as ctx} (create-edited-file)
+        pointer-page-id (uuid/next)
+        pointer-id      (uuid/next)
+        data     (-> (snapshot-data ctx)
+                     (assoc-in [:pages-index pointer-page-id] (pmap/create pointer-id {})))
+        file     (assoc (get-file file-id) :data data)
+        snapshot (fsnap/create! th/*system* file {:profile-id profile-id})
+        ctx      (assoc ctx :snapshot-id (:id snapshot))]
+    (run-compaction ctx)
+    (let [data (snapshot-data ctx)
+          page (get-in data [:pages-index pointer-page-id])]
+      (t/is (not (fdata/has-objects-map? data)))
+      (t/is (map? (get-in data [:pages-index page-id :objects])))
+      (t/is (pmap/pointer-map? page))
+      (t/is (= pointer-id (pmap/get-id page))))))
+
+(t/deftest compaction-with-storage-backend
+  (binding [cf/config (assoc cf/config :file-data-backend "storage")]
+    (let [ctx     (create-edited-file)
+          before  (snapshot-row ctx)
+          old-ref (-> before :metadata fdata/decode-metadata :storage-ref-id)
+          storage (sto/resolve th/*system*)
+          data    (fn [row]
+                    (->> (-> row :metadata fdata/decode-metadata :storage-ref-id)
+                         (sto/get-object storage)
+                         (sto/get-object-bytes storage)
+                         (blob/decode)))]
+      (t/is (= "storage" (:backend before)))
+      (t/is (fdata/has-objects-map? (data before)))
+
+      (run-compaction ctx)
+
+      (let [after   (snapshot-row ctx)
+            new-ref (-> after :metadata fdata/decode-metadata :storage-ref-id)]
+        (t/is (= "storage" (:backend after)))
+        (t/is (not= old-ref new-ref))
+        (t/is (= (fdata/process-objects (data before) (partial into {}))
+                 (data after)))
+        (t/testing "the replaced object is left for the storage gc"
+          (t/is (some? (:touched-at (th/db-get :storage-object {:id old-ref})))))))))
+
+(t/deftest snapshot-before-compaction-can-be-previewed-and-restored
+  (let [{:keys [profile-id file-id page-id rect-id snapshot-id]} (create-edited-file)]
+
+    (t/testing "preview"
+      (let [out (th/command! {::th/type :get-file-snapshot
+                              ::rpc/profile-id profile-id
+                              :file-id file-id
+                              :id snapshot-id})]
+        (t/is (nil? (:error out)))
+        (t/is (contains? (-> out :result :data :pages-index (get page-id) :objects) uuid/zero))
+        (t/is (not (contains? (-> out :result :data :pages-index (get page-id) :objects) rect-id)))))
+
+    (t/testing "restore"
+      (let [out (th/command! {::th/type :restore-file-snapshot
+                              ::rpc/profile-id profile-id
+                              :file-id file-id
+                              :id snapshot-id})
+            objects (-> (th/command! {::th/type :get-file
+                                      ::rpc/profile-id profile-id
+                                      :id file-id})
+                        :result :data :pages-index (get page-id) :objects)]
+        (t/is (nil? (:error out)))
+        (t/is (contains? objects uuid/zero))
+        (t/is (not (contains? objects rect-id)))))))
+
+(t/deftest pointer-map-file-snapshot-resolves-pointers-and-is-compacted-later
+  (let [{:keys [page-id rect-id] :as ctx} (create-edited-file :pointer-map? true)
+        data (snapshot-data ctx)]
+    (t/is (uuid? (:snapshot-id ctx)))
+    (t/is (empty? (fdata/get-used-pointer-ids data)))
+    (t/is (fdata/has-objects-map? data))
+    (t/is (not (contains? (get-in data [:pages-index page-id :objects]) rect-id)))
+    (t/is (= 1 (count (compaction-tasks))))
+    (th/run-pending-tasks!)
+    (t/is (not (fdata/has-objects-map? (snapshot-data ctx))))))
+
+(t/deftest snapshot-without-objects-map-needs-no-compaction
+  (let [profile (th/create-profile* 1 {:is-active true})
+        file    (th/create-file* 1 {:profile-id (:id profile)
+                                    :project-id (:default-project-id profile)
+                                    :is-shared false
+                                    :features (-> (cfeat/get-enabled-features cf/flags)
+                                                  (disj "fdata/objects-map" "fdata/pointer-map"))})]
+    ;; The save enables fdata/objects-map, but the data it snapshots has none
+    (update-file! :file-id (:id file)
+                  :profile-id (:id profile)
+                  :changes [(th/add-rect-change (-> file :data :pages first) (uuid/next))])
+    (t/is (= 1 (count (th/db-query :file-change {:file-id (:id file) :label "internal/snapshot/0"}
+                                   {::db/remove-deleted false}))))
+    (t/is (empty? (compaction-tasks)))))

backend/test/backend_tests/rpc_file_update_test.clj

@@ -11,7 +11,6 @@
    [app.common.files.changes :as cpc]
    [app.common.files.validate :as val]
    [app.common.logging :as l]
-   [app.common.types.shape :as cts]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.msgbus :as mbus]
@@ -38,20 +37,6 @@
      :file-id    (:id file)
      :page-id    (-> file :data :pages first)}))
 
-(defn- add-rect
-  [page-id id]
-  {:type :add-obj
-   :page-id page-id
-   :id id
-   :parent-id uuid/zero
-   :frame-id uuid/zero
-   :obj (cts/setup-shape {:id id
-                          :type :rect
-                          :name "rect"
-                          :x 0 :y 0 :width 10 :height 10
-                          :parent-id uuid/zero
-                          :frame-id uuid/zero})})
-
 (defn- break-parent
   "A change that leaves the shape pointing to a parent that does not exist."
   [page-id id]
@@ -60,6 +45,15 @@
    :id id
    :operations [{:type :set :attr :parent-id :val (uuid/next)}]})
 
+(defn- conflicting-page-change
+  "A change that fails while applied: `:add-page` refuses an id and name
+  together with a page."
+  []
+  {:type :add-page
+   :id (uuid/next)
+   :name "page"
+   :page {:id (uuid/next) :name "page" :objects {}}})
+
 (defn- update-file
   [{:keys [profile-id file-id]} params]
   (th/command! (merge {::th/type :update-file
@@ -101,9 +95,9 @@
   (let [{:keys [page-id] :as ctx} (create-file)
         shape-a (uuid/next)
         shape-c (uuid/next)
-        commit1 (commit (add-rect page-id shape-a))
+        commit1 (commit (th/add-rect-change page-id shape-a))
         commit2 (commit (break-parent page-id shape-a))
-        commit3 (commit (add-rect page-id shape-c))
+        commit3 (commit (th/add-rect-change page-id shape-c))
 
         {:keys [out messages]}
         (capture-messages
@@ -137,9 +131,9 @@
 (t/deftest saves-nothing-when-the-first-commit-is-invalid
   (let [{:keys [page-id] :as ctx} (create-file)
         shape-a (uuid/next)
-        _       (update-file ctx {:changes [(add-rect page-id shape-a)]})
+        _       (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
         commit1 (commit (break-parent page-id shape-a))
-        commit2 (commit (add-rect page-id (uuid/next)))
+        commit2 (commit (th/add-rect-change page-id (uuid/next)))
 
         {:keys [out messages]}
         (capture-messages
@@ -155,12 +149,8 @@
 (t/deftest rejects-a-commit-that-throws-while-applied
   (let [{:keys [page-id] :as ctx} (create-file)
         shape-a (uuid/next)
-        commit1 (commit (add-rect page-id shape-a))
-        ;; `:add-page` refuses an id+name and a page at once
-        commit2 (commit {:type :add-page
-                         :id (uuid/next)
-                         :name "page"
-                         :page {:id (uuid/next) :name "page" :objects {}}})
+        commit1 (commit (th/add-rect-change page-id shape-a))
+        commit2 (commit (conflicting-page-change))
         out     (update-file ctx {:changes-with-metadata [commit1 commit2]})]
 
     (t/is (nil? (:error out)))
@@ -172,12 +162,12 @@
   (let [{:keys [page-id] :as ctx} (create-file)
         shape-a  (uuid/next)
         shape-c  (uuid/next)
-        commit1  (commit (add-rect page-id shape-a))
+        commit1  (commit (th/add-rect-change page-id shape-a))
         commit2  (commit {:type :mod-obj
                           :page-id page-id
                           :id shape-a
                           :operations [{:type :set :attr :name :val "schema-breaker"}]})
-        commit3  (commit (add-rect page-id shape-c))
+        commit3  (commit (th/add-rect-change page-id shape-c))
         validate val/validate-file-schema-affected!
         ;; Changes and shapes are schema checked while applied, so no real
         ;; change reaches the file schema check invalid: one is simulated
@@ -199,8 +189,8 @@
 
 (t/deftest saves-every-commit-when-all-are-valid
   (let [{:keys [page-id] :as ctx} (create-file)
-        out (update-file ctx {:changes-with-metadata [(commit (add-rect page-id (uuid/next)))
-                                                      (commit (add-rect page-id (uuid/next)))]})]
+        out (update-file ctx {:changes-with-metadata [(commit (th/add-rect-change page-id (uuid/next)))
+                                                      (commit (th/add-rect-change page-id (uuid/next)))]})]
     (t/is (nil? (:error out)))
     (t/is (nil? (-> out :result :rejected)))
     (t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
@@ -208,7 +198,7 @@
 (t/deftest flat-changes-stay-all-or-nothing
   (let [{:keys [page-id] :as ctx} (create-file)
         shape-a (uuid/next)
-        out     (update-file ctx {:changes [(add-rect page-id shape-a)
+        out     (update-file ctx {:changes [(th/add-rect-change page-id shape-a)
                                             (break-parent page-id shape-a)]})]
     (t/is (= :validation (th/ex-type (:error out))))
     (t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
@@ -217,31 +207,27 @@
   (let [{:keys [page-id] :as ctx} (create-file)
         shape-a (uuid/next)
         out     (update-file ctx {:changes-with-metadata
-                                  [{:changes [(add-rect page-id shape-a)]}
+                                  [{:changes [(th/add-rect-change page-id shape-a)]}
                                    {:changes [(break-parent page-id shape-a)]}]})]
     (t/is (= :validation (th/ex-type (:error out))))
     (t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
 
 (t/deftest database-failures-fail-the-whole-request
   (let [{:keys [page-id] :as ctx} (create-file)
-        process cpc/process-changes
-        calls   (atom 0)
-        out     (with-redefs [cpc/process-changes
-                              (fn [& args]
-                                ;; The first call is the single pass over
-                                ;; every commit; the database fails on the
-                                ;; first attempt of the retry. The 3-arity
-                                ;; call is the same pass.
-                                (when (and (= 2 (count args))
-                                           (= 2 (swap! calls inc)))
-                                  (throw (java.sql.SQLException. "connection lost")))
-                                (apply process args))]
-                  (update-file ctx {:changes-with-metadata
-                                    [(commit (add-rect page-id (uuid/next)))
-                                     (commit {:type :add-page
-                                              :id (uuid/next)
-                                              :name "page"
-                                              :page {:id (uuid/next) :name "page" :objects {}}})]}))]
+        conflict (conflicting-page-change)
+        process  cpc/process-changes
+        out      (with-redefs [cpc/process-changes
+                               (fn [data changes & args]
+                                 ;; The database fails on every attempt that
+                                 ;; leaves the conflicting commit out: the
+                                 ;; retries, never the pass over every commit
+                                 (when (and (seq changes)
+                                            (not-any? #{conflict} changes))
+                                   (throw (java.sql.SQLException. "connection lost")))
+                                 (apply process data changes args))]
+                   (update-file ctx {:changes-with-metadata
+                                     [(commit (th/add-rect-change page-id (uuid/next)))
+                                      (commit conflict)]}))]
     (t/is (instance? java.sql.SQLException (:error out)))
     (t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
 
@@ -252,70 +238,6 @@
    :id id
    :operations [{:type :set :attr :x :val x}]})
 
-(defn- update-file-counting
-  "Updates the file and counts the times the changes are applied."
-  [ctx params]
-  (let [process cpc/process-changes
-        calls   (atom 0)
-        out     (with-redefs [cpc/process-changes
-                              (fn [& args]
-                                ;; The 3-arity call is the same application
-                                (when (= 2 (count args))
-                                  (swap! calls inc))
-                                (apply process args))]
-                  (update-file ctx params))]
-    {:out out :calls @calls}))
-
-(t/deftest bisects-the-commits-to-find-the-invalid-one
-  (let [{:keys [page-id] :as ctx} (create-file)
-        shape-a (uuid/next)
-        _       (update-file ctx {:changes [(add-rect page-id shape-a)]})
-        commits (mapv (fn [i]
-                        (if (= i 5)
-                          (commit (break-parent page-id shape-a))
-                          (commit (move-rect page-id shape-a i))))
-                      (range 16))
-
-        {:keys [out calls]}
-        (update-file-counting ctx {:revn 1 :changes-with-metadata commits})]
-
-    (t/is (nil? (:error out)))
-    (t/is (= (mapv :commit-id (subvec commits 5))
-             (-> out :result :rejected :commit-ids)))
-    (t/is (= (:commit-id (nth commits 5))
-             (-> out :result :rejected :failed-commit-id)))
-    (t/is (= :referential-integrity (-> out :result :rejected :error :code)))
-
-    (t/testing "the single pass plus log2 of the commits attempts"
-      (t/is (= 5 calls)))
-
-    (t/testing "the file holds the commits before the invalid one"
-      (let [objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
-        (t/is (= uuid/zero (get-in objects [shape-a :parent-id])))
-        (t/is (= 4 (get-in objects [shape-a :x])))))))
-
-(t/deftest rejects-a-single-commit-without-a-retry
-  (let [{:keys [page-id] :as ctx} (create-file)
-        shape-a (uuid/next)
-        _       (update-file ctx {:changes [(add-rect page-id shape-a)]})
-        commit1 (commit (break-parent page-id shape-a))
-
-        {:keys [out calls]}
-        (update-file-counting ctx {:revn 1 :changes-with-metadata [commit1]})]
-
-    (t/is (nil? (:error out)))
-    (t/is (= [(:commit-id commit1)] (-> out :result :rejected :commit-ids)))
-    (t/is (= :referential-integrity (-> out :result :rejected :error :code)))
-    (t/is (= 1 calls))
-    (t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
-
-(defn- rename-rect
-  [page-id id name]
-  {:type :mod-obj
-   :page-id page-id
-   :id id
-   :operations [{:type :set :attr :name :val name}]})
-
 (defn- wait-for-record
   "The first log record whose message hint is `hint`, waiting up to two
   seconds for the asynchronous logger to write it."
@@ -329,19 +251,80 @@
         (Thread/sleep 10)
         (recur (inc tries))))))
 
-(t/deftest keeps-fifty-commits-before-the-invalid-one
-  (let [{:keys [page-id] :as ctx} (create-file)
-        shape-a (uuid/next)
-        _       (update-file ctx {:changes [(add-rect page-id shape-a)]})
-        renames (mapv #(commit (rename-rect page-id shape-a (str "name " %))) (range 50))
-        invalid (commit (break-parent page-id shape-a))
-        records (atom [])
+(defn- update-file-logged
+  "Updates the file and returns the response in `:out` and, in `:rejected`,
+  the props of the log record of the rejection, if any."
+  [ctx params]
+  (let [records (atom [])
         out     (try
                   (add-watch l/log-record ::capture
                              (fn [_ _ _ record] (swap! records conj record)))
-                  (update-file ctx {:revn 1 :changes-with-metadata (conj renames invalid)})
+                  (update-file ctx params)
                   (finally
                     (remove-watch l/log-record ::capture)))]
+    {:out      out
+     :rejected (some-> (wait-for-record records "update-file commit rejected")
+                       ::l/props)}))
+
+(t/deftest bisects-the-commits-to-find-the-invalid-one
+  (let [{:keys [page-id] :as ctx} (create-file)
+        shape-a (uuid/next)
+        _       (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
+        commits (mapv (fn [i]
+                        (if (= i 5)
+                          (commit (break-parent page-id shape-a))
+                          (commit (move-rect page-id shape-a i))))
+                      (range 16))
+
+        {:keys [out rejected]}
+        (update-file-logged ctx {:revn 1 :changes-with-metadata commits})]
+
+    (t/is (nil? (:error out)))
+    (t/is (= (mapv :commit-id (subvec commits 5))
+             (-> out :result :rejected :commit-ids)))
+    (t/is (= (:commit-id (nth commits 5))
+             (-> out :result :rejected :failed-commit-id)))
+    (t/is (= :referential-integrity (-> out :result :rejected :error :code)))
+
+    (t/testing "the search takes log2 of the commits attempts"
+      (t/is (= 4 (:attempts rejected))))
+
+    (t/testing "the file holds the commits before the invalid one"
+      (let [objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
+        (t/is (= uuid/zero (get-in objects [shape-a :parent-id])))
+        (t/is (= 4 (get-in objects [shape-a :x])))))))
+
+(t/deftest rejects-a-single-commit-without-a-retry
+  (let [{:keys [page-id] :as ctx} (create-file)
+        shape-a (uuid/next)
+        _       (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
+        commit1 (commit (break-parent page-id shape-a))
+
+        {:keys [out rejected]}
+        (update-file-logged ctx {:revn 1 :changes-with-metadata [commit1]})]
+
+    (t/is (nil? (:error out)))
+    (t/is (= [(:commit-id commit1)] (-> out :result :rejected :commit-ids)))
+    (t/is (= :referential-integrity (-> out :result :rejected :error :code)))
+    (t/is (= 0 (:attempts rejected)) "no retry")
+    (t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
+
+(defn- rename-rect
+  [page-id id name]
+  {:type :mod-obj
+   :page-id page-id
+   :id id
+   :operations [{:type :set :attr :name :val name}]})
+
+(t/deftest keeps-fifty-commits-before-the-invalid-one
+  (let [{:keys [page-id] :as ctx} (create-file)
+        shape-a (uuid/next)
+        _       (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
+        renames (mapv #(commit (rename-rect page-id shape-a (str "name " %))) (range 50))
+        invalid (commit (break-parent page-id shape-a))
+
+        {:keys [out rejected]}
+        (update-file-logged ctx {:revn 1 :changes-with-metadata (conj renames invalid)})]
 
     (t/is (nil? (:error out)))
     (t/is (= [(:commit-id invalid)] (-> out :result :rejected :commit-ids)))
@@ -358,22 +341,20 @@
                  (:changes (last rows))))))
 
     (t/testing "the search takes log2 of the commits attempts"
-      (let [record (wait-for-record records "update-file commit rejected")]
-        (t/is (some? record))
-        (t/is (= 51 (get-in record [::l/props :commits])))
-        (t/is (= 6 (get-in record [::l/props :attempts])))))))
+      (t/is (= 51 (:commits rejected)))
+      (t/is (= 6 (:attempts rejected))))))
 
 (t/deftest keeps-a-commit-that-repairs-an-earlier-one
   (let [{:keys [page-id] :as ctx} (create-file)
         shape-a (uuid/next)
         shape-c (uuid/next)
-        _       (update-file ctx {:changes [(add-rect page-id shape-a)]})
+        _       (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
         commit1 (commit (break-parent page-id shape-a))
         commit2 (commit {:type :mod-obj
                          :page-id page-id
                          :id shape-a
                          :operations [{:type :set :attr :parent-id :val uuid/zero}]})
-        commit3 (commit (add-rect page-id shape-c))
+        commit3 (commit (th/add-rect-change page-id shape-c))
         commit4 (commit (break-parent page-id shape-c))
         out     (update-file ctx {:revn 1 :changes-with-metadata [commit1 commit2 commit3 commit4]})
         objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
@@ -400,9 +381,9 @@
 (t/deftest a-debug-fault-rejects-its-commit
   (let [{:keys [page-id] :as ctx} (create-file)
         shape-a (uuid/next)
-        commit1 (commit (add-rect page-id shape-a))
+        commit1 (commit (th/add-rect-change page-id shape-a))
         commit2 (commit (debug-fault "runtime"))
-        commit3 (commit (add-rect page-id (uuid/next)))
+        commit3 (commit (th/add-rect-change page-id (uuid/next)))
         out     (with-debug-faults
                   #(update-file ctx {:changes-with-metadata [commit1 commit2 commit3]}))
         objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
@@ -417,7 +398,7 @@
   (let [{:keys [page-id] :as ctx} (create-file)
         out (with-debug-faults
               #(update-file ctx {:changes-with-metadata
-                                 [(commit (add-rect page-id (uuid/next)))
+                                 [(commit (th/add-rect-change page-id (uuid/next)))
                                   (commit (debug-fault "validation"))]}))]
     (t/is (= :validation (-> out :result :rejected :error :type)))))
 
@@ -425,7 +406,7 @@
   (let [{:keys [page-id] :as ctx} (create-file)
         out (with-debug-faults
               #(update-file ctx {:changes-with-metadata
-                                 [(commit (add-rect page-id (uuid/next)))
+                                 [(commit (th/add-rect-change page-id (uuid/next)))
                                   (commit (debug-fault "sql"))]}))]
     (t/is (instance? java.sql.SQLException (:error out)))
     (t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
@@ -433,7 +414,7 @@
 (t/deftest debug-faults-need-the-flag
   (let [{:keys [page-id] :as ctx} (create-file)
         out (update-file ctx {:changes-with-metadata
-                              [(commit (add-rect page-id (uuid/next)))
+                              [(commit (th/add-rect-change page-id (uuid/next)))
                                (commit (debug-fault "runtime"))]})]
     (t/is (nil? (:error out)))
     (t/is (nil? (-> out :result :rejected)))
@@ -444,7 +425,7 @@
   (let [{:keys [page-id] :as ctx} (create-file)
         out (with-debug-faults
               #(update-file ctx {:changes-with-metadata
-                                 [(commit (add-rect page-id (uuid/next)))
+                                 [(commit (th/add-rect-change page-id (uuid/next)))
                                   (commit (debug-fault "ex-info"))]}))
         error (-> out :result :rejected :error)]
     (t/is (= :internal (:type error)))
@@ -470,7 +451,7 @@
 (defn- add-image-rect
   "A rect filled with the image of `mobj`."
   [page-id id mobj]
-  (assoc-in (add-rect page-id id)
+  (assoc-in (th/add-rect-change page-id id)
             [:obj :fills]
             [{:fill-opacity 1
               :fill-image {:id (:id mobj) :width 100 :height 100 :mtype "image/jpeg"}}]))
@@ -485,7 +466,7 @@
         mobj    (upload-image profile-id (:id other))
         shape-a (uuid/next)
         shape-b (uuid/next)
-        commit1 (commit (add-rect page-id shape-a))
+        commit1 (commit (th/add-rect-change page-id shape-a))
         commit2 (commit (add-image-rect page-id shape-b mobj)
                         (break-parent page-id shape-a))
         out     (update-file ctx {:changes-with-metadata [commit1 commit2]})]