github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-11-03 00:20:41 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Stabilize fragmented file data across snapshots and GC (#12420)

Browse Source 
* ✨ Stabilize fragmented file data across snapshots and GC

Snapshots, automatic and user, now store pointer-based rows that share
fragments with the live file instead of duplicating page content.
`get-file-snapshot` resolves those pointers on the server so version
previews keep rendering plain data, and `restore!` reuses the shared
rows. Export still materializes (the package carries no fragments) and
import regenerates them.

`file-gc` treats the main file and every unpurged snapshot as liveness
roots, reads the file unrealized, and reattaches the original pointer
wherever the cleaned value is unchanged, so a pass over an untouched
file writes no fragments and a pass over an edited file keeps the ids
of the pages it did not touch. Snapshot creation and the restore
backup take the file row `FOR SHARE`, which serializes them with the
pass and closes the race that let a new snapshot reference fragments
the pass was about to mark.

All backend pointer bindings go through the `fdata/with-pointers`,
`with-tracked`, `with-tracked-pointers` and `with-untracked` macros.
The loader reads fragments a previous pass marked until `objects-gc`
purges them, and the frontend fails loudly with retry instead of
dropping an unresolved fragment.

Review fixes in this branch: the automatic snapshot attaches before
pending migrations, `realize-pointers` is the single verb,
`reattach-unchanged` takes the identity fast path, the restore guard
takes its revn from the backup read, and `PointerMap.withMeta`
generates a fresh id when metadata changes.

Tests cover both snapshot writers (red without the lock), snapshot
sharing and pin release through the real delete and purge paths,
reattach against orphan marking, preview after offload, the pointer
binding contracts and the with-meta id change.

Closes #12410

AI-assisted-by: muse-spark-1.3-contributor
AI-assisted-by: deepseek-v4.1-flash

♻️ Pin no-churn behavior for untouched pages

Pin the behavior the churn verification measured: a save keeps the
fragment id of every page it does not touch, with a page of eleven keys
(PersistentHashMap), a 46-shape objects map and a nine-page index (hash
map). Also pin the mixed case: a data-level objects-map flip rewrites
the old pointer pages once and the next save keeps the new ids.

The memory records the identity rule behind it: re-assoc with the same
value returns the same map in array and hash maps alike.

Closes #12410

AI-assisted-by: deepseek-v4.1-flash

⚡ Stop loading untouched pages when enabling objects-map

`enable-objects-map` wrapped every page on every save, and reading a
page's objects forced its PointerMap to load the fragment. A save of
one page in a seven-page file therefore made seven fragment reads.

Skip unloaded pointers: their fragment was already wrapped by the
encode-file that wrote it, so loading it only to wrap it again is a
no-op. The save now loads only the pages it edits. A page with a plain
fragment (a data-level feature flip) keeps its plain fragment until it
is first loaded or edited; a migration that enables the feature must
rewrite the data itself.

Cover the change with load-count tests for save and restore, update the
flip test to the new contract, and drop the stale restore comment.

Closes #12410

AI-assisted-by: deepseek-v4.1-flash

⚡ Keep page fragment ids through pending migrations

Applying a pending migration on read realized the file, ran the
migration and persisted it again; the persist wrapped every plain page
in a new PointerMap, so every page got a new fragment id even when the
migration did not change it. That leaves the fragment cache cold and
rewrites every fragment on the first read after a deploy.

Capture the original pointers before realizing, reattach the unchanged
positions after migrating (same value comparison file-gc already uses),
persist the reattached file and return the realized one: the read
contract is plain data. Read-only connections skip the persist and the
reattach. A migration that adds objects-map skips the reattach so the
pages get wrapped.

Move the three helpers to fdata so file-gc and the migration path share
them, and cover the path with a real 0031 migration test: the unchanged
page keeps its id, the changed page gets a new one, the caller gets
realized data and a second read does not migrate again.

Closes #12410

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Realize library pointers with each library's own loader

Fragment rows are keyed by file id, and every caller binds the
fragment loader of the file it works on. get-resolved-file-libraries
returned libraries with their pages still as pointers, so the first
read of a library page under fdata/pointer-map asked the consuming
file for the fragment and failed with :fragment-not-found. That
broke migrations and file validation for every file using a
pointer-mapped library.

The weak-map loader now realizes each library's pointers with the
library's own id. The test fails without the change.

AI-assisted-by: claude-opus-5-5
Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>

* 🐛 Restore the pointer-map require the repair path still needs

The branch dropped `app.util.pointer-map` from the namespace while the
auto-repair path (added to develop before this branch) still rebinds
`pmap/*tracked*` around validation and repair in
`repair-preexisting-damage` and `process-changes-and-validate`. The
namespace did not compile, so the whole backend failed to load.

Those toggles do not fit the fdata macros: `with-untracked` binds nil
and `with-tracked` creates a fresh atom, while the repair path has to
turn tracking off and restore the existing atom (and read it before the
repair starts). Restore the require and keep the bindings explicit.

Also pin the feature-off path with a test: with `fdata/pointer-map` off
(the default), a save creates no fragments, file-gc writes nothing and
the snapshot preview still returns plain data. Drop a stray `\n` char
literal left at the end of one deftest.

Update the memories with the exception to the macro rule, the snapshot
FOR SHARE locking and the pre-migration automatic snapshot.

Closes #12410

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Validate debug files with their own pointer loader

The `/dbg/actions` file validation passed the file id where
`get-resolved-file-libraries` expects the file map, so the library map
was seeded with a nil key. It also validated a file read without
realizing it, so the first page lookup of a pointer-mapped file raised
"load is not supported when *load-fn* is not bind" and the endpoint
could not validate exactly the files the feature touches.

Read the file realized (validation walks every page and component
anyway) and build the library map from the file. The library loader
already resolves each library's pointers with its own id, so the
realized file and its libraries validate as plain data. Covered by a
handler-level test that fails before the change.

AI-assisted-by: deepseek-v4.1-flash

* ♻️ Bind the snapshot loader through the fdata helper

`reduce-snapshots` hand-rolled the same `binding` that
`fdata/with-pointers` builds (it also loaded the function's own
pointer loader before entering the reduction). Use the macro so the
rule holds there too and the namespace no longer needs
`app.util.pointer-map`; the loader is identical (same cfg and file-id)
and snapshot walking behaves the same.

AI-assisted-by: deepseek-v4.1-flash

* 📚 Note the pointer-binding exceptions and snapshot ordering

Record what the feature review settled:

- Two direct `binding`s stay on purpose: the fine-grained `*tracked*`
  toggles of `app.rpc.commands.files-update` (validation/repair turn
  tracking off and restore the existing atom) and
  `binfile.common/encode-file` (fresh tracked set inheriting the
  current one). Atom-scoped macros would only be worth it if the set
  grows.
- The automatic snapshot is taken before the pending migration, and
  the pre-migration window is narrow: the `get-file` RPC migrates on
  read and its ETag hashes the available migrations, so a post-deploy
  read cannot be a 304 from the pre-deploy state. The old-format
  snapshot only appears when the save is the first request to touch
  the file after the deploy, and `get-file-snapshot` previews it as
  stored.

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Apply pending migrations when previewing a version

Automatic snapshots are attached before the save applies pending file
migrations, so a version can store the old format. The preview RPC
handed that data to the UI as stored, and the viewport renders it with
the current code.

Realize the snapshot with the live file id (fragments are keyed by
file, not by snapshot), normalize its migrations to a set (the decoder
keeps the pgarray as a vector, and `set/difference` would compare
indexes) and apply the pending migrations with the pure
`fmg/migrate-file` and the live libraries. Nothing is persisted: the
stored version keeps its data and restoring it re-migrates on the next
read. The response now carries the snapshot's migrations.

Use `:features` the way `get-file` does for `fdata/objects-map`: a
client that does not declare it gets plain objects. The historical
feature set is not checked against the enabled one on purpose: a
version may predate a feature change.

Cover the preview of a snapshot with a pending migration and the
objects realization; both pin that the stored row is untouched. Update
the file-data memory with the preview contract and the vector/set
trap.

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Decode snapshot migrations as an ordered set

`file-snapshots/decode-snapshot` handed the `file_change.migrations`
pgarray as a vector. `set/difference` falls back to index lookups when
the first collection is shorter than the second, so the pending set was
right only by accident: a stored subset happens to work, while a
stored set larger than `available-migrations` (a snapshot taken by a
newer build) marks every available migration as pending and re-applies
it to already migrated data.

Decode it as a `d/ordered-set`, the type the rest of the code and
`schema:file` expect. This also covers `restore!` and the snapshot
list, and it lets `get-file-snapshot` drop the `(into #{} ...)`
normalization it was carrying. Re-wrap the union in `fmg/migrate` so
the invariant holds even when a caller hands a plain set.

A snapshot with NULL `migrations` predates SQL migration 0140 and
keeps the format version of its time. Pin that legacy path: the
preview regenerates the applied set from that version, migrates in
memory and leaves the stored row untouched. Update the file-data
memory with the invariant and the legacy path.

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Fix flaky waiting-gauge assertion in climit test

The throwable-while-waiting test asserted the exact list of
waiting-gauge publications, but the component sampler republishes
the same count when its first tick lands inside the recorded
window under load. Assert only the last value, which is the
contract the helper documents.

AI-assisted-by: muse-spark-1.3

---------

Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
Co-authored-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
This commit is contained in:
Andrey Antukh 2026-11-02 15:02:55 +01:00 committed by GitHub
parent 79aebcca49
commit 93d36d04d8
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
28 changed files with 2232 additions and 203 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -92,7 +92,15 @@
- 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.
- Pointer-map fragments are persisted separately as type `fragment`, and only modified pointer maps are written. A pointer keeps its id while nothing changes; content (`assoc`/`without`) and metadata (`with-meta`) changes produce a fresh id, so a fragment row is never rewritten after it is written. Re-assoc with an identical value returns the same map in array and hash maps alike, so a save keeps the fragment id of every page it does not change.
- `enable-objects-map` skips unloaded pointer pages: their fragment was already wrapped when it was written, and loading it only to wrap it again costs one page read per untouched page on every save. A page with a plain fragment is wrapped when it is first loaded or edited; a data migration that enables `fdata/objects-map` must rewrite the data itself.
- Snapshots share fragment rows with the live file (they are stored with pointers, not materialized). `file-gc` marks every fragment referenced neither by the current main file nor by an unpurged snapshot; the file is read unrealized and unchanged pages keep their ids via reattach, so a pass over an unchanged file writes no new fragments.
- A save attaches its automatic snapshot before applying pending file migrations: the snapshot keeps the pre-migration pointers, data and migration set, and restoring it leaves the next read to migrate the file. This also holds for files without the feature. The preview (`get-file-snapshot`) applies the pending migrations in memory with the live file's libraries and never persists them: the stored version keeps its data, the payload carries the snapshot's `:migrations` (an ordered set) and `fdata/objects-map` is realized for clients that do not declare it. The historical feature set is deliberately not checked against the enabled one: a version may predate a feature change. The window is narrow: the `get-file` RPC reads with `migrate?` on and its ETag hashes `available-migrations`, so a post-deploy read cannot be a 304 from the pre-deploy state and migrates before any save in the normal flow; the pre-migration snapshot only appears when the save is the first request to touch the file after the deploy (an open tab that saves without re-reading, or a non-UI writer). `create-file-snapshot` and the restore backup read with `migrate?` on, so those versions are stored already migrated.
- `:migrations` is always a `d/ordered-set`: `file-migrations/resolve-applied-migrations` builds one, `fmg/migrate` re-wraps the union after applying, and `file-snapshots/decode-snapshot` converts the `file_change` pgarray (as a plain vector, `set/difference` and `contains?` would compare indexes instead of names). A snapshot with NULL `:migrations` and an old `:version` predates the `file_change.migrations` column (SQL migration 0140): the preview regenerates the set from the stored version and applies that full chain, while `restore!` uses a fixed 67 baseline, so preview and restore can disagree for very old snapshots.
- The migration read path (`binfile.common/migrate-file`) captures `fdata/original-pointers` before realizing, reattaches unchanged positions after applying the migrations, and persists the reattached file; it returns the realized file because reads expose plain data. A migration that adds `fdata/objects-map` skips the reattach so the pages get wrapped.
- `fdata/load-pointer` reads rows that a previous `file-gc` pass marked on purpose (explicit `::db/remove-deleted false`): the fragment is only gone once `objects-gc` purges it. The `get-file-fragment` RPC keeps rejecting marked rows.
- Bind the fragment loader through `fdata/with-pointers` (reads), `fdata/with-tracked-pointers` (writes with a loader) or `fdata/with-tracked` (writes with nothing to load yet, e.g. file creation), and `fdata/with-untracked` (validation passes that must track nothing) instead of hand-rolled `binding` forms. Two direct bindings remain on purpose: the fine-grained tracked toggles of `app.rpc.commands.files-update` (validation/repair turn tracking off, restore the existing atom and read it before repairing), and `binfile.common/encode-file` (a fresh tracked set inheriting the current one). Converge them only if atom-scoped macros (`with-tracking`, `with-inherited-tracking`) are added; today the extra indirection buys nothing.
- Snapshot creation takes `FOR SHARE` on the file row: both `create-file-snapshot` and the backup read of `restore-file-snapshot` hold it from the read to the insert, so they serialize with a `file-gc` pass (`FOR UPDATE ... SKIP LOCKED`) instead of pinning fragments the pass is about to mark. `get-file-snapshot` realizes the snapshot pointers with the live file id (fragment rows are keyed by file, not by snapshot).
- `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.

2
.serena/memories/frontend/dashboard-viewer-subtleties.md
View File

@ -13,6 +13,6 @@
- `app.main.ui.ui` parses the viewer's `file-id` query param with `uuid/parse*`, so a missing or malformed id arrives as nil. `viewer-page*` calls `check-file-id!` (same namespace) during render, before mounting `viewer*`: it raises `ex/raise :type :not-found :code :missing-file-id`, which the error boundary turns into the not-found page. Without the guard the `dv/initialize` assertion fails on the nil file-id and the user gets an internal-error page. Test: `frontend-tests.ui.viewer-test/check-file-id-raises-not-found-for-invalid-file-id`.
- Viewer initialization sets `:current-file-id`, `:current-share-id`, and `:viewer-local`, then fetches the view-only bundle. Comment threads are fetched only for logged-in users.
- Viewer bundle fetch sends the full supported feature set because anonymous shared viewers may not know team-enabled features.
- View-only bundles can contain pointer values in `:pages-index` and file data. Viewer resolves those fragments with `:get-file-fragment` before storing the bundle.
- View-only bundles can contain pointer values in `:pages-index` and file data. Viewer resolves those fragments with `:get-file-fragment` before storing the bundle, through `app.main.features.pointer-map/resolve-pointer` (share-link scoped; the workspace and library loaders use `resolve-file`, which resolves the same two levels). Both fail loudly: a fragment that cannot be resolved rejects the stream and is logged with file id and fragment id instead of silently dropping the page.
- `bundle-fetched` indexes pages and precomputes viewer frames/all-frames, stores libraries/users/thumbnails/permissions under `:viewer`, then navigates to frame id, query index, or auto-selected frame.
- Viewer zoom and interaction mode changes update both `:viewer-local` and the `:viewer` route query params. `update-zoom-querystring` guards with a query-param comparison (`not= current expected`) and uses `::rt/replace`; without that guard the load sequence (`bundle-fetched` → `zoom-to-fill` → `update-zoom-querystring` → `rt/nav`) re-runs on every navigation and crashes with React "maximum update depth exceeded" (2.18.0-RC5 regression, fixed in `31b73460c3`; regression test: `bundle-fetched-with-zoom-fill-url-does-not-navigate`).

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

@ -239,24 +239,30 @@
(defn- migrate-file
[{:keys [::db/conn] :as cfg} {:keys [read-only?]} {:keys [id] :as file}]
(binding [pmap/*load-fn* (partial fdata/load-pointer cfg id)
pmap/*tracked* (pmap/create-tracked)]
(let [libs (delay (get-resolved-file-libraries cfg file))
;; For avoid unnecesary overhead of creating multiple
;; pointers and handly internally with objects map in their
;; worst case (when probably all shapes and all pointers
;; will be readed in any case), we just realize/resolve them
;; before applying the migration to the file.
file (-> (fdata/realize cfg file)
(fmg/migrate-file libs))]
(fdata/with-tracked-pointers cfg id
(let [libs (delay (get-resolved-file-libraries cfg file))
;; Capture the pointer layout before realizing: the migration
;; runs on plain data, and unchanged positions must keep their
;; original fragment ids instead of being re-wrapped with new
;; ones on persist.
original (fdata/original-pointers (:data file))
objects-map-before? (contains? (:features file) "fdata/objects-map")
realized (-> (fdata/realize cfg file)
(fmg/migrate-file libs))
objects-map-added? (and (not objects-map-before?)
(contains? (:features realized) "fdata/objects-map"))]
(if (or read-only? (db/read-only? conn))
file
(do ;; When file is migrated, we break the rule of no
;; perform mutations on get operations and update the
;; file with all migrations applied
realized
(let [file (if objects-map-added?
realized
(fdata/reattach-unchanged original realized))]
;; When the file is migrated, we break the rule of not
;; performing mutations on get operations and update the file
;; with all migrations applied. The caller still receives the
;; realized file: the read contract is plain data.
(update-file! cfg file)
(fmigr/resolve-applied-migrations cfg file))))))
(fmigr/resolve-applied-migrations cfg realized))))))
(defn- get-file*
[{:keys [::db/conn] :as cfg} id
@ -281,7 +287,7 @@
(assert (db/connection? conn) "expected cfg with valid connection")
(when (and (not load-data?)
(or lock-for-share? lock-for-share? skip-locked?))
(or lock-for-share? lock-for-update? skip-locked?))
(throw (IllegalArgumentException. "locking is incompatible when `load-data?` is false")))
(let [sql
@ -944,7 +950,12 @@
(let [library-ids (->> (get-file-libraries conn (:id file))
(map :id)
(cons (:id file)))
load-fn #(get-file cfg % :migrate? false)]
;; Fragment rows are file-local and callers bind the loader of
;; the file they work on, so each library realizes its pointers
;; here, with its own id, before anything walks its data.
load-fn (fn [library-id]
(->> (get-file cfg library-id :migrate? false)
(fdata/realize-pointers cfg)))]
(weak/loadable-weak-value-map library-ids load-fn {id file})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

116
backend/src/app/features/fdata.clj
View File

@ -51,10 +51,19 @@
(update file :data process-objects (partial into {})))
(defn enable-objects-map
"Ensure every page holds an ObjectsMap. Unloaded pointers are left
untouched: the fragment they point to was written by an `encode-file`
that already wrapped its objects, and loading it only to wrap it again
costs one page read per untouched page on every save. A page whose
fragment predates the feature is wrapped when it is first loaded or
edited; a data migration that enables the feature must rewrite the
data itself."
[file & _opts]
(let [update-page
(fn [page]
(update page :objects omap/wrap))
(if (and (pmap/pointer-map? page) (not (pmap/loaded? page)))
page
(update page :objects omap/wrap)))
update-data
(fn [fdata]
@ -264,9 +273,13 @@
(defn load-pointer
"A database loader pointer helper"
[cfg file-id id]
;; Keep the include-marked behavior explicit: `db/get*` only filters
;; rows by `deleted_at` when that column is selected, and a fragment a
;; previous pass marked must still load until `objects-gc` purges it.
(let [fragment (some-> (db/get* cfg :file-data
{:id id :file-id file-id :type "fragment"}
{::sql/columns [:data :backend :id :metadata]})
{::sql/columns [:data :backend :id :metadata]
::db/remove-deleted false})
(update :metadata decode-metadata))]
(l/trc :hint "load pointer"
@ -297,6 +310,40 @@
:type "fragment"
:data content})))))
(defmacro with-pointers
"Bind the fragment loader for `file-id` around `body`. All pointer
derefs must happen inside the body; a pointer derefed outside of it
raises because there is no loader bound."
[cfg file-id & body]
`(binding [pmap/*load-fn* (partial load-pointer ~cfg ~file-id)]
~@body))
(defmacro with-tracked
"Bind a fresh tracked set around `body`, without a fragment loader.
For write paths that create pointers before any file exists to load
from (e.g. file creation): wrapping tracks new pointers for
persistence, while any deref still fails loudly."
[& body]
`(binding [pmap/*tracked* (pmap/create-tracked)]
~@body))
(defmacro with-untracked
"Run `body` with pointer tracking disabled. For validation passes
that must not track anything for persistence: pointers created
inside are not collected, and derefs still go through the bound
loader when there is one."
[& body]
`(binding [pmap/*tracked* nil]
~@body))
(defmacro with-tracked-pointers
"Bind a fresh tracked set plus the fragment loader for `file-id`
around `body`. For write paths that create or modify pointers."
[cfg file-id & body]
`(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial load-pointer ~cfg ~file-id)]
~@body))
(defn process-pointers
"Apply a function to all pointers on the file. Usuly used for
dereference the pointer to a plain value before some processing."
@ -311,14 +358,20 @@
(defn realize-pointers
"Process a file and remove all instances of pointers realizing them to
a plain data. Used in operation where is more efficient have the
whole file loaded in memory."
[cfg {:keys [id] :as file}]
(binding [pmap/*load-fn* (partial load-pointer cfg id)]
(update file :data process-pointers deref)))
plain data. Accepts a file map (arity 1) or raw file data with its
file id (arity 2): a snapshot map carries the snapshot id, so always
pass the live file id explicitly."
([cfg {:keys [id] :as file}]
(update file :data #(realize-pointers cfg id %)))
([cfg file-id data]
(with-pointers cfg file-id
(process-pointers data deref))))
(defn get-used-pointer-ids
"Given a file, return all pointer ids used in the data."
"Given a file data map, return all pointer ids used in the data.
This is a plain readout with no liveness meaning of its own: file-gc
unions it over the main file and every unpurged snapshot (see
`app.tasks.file-gc/clean-fragments!` for the actual liveness rule)."
[fdata]
(->> (concat (vals fdata)
(vals (:pages-index fdata)))
@ -345,3 +398,50 @@
(->> file
(realize-pointers cfg)
(realize-objects cfg)))
(defn realize-entry
"Realize a file data entry (a page or the components map) to plain
data for value comparison: deref pointers and convert objects-maps
with the same `into {}` production uses. Requires *load-fn* bound."
[entry]
(let [entry (if (pmap/pointer-map? entry) (deref entry) entry)]
(if (and (map? entry) (contains? entry :objects))
(let [objects (:objects entry)]
(assoc entry :objects (if (omap/objects-map? objects)
(into {} objects)
objects)))
entry)))
(defn original-pointers
"Snapshot the current pointer layout of file data, mapping each
pointer position to its PointerMap. No loading involved."
[fdata]
{:root (into {} (filter (fn [[_ v]] (pmap/pointer-map? v))) fdata)
:pages (into {} (filter (fn [[_ v]] (pmap/pointer-map? v)))
(:pages-index fdata {}))})
(defn reattach-unchanged
"Put back the original fragment pointers wherever the current value
is value-equal to the stored fragment, so unchanged positions keep
their ids and no new fragment rows are persisted for them. `current`
may be a PointerMap (file-gc) or a plain page (the migration read
path); `orig` always comes from `original-pointers`. Anything added,
removed or actually changed keeps the current value. Requires
*load-fn* bound."
[{:keys [root pages]} file]
(letfn [(reattach [current orig]
(if (or (identical? current orig)
(= (realize-entry current) (realize-entry orig)))
orig
current))
(reattach-all [m origs]
(reduce-kv (fn [m k orig]
(if (contains? m k)
(update m k reattach orig)
m))
m origs))]
(update file :data (fn [data]
(cond-> (reattach-all data root)
(contains? data :pages-index)
(update :pages-index reattach-all pages))))))

31
backend/src/app/features/file_snapshots.clj
View File

@ -48,11 +48,19 @@
AND fd.type = 'snapshot')
WHERE c.label IS NOT NULL")
;; `:migrations` is an ordered set everywhere (see `common.types.file`),
;; and `need-migration?`/`migrate` use set semantics on it: the pgarray
;; must never surface as a vector, where `contains?`/`set/difference`
;; would compare indexes instead of names.
(defn- decode-migrations
[value]
(into (d/ordered-set) (db/decode-pgarray value [])))
(defn- decode-snapshot
[snapshot]
(some-> snapshot
(-> (d/update-when :metadata fdata/decode-metadata)
(d/update-when :migrations db/decode-pgarray [])
(d/update-when :migrations decode-migrations)
(d/update-when :features db/decode-pgarray #{}))))
(def ^:private sql:get-minimal-file
@ -376,8 +384,13 @@
:snapshot-id (str (:id snapshot)))
;; In the same way, on reseting the file data, we need to restore
;; the applied migrations on the moment of taking the snapshot
(bfc/update-file! cfg file ::bfc/reset-migrations? true)
;; the applied migrations on the moment of taking the snapshot.
;; The snapshot data may hold shared pointer-mapped pages; the
;; loader stays bound while persisting so any page the encode
;; path does load keeps working (`enable-objects-map` skips the
;; unloaded ones).
(fdata/with-pointers cfg file-id
(bfc/update-file! cfg file ::bfc/reset-migrations? true))
;; FIXME: this should be separated functions, we should not have
;; inline sql here.
@ -441,7 +454,12 @@
(defn reduce-snapshots
"Process the file snapshots using efficient reduction; the file
reduction comes with all snapshots, including maked as deleted"
reduction comes with all snapshots, including maked as deleted.
Snapshot data may hold pointer-mapped pages, so the fragment loader
is bound while reducing: consumers that walk page content (media
refs, stats) transparently load fragments, consumers that only read
pointer ids never trigger a load."
[cfg file-id xform f init]
(let [conn (db/get-connection cfg)
xform (comp
@ -449,5 +467,6 @@
(map (partial fdata/decode-file-data cfg))
xform)]
(->> (db/plan conn [sql:get-snapshots file-id] {:fetch-size 1})
(transduce xform f init))))
(fdata/with-pointers cfg file-id
(->> (db/plan conn [sql:get-snapshots file-id] {:fetch-size 1})
(transduce xform f init)))))

8
backend/src/app/http/debug.clj
View File

@ -785,8 +785,12 @@
(db/tx-run! (assoc cfg ::db/rollback true)
(fn [cfg]
(let [file (bfc/get-file cfg file-id)
libs (bfc/get-resolved-file-libraries cfg file-id)]
;; Validation walks every page and component, so the
;; file is read realized; the library map is built
;; from the file (not its id) and its own loader
;; resolves each library's pointers.
(let [file (bfc/get-file cfg file-id :realize? true)
libs (bfc/get-resolved-file-libraries cfg file)]
(if file
(let [errors (cfv/validate-file file libs)]
{::yres/status 200

3
backend/src/app/rpc/commands/comments.clj
View File

@ -29,7 +29,6 @@
[app.rpc.doc :as-alias doc]
[app.rpc.quotes :as quotes]
[app.rpc.retry :as rtry]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[clojure.set :as set]
[cuerdas.core :as str]))
@ -170,7 +169,7 @@
(defn- get-file
"A specialized version of get-file for comments module."
[cfg file-id page-id]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
(feat.fdata/with-pointers cfg file-id
(let [file (bfc/get-file cfg file-id)
data (get file :data)]
(-> file

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

@ -431,7 +431,7 @@
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file)))
page (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
page (feat.fdata/with-pointers cfg file-id
(let [page (dm/get-in file [:data :pages-index resolved-page-id])]
(if (pmap/pointer-map? page)
(deref page)
@ -561,7 +561,7 @@
calculate-from-db
(fn []
(let [file (bfc/get-file cfg id)
result (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
result (feat.fdata/with-pointers cfg id
(calculate-library-summary file))]
(-> file
(assoc :library-summary result)
@ -685,7 +685,7 @@
(defn- get-file-stats
[{:keys [::db/conn] :as cfg} file-id]
(let [file (bfc/get-file cfg file-id)
base (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
base (feat.fdata/with-pointers cfg file-id
(cfs/calc-file-stats (:data file)))
lib-cnt (get-file-stats-library-counts conn file-id)]
(-> base
@ -774,7 +774,7 @@
(bfc/check-file-exists cfg file-id)
(check-read-permissions! cfg profile-id file-id)
(let [{:keys [data]} (bfc/get-file cfg file-id)]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
(feat.fdata/with-pointers cfg file-id
(when-let [tokens-lib (cfo/get-tokens-lib data)]
(ctob/export-dtcg-json tokens-lib (cfo/get-tokens-status data))))))
@ -993,8 +993,7 @@
(assert (db/connection-map? cfg)
"expected cfg with valid connection")
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)
pmap/*tracked* (pmap/create-tracked)]
(feat.fdata/with-tracked-pointers cfg file-id
(let [file (-> (bfc/get-file cfg file-id
:include-deleted? true
:lock-for-update? true)

45
backend/src/app/rpc/commands/files_create.clj
View File

@ -14,6 +14,7 @@
[app.common.types.file :as ctf]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :as fdata]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
@ -22,7 +23,6 @@
[app.rpc.doc :as-alias doc]
[app.rpc.permissions :as perms]
[app.rpc.quotes :as quotes]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[clojure.set :as set]))
@ -44,32 +44,31 @@
(assert (db/connection? conn) "expected a valid connection")
(binding [pmap/*tracked* (pmap/create-tracked)
cfeat/*current* features]
(binding [cfeat/*current* features]
(fdata/with-tracked
(let [file (ctf/make-file {:id id
:project-id project-id
:name name
:revn revn
:is-shared is-shared
:features features
:migrations fmg/available-migrations
:ignore-sync-until ignore-sync-until
:created-at modified-at
:deleted-at deleted-at}
{:create-page create-page
:page-id page-id})]
(let [file (ctf/make-file {:id id
:project-id project-id
:name name
:revn revn
:is-shared is-shared
:features features
:migrations fmg/available-migrations
:ignore-sync-until ignore-sync-until
:created-at modified-at
:deleted-at deleted-at}
{:create-page create-page
:page-id page-id})]
(bfc/insert-file! cfg file)
(bfc/insert-file! cfg file)
(->> (assoc params :file-id (:id file) :role :owner)
(create-file-role! conn))
(->> (assoc params :file-id (:id file) :role :owner)
(create-file-role! conn))
(db/update! conn :project
{:modified-at (ct/now)}
{:id project-id})
(db/update! conn :project
{:modified-at (ct/now)}
{:id project-id})
(bfc/get-file cfg (:id file)))))
(bfc/get-file cfg (:id file))))))
(def ^:private schema:create-file
[:map {:title "create-file" :closed true}

98
backend/src/app/rpc/commands/files_snapshot.clj
View File

@ -9,10 +9,12 @@
[app.binfile.common :as bfc]
[app.common.exceptions :as ex]
[app.common.features :as-alias cfeat]
[app.common.files.migrations :as fmg]
[app.common.schema :as sm]
[app.common.time :as ct]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.features.fdata :as fdata]
[app.features.file-snapshots :as fsnap]
[app.features.logical-deletion :as ldel]
[app.main :as-alias main]
@ -53,7 +55,7 @@
::sm/params schema:get-file-snapshot
::sm/result files/schema:file-with-permissions
::db/transaction true}
[cfg {:keys [::rpc/profile-id file-id id] :as params}]
[cfg {:keys [::rpc/profile-id file-id id features] :as params}]
(let [perms (perms/get-file-read-permissions cfg profile-id file-id)]
(files/check-read-permissions! perms)
(let [snapshot (fsnap/get-snapshot cfg file-id id)]
@ -66,12 +68,41 @@
;; Load current file metadata only (no data decoding) then overlay
;; the snapshot data so the client receives the same shape as a
;; normal get-file response but with historical page/object content.
(let [base-file (bfc/get-file cfg file-id :load-data? false)]
;; Snapshots may hold pointer-mapped pages shared with the live
;; file, so materialize them here: the preview UI applies the
;; response straight into state and cannot resolve pointers.
;; NOTE: the loader binds the live file-id, not the snapshot id.
;;
;; A snapshot taken while a migration was pending stores the old
;; format. Apply the pending migrations in memory, the same pure
;; step a normal read runs, and never persist them: the stored
;; version keeps its data and restoring it re-migrates on the
;; next read. `decode-snapshot` hands an ordered set, which is
;; what `need-migration?`/`migrate` require; a stored NULL is
;; regenerated from the snapshot's version.
(let [base-file (bfc/get-file cfg file-id :load-data? false)
snapshot (assoc snapshot :id file-id)
file (if (fmg/need-migration? snapshot)
(let [file (fdata/realize cfg snapshot)]
(fmg/migrate-file
file
(delay (bfc/get-resolved-file-libraries cfg file))))
(update snapshot :data
#(fdata/realize-pointers cfg file-id %)))
;; Works like in `get-file`: a client that does not declare
;; `fdata/objects-map` gets plain objects. The historical
;; feature set is deliberately not checked against the
;; enabled one: a version may predate a feature change.
file (if (and (contains? (:features file) "fdata/objects-map")
(not (contains? features "fdata/objects-map")))
(fdata/realize-objects cfg file)
file)]
(-> base-file
(assoc :data (:data snapshot))
(assoc :version (:version snapshot))
(assoc :features (:features snapshot))
(assoc :revn (:revn snapshot))
(assoc :data (:data file))
(assoc :version (:version file))
(assoc :features (:features file))
(assoc :migrations (:migrations file))
(assoc :revn (:revn file))
(assoc :vern (rand-int 100000))
(assoc :permissions perms))))))
@ -84,10 +115,22 @@
{::doc/added "1.20"
::sm/params schema:create-file-snapshot
::climit/id [[:create-file-snapshot/by-profile ::rpc/profile-id]
[:create-file-snapshot/global]]}
[:create-file-snapshot/global]]
::db/transaction true}
[cfg {:keys [::rpc/profile-id file-id label]}]
(files/check-edition-permissions! cfg profile-id file-id)
(let [file (bfc/get-file cfg file-id :realize? true)
;; NOTE: the file is intentionally NOT realized here: the snapshot
;; shares fragment rows with the live file (same as automatic
;; snapshots) instead of storing a materialized copy. file-gc treats
;; every unpurged snapshot as a liveness root, and readers
;; (get-file-snapshot, restore!, reduce-snapshots) resolve pointers
;; on demand.
;; NOTE: the file is read with FOR SHARE inside this transaction so
;; snapshot creation serializes with a concurrent :file-gc pass
;; (which takes FOR UPDATE + SKIP LOCKED on the same row). Without
;; the lock, a version pinned mid-pass could reference fragment rows
;; the pass is recreating.
(let [file (bfc/get-file cfg file-id :lock-for-share? true)
project (db/get-by-id cfg :project (:project-id file))]
(-> cfg
@ -115,37 +158,50 @@
[:restore-file-snapshot/global]]}
[{:keys [::db/pool ::mbus/msgbus] :as cfg} {:keys [::rpc/profile-id ::rpc/session-id file-id id] :as params}]
;; Check permissions and read current file state (short-lived, outside restore transaction)
;; Check permissions
(files/check-edition-permissions! pool profile-id file-id)
(let [file (bfc/get-file cfg file-id)
team (teams/get-team pool
(let [team (teams/get-team pool
:profile-id profile-id
:file-id file-id)
delay (ldel/get-deletion-delay team)
file-revn (:revn file)]
;; Create backup snapshot of the current state (committed immediately
;; independently of the restore outcome)
(fsnap/create! cfg file
{:profile-id profile-id
:deleted-at (ct/in-future delay)
:created-by "system"})
;; Create backup snapshot of the current state (committed immediately
;; independent of the restore outcome). The read takes FOR SHARE so a
;; concurrent :file-gc pass (which holds FOR UPDATE + SKIP LOCKED on the
;; file row) either finishes first -- and we snapshot the new fragments --
;; or skips the file and retries later. Without the lock, the backup
;; could reference fragments the pass is about to mark as deleted,
;; breaking the backup permanently.
;;
;; The backup read also provides the revn the guard below compares
;; against. An edit committed before this read is captured in the
;; backup and no longer aborts the restore; only edits committed
;; after the backup conflict.
backup-revn
(db/tx-run! cfg
(fn [cfg]
(let [file (bfc/get-file cfg file-id :lock-for-share? true)]
(fsnap/create! cfg file
{:profile-id profile-id
:deleted-at (ct/in-future delay)
:created-by "system"})
(:revn file))))]
;; Restore snapshot inside its own transaction; the revn check
;; ensures no data is lost if the file was edited concurrently
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(let [current (bfc/get-minimal-file conn file-id {::db/for-update true})]
(when (not= (:revn current) file-revn)
(when (not= (:revn current) backup-revn)
(ex/raise :type :conflict
:code :file-modified
:hint "the file was modified during the restore process, please retry")))
(let [vern (fsnap/restore! cfg file-id id)]
(mbus/pub! msgbus
:topic (:id file)
:topic file-id
:message {:type :file-restored
:session-id session-id
:file-id (:id file)
:file-id file-id
:vern vern})
nil)))))

2
backend/src/app/rpc/commands/files_thumbnails.clj
View File

@ -166,7 +166,7 @@
objects)))]
(binding [pmap/*load-fn* (partial fdata/load-pointer cfg id)]
(fdata/with-pointers cfg id
(let [frame (get-thumbnail-frame data)
frame-id (:id frame)
page-id (or (:page-id frame)

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

@ -282,8 +282,7 @@
[{:keys [::db/conn ::timestamp] :as cfg}
{:keys [profile-id file team features changes session-id skip-validate] :as params}]
(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial fdata/load-pointer cfg (:id file))]
(fdata/with-tracked-pointers cfg (:id file)
(let [file (assoc file :features
(-> features
@ -430,11 +429,13 @@
(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))]
(assoc file ::snapshot snapshot)))
"Attach snapshot data to the file. Snapshots share fragment rows with
the live file, so the snapshot is kept as-is (with pointers); it is
NOT realized/materialized here. The file-gc liveness set unions main
and snapshots, so shared fragments survive while any of them needs
them."
[file]
(assoc file ::snapshot file))
(defn- update-file-data!
"Perform a file data transformation in with all update context setup.
@ -442,8 +443,9 @@
This function expected not-decoded file and transformation function. Returns
an encoded file.
This function is not responsible of saving the file. It only saves
fdata/pointer-map modified fragments."
This function is not responsible of saving the file. Fragment rows are
persisted later by `persist-file!` (via `bfc/update-file!` inside the
same transaction); nothing is written to `file_data` here."
[cfg {:keys [id] :as file} update-fn & args]
(let [file (update file :data (fn [data]
@ -458,6 +460,11 @@
take-snapshot?
(take-snapshot? file)
;; Attach the snapshot before migrating: a migration can rebuild a
;; page and give its PointerMap a new id with `modified?` set, and a
;; snapshot taken after that would keep the very pointer the save
;; then rewrites, ending up with post-save content.
;;
;; For avoid unnecesary overhead of creating multiple
;; pointers and handly internally with objects map in their
;; worst case (when probably all shapes and all pointers
@ -468,11 +475,11 @@
;; need-migration?
;; (->> (fdata/realize cfg))
need-migration?
(fmg/migrate-file libs)
take-snapshot?
(->> (attach-snapshot cfg need-migration?)))]
(->> (attach-snapshot))
need-migration?
(fmg/migrate-file libs))]
(apply update-fn cfg file args)))
@ -630,7 +637,7 @@
pending-repair
(atom nil)]
(binding [pmap/*tracked* nil]
(fdata/with-untracked
(when (contains? cf/flags :soft-file-validation)
(let [t (ct/tpoint)]
(try

71
backend/src/app/tasks/file_gc.clj
View File

@ -42,14 +42,27 @@
(map :data)
(mapcat cfh/collect-used-media)))
(defn- collect-snapshot-liveness
"Single snapshot scan collecting both fragment pointer ids and media
ids referenced by unpurged snapshots. Runs once per file-gc pass and
feeds clean-file-media! and clean-fragments!, so snapshot blobs are
read and decoded only once instead of once per cleaner."
[cfg file-id]
(let [xf (comp (filter :data)
(map (fn [{:keys [data]}]
{:pointers (feat.fdata/get-used-pointer-ids data)
:media (cfh/collect-used-media data)})))
rf (completing (fn [acc {:keys [pointers media]}]
(-> acc
(update :pointers into pointers)
(update :media into media))))]
(fsnap/reduce-snapshots cfg file-id xf rf {:pointers #{} :media #{}})))
(defn- clean-file-media!
"Performs the garbage collection of file media objects."
[{:keys [::db/conn ::timestamp] :as cfg} {:keys [id] :as file}]
[{:keys [::db/conn ::timestamp] :as cfg} snap-media {:keys [id] :as file}]
(let [used-media
(fsnap/reduce-snapshots cfg id xf:collect-used-media conj #{})
used-media
(into used-media xf:collect-used-media [file])
(into snap-media xf:collect-used-media [file])
used-media
(db/create-array conn "uuid" used-media)
@ -186,8 +199,15 @@
(mapcat feat.fdata/get-used-pointer-ids)))
(defn- clean-fragments!
[{:keys [::db/conn ::timestamp] :as cfg} {:keys [id] :as file}]
(let [used (into #{} xf:collect-pointers [file])
"Mark fragment rows referenced neither by the current main file data
nor by any unpurged snapshot. The file arrives unrealized (see
`get-file`), so `main-used` holds its stored fragment ids; combined
with `reattach-unchanged`, unchanged pages keep their ids and are
never marked. Runs inside the caller transaction, which already
holds FOR UPDATE on the file row."
[{:keys [::db/conn ::timestamp] :as cfg} snap-pointers {:keys [id] :as file}]
(let [main-used (into #{} xf:collect-pointers [file])
used (into main-used snap-pointers)
unused (->> (db/exec! conn [sql:mark-deleted-data-fragments timestamp id
(db/create-array conn "uuid" used)])
(into #{} bfc/xf-map-id))]
@ -201,10 +221,10 @@
file))
(defn- clean-media!
[cfg file]
[cfg {:keys [media]} file]
(let [file (->> file
(clean-deleted-components! cfg)
(clean-file-media! cfg)
(clean-file-media! cfg media)
(clean-file-thumbnails! cfg)
(clean-file-object-thumbnails! cfg))]
(cfv/validate-file-schema! file)
@ -212,8 +232,12 @@
(defn get-file
[cfg {:keys [file-id revn]}]
;; NOTE: deliberately NOT realized: `process-file!` binds the fragment
;; loader and works on PointerMaps directly, so unchanged pages keep
;; their fragment ids (see `reattach-unchanged`). Realizing here would
;; force every page to be re-persisted under a new id on every pass.
(let [file (bfc/get-file cfg file-id
:realize? true
:realize? false
:skip-locked? true
:lock-for-update? true)]
@ -229,13 +253,21 @@
(defn- process-file!
[cfg {:keys [file-id] :as props}]
(if-let [file (get-file cfg props)]
(let [file (->> file
(bfl/clean-file)
(clean-media! cfg)
(clean-fragments! cfg))
file (assoc file :has-media-trimmed true)]
(bfc/update-file! cfg file)
true)
;; Every fragment load goes through `with-pointers`. Each pointer
;; instance loads its content once (`loaded?`), and the replacement
;; instances `clean-file` creates already carry their content, so
;; the pass reads each fragment once without a separate cache.
(feat.fdata/with-pointers cfg file-id
(let [liveness (collect-snapshot-liveness cfg file-id)
original (feat.fdata/original-pointers (:data file))
file (->> file
(bfl/clean-file)
(clean-media! cfg liveness)
(feat.fdata/reattach-unchanged original)
(clean-fragments! cfg (:pointers liveness)))
file (assoc file :has-media-trimmed true)]
(bfc/update-file! cfg file)
true))
(do
(l/dbg :hint "skip cleaning, criteria does not match" :file-id (str file-id))
@ -258,9 +290,12 @@
processed? (process-file! cfg params)]
(when (and processed? (contains? cf/flags :tiered-file-data-storage))
;; Pass only the file id: the offload job ignores
;; any other file-gc param, and forwarding the whole
;; map would silently couple the two jobs.
(jobs/submit cfg
{::jobs/name :offload-file-data
::jobs/params params
::jobs/params {:file-id (:file-id params)}
::jobs/priority 10
::jobs/delay 1000}))
processed?))))

9
backend/src/app/util/pointer_map.clj
View File

@ -133,8 +133,13 @@
(or mdata {}))
(withMeta [_ mdata']
(let [pmap (PointerMap. id mdata' odata (not= mdata mdata') loaded?)]
(some-> *tracked* (swap! assoc id pmap))
(let [changed? (not= mdata mdata')
;; A fragment row never changes after it is written, so a
;; metadata change is a new pointer (fresh id + tracked), like
;; `assoc` does; reusing the id would rewrite the same row.
id' (if changed? (uuid/next) id)
pmap (PointerMap. id' mdata' odata changed? loaded?)]
(some-> *tracked* (swap! assoc id' pmap))
pmap))
Seqable

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

@ -2903,3 +2903,15 @@
(t/is (= (str (first result) "/" thumb-page-id "/" thumb-frame-id "/" thumb-tag)
(:object-id thumb)))
(t/is (some? (:media-id thumb)))))))
(t/deftest get-file-without-data-rejects-locks
;; Locking is incompatible with `load-data? false`: the guard fires
;; before any query, so no DB row is needed. Regression test for the
;; `lock-for-share?`/`lock-for-share?` typo that left `lock-for-update?`
;; unchecked. NOTE: the guard is an unconditional `when`/`throw` in
;; `get-file*` (not an `assert`), so this test is not flag-dependent:
;; it behaves the same with or without `enable-backend-asserts`.
(doseq [opt [:lock-for-share? :lock-for-update? :skip-locked?]]
(t/is (thrown? IllegalArgumentException
(bfc/get-file th/*system* (uuid/random)
:load-data? false opt true)))))

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

@ -445,9 +445,12 @@
(t/is (thrown? clojure.lang.ExceptionInfo
(invoke! cfg (fn [_ _] :never) {}))))
;; the count came back down instead of staying up for good
;; the count came back down instead of staying up for good. Only the
;; last publication is asserted, not the exact list: the sampler
;; republishes the same count when its first tick lands inside the
;; window.
(t/is (= 0 (waiting-count climit name)))
(t/is (= [0] (waiting-value-of name)))
(t/is (= 0 (waiting-last name)))
;; and the thread dropped the mark: with it left behind, this call would
;; run inline instead of waiting for the permit another thread holds.

1005
backend/test/backend_tests/file_pointer_snapshot_test.clj Normal file
View File

File diff suppressed because it is too large Load Diff

29
backend/test/backend_tests/http_debug_test.clj Normal file
View File

@ -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 backend-tests.http-debug-test
"The /dbg validate action walks the whole file and its libraries: it
must hand `get-resolved-file-libraries` the file (not its id) and
resolve the pointer-mapped pages with the file's own loader."
(:require
[app.http.debug :as debug]
[backend-tests.helpers :as th]
[clojure.test :as t]
[yetti.response :as-alias yres]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest validate-file-action-resolves-pointer-mapped-data
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
handler (deref #'debug/validate-file)
result (handler th/*system* {:params {:file-id (str (:id file))}})]
(t/is (= 200 (::yres/status result)))
(t/is (= "NO VALIDATION ERRORS FOUND" (::yres/body result)))))

519
backend/test/backend_tests/rpc_file_snapshot_test.clj
View File

@ -6,19 +6,27 @@
(ns backend-tests.rpc-file-snapshot-test
(:require
[app.binfile.common :as bfc]
[app.common.data :as d]
[app.common.features :as cfeat]
[app.common.files.defaults :as cfd]
[app.common.files.migrations :as fmg]
[app.common.pprint :as pp]
[app.common.thumbnails :as thc]
[app.common.time :as ct]
[app.common.types.objects-map :as omap]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[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]
[backend-tests.helpers :as th]
[clojure.set :as set]
[clojure.test :as t]
[cuerdas.core :as str]))
@ -138,6 +146,156 @@
;; delete 2 snapshots and 2 file data entries
(t/is (= 4 (:processed res)))))))))
(t/deftest snapshot-preview-resolves-fragments
;; Regression test (R1): previewing an automatic snapshot of a
;; pointer-mapped file must return plain data, not pointer
;; placeholders the preview UI cannot render.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file-id (:id file)
page-id (first (get-in file [:data :pages]))
shape-id (uuid/random)]
;; An update at revn 0 takes an automatic (system) snapshot of the
;; pre-change state; with pointer-map that snapshot shares fragments
;; with the live file.
(update-file! :profile-id (:id profile)
:file-id file-id
:revn 0
:changes [{:type :add-obj
:page-id page-id
:id shape-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id shape-id
:name "rect"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect})}])
;; Single labeled snapshot here, but order explicitly so a
;; future edit adding more snapshots cannot pick the wrong one.
(let [snap-id (->> (th/db-query :file-change {:file-id file-id} {:order-by [:created-at]})
(filter #(some? (:label %)))
(first)
(:id))
_ (t/is (uuid? snap-id))
out (th/command! {::th/type :get-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snap-id
:features cfeat/supported-features})]
(t/is (nil? (:error out)))
(let [data (get-in (:result out) [:data])]
(t/is (map? data))
(t/is (empty? (fdata/get-used-pointer-ids data)))))))
(defn- live-fragment-ids
[file-id]
(into #{}
(comp (filter #(nil? (:deleted-at %)))
(map :id))
(th/db-query :file-data {:file-id file-id :type "fragment"})))
(t/deftest user-snapshot-shares-fragments
;; User-pinned versions share fragment rows like automatic snapshots
;; instead of storing a materialized copy.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file-id (:id file)
page-id (first (get-in file [:data :pages]))
before (live-fragment-ids file-id)
out (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:label "v1"})
_ (t/is (nil? (:error out)))
snap-id (:id (:result out))]
;; No new fragment rows: the version reuses the live ones.
(t/is (uuid? snap-id))
(t/is (= before (live-fragment-ids file-id)))
;; The version pointers are a subset of the live pointers.
(let [live (fdata/get-used-pointer-ids
(:data (bfc/get-file th/*system* file-id)))
snap (fdata/get-used-pointer-ids
(:data (fsnap/get-snapshot th/*system* file-id snap-id)))]
(t/is (pos? (count snap)))
(t/is (every? #(contains? live %) snap)))
(let [shape-id (uuid/random)]
;; Modify the file, then restore the version and compare resolved
;; content with the version preview (both materialized).
(update-file! :profile-id (:id profile)
:file-id file-id
:revn 0
:changes [{:type :add-obj
:page-id page-id
:id shape-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id shape-id
:name "rect"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect})}]))
(let [preview-out (th/command! {::th/type :get-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snap-id
:features cfeat/supported-features})
_ (t/is (nil? (:error preview-out)))
preview (:result preview-out)
restore-out (th/command! {::th/type :restore-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snap-id})
_ (t/is (nil? (:error restore-out)))
live (:data (bfc/get-file th/*system* file-id :realize? true))
;; The preview resolves pointers but keeps objects-maps
;; encoded; realize them too so both sides are plain data.
preview-data (:data (fdata/realize-objects
nil {:data (:data preview)}))]
(t/is (= preview-data live)))))
(t/deftest user-snapshot-of-file-needing-migration-is-materialized
;; A file with pending migrations cannot share fragments: the
;; migration path realizes the data, so the stored snapshot holds
;; plain maps. This pins the shape so it cannot drift silently.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file-id (:id file)]
(th/db-update! :file {:version (dec (:version file))} {:id file-id})
(let [out (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:label "v1"})
_ (t/is (nil? (:error out)))
snap-id (:id (:result out))
snap (fsnap/get-snapshot th/*system* file-id snap-id)]
(t/is (uuid? snap-id))
(t/is (empty? (fdata/get-used-pointer-ids (:data snap))))
;; ...while preview keeps working on the migrated content.
(let [preview (th/command! {::th/type :get-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snap-id
:features cfeat/supported-features})]
(t/is (nil? (:error preview)))
(t/is (map? (get-in preview [:result :data])))))))
(t/deftest snapshots-locking
(let [profile-1 (th/create-profile* 1 {:is-active true})
profile-2 (th/create-profile* 2 {:is-active true})
@ -220,3 +378,364 @@
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (true? (:result out)))))))
(t/deftest snapshot-creation-serializes-with-file-gc
;; A user snapshot shares fragment rows with the live file, so its
;; creation must serialize with a concurrent :file-gc pass (which
;; takes FOR UPDATE + SKIP LOCKED on the file row): creation holds
;; FOR SHARE, the GC skips locked files instead of racing it.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file-id (:id file)]
(t/testing "gc skips a file locked for share"
(db/tx-run! th/*system*
(fn [cfg]
;; Hold FOR SHARE to commit, like create-file-snapshot does.
(bfc/get-file cfg file-id :lock-for-share? true)
;; The GC uses SKIP LOCKED on a different connection, so it
;; must skip instead of blocking or marking.
(t/is (not (th/run-task! :file-gc {:file-id file-id}))))))
(t/testing "creation cannot slip between gc scan and mark"
;; Deterministic interleaving: pause the GC right after its
;; snapshot scan, then create a snapshot. With the FOR SHARE lock
;; the creation waits at the read and sees post-GC fragment ids;
;; without it, it reads pre-GC ids and pins a fragment the pass
;; is about to mark.
(let [orig-reduce @#'fsnap/reduce-snapshots
orig-create @#'fsnap/create!
scan-started (promise)
release-scan (promise)
reached-insert (promise)
do-create (fn []
(th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:label "pinned"}))]
(with-redefs [fsnap/reduce-snapshots
(fn [cfg file-id xform f init]
(deliver scan-started true)
@release-scan
(orig-reduce cfg file-id xform f init))
fsnap/create!
(fn [& args]
(deliver reached-insert true)
(apply orig-create args))]
(let [gc-done (future (th/run-task! :file-gc {:file-id file-id}))]
(t/is (= true (deref scan-started 10000 ::timeout)))
(let [created (future (do-create))]
;; The creation must not reach the insert while the GC
;; pass holds the file row: with FOR SHARE it waits at the
;; read instead of snapshotting pre-GC fragment ids.
(t/is (= ::timeout (deref reached-insert 10000 ::timeout)))
(deliver release-scan true)
(t/is (some? (deref gc-done 30000 ::timeout)))
(let [out (deref created 30000 ::timeout)]
(t/is (not= ::timeout out))
(t/is (nil? (:error out)))
(t/is (uuid? (get-in out [:result :id])))))))))
(t/testing "snapshot taken around gc still resolves"
;; The racing pass marks nothing (the file is unchanged, so
;; reattach keeps every id), therefore there is nothing to purge;
;; the snapshot keeps resolving afterwards.
(t/is (zero? (:processed (th/run-task! :objects-gc {}))))
(t/is (true? (th/run-task! :file-gc {:file-id file-id})))
;; The pinned snapshot (not an arbitrary autosnapshot: those may
;; reference fragments an earlier pass already marked) must keep
;; resolving after another GC cycle.
(let [snap-id (->> (th/db-query :file-change {:file-id file-id} {:order-by [:created-at]})
(filter #(= "pinned" (:label %)))
(first)
(:id))
out (th/command! {::th/type :get-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snap-id
:features cfeat/supported-features})]
(t/is (uuid? snap-id))
(t/is (nil? (:error out)))
(t/is (empty? (fdata/get-used-pointer-ids
(get-in out [:result :data]))))))))
(t/deftest restore-backup-serializes-with-file-gc
;; The backup snapshot taken by restore shares fragment rows with
;; the live file, so its creation must serialize with a concurrent
;; :file-gc pass, like ::create-file-snapshot does: with FOR SHARE
;; held by the GC pass, the restore waits at the locked read instead
;; of snapshotting pre-GC fragment ids that the pass is about to
;; mark as deleted.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file-id (:id file)
page-id (first (get-in file [:data :pages]))
shape-id (uuid/random)
snap-id (:id (:result (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:label "v1"})))]
(t/is (uuid? snap-id))
(update-file! :profile-id (:id profile)
:file-id file-id
:revn 0
:changes [{:type :add-obj
:page-id page-id
:id shape-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id shape-id
:name "rect"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect})}])
(let [orig-reduce @#'fsnap/reduce-snapshots
orig-create @#'fsnap/create!
scan-started (promise)
release-scan (promise)
reached-insert (promise)
do-restore (fn []
(th/command! {::th/type :restore-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snap-id}))]
(with-redefs [fsnap/reduce-snapshots
(fn [cfg file-id xform f init]
(deliver scan-started true)
@release-scan
(orig-reduce cfg file-id xform f init))
fsnap/create!
(fn [& args]
(deliver reached-insert true)
(apply orig-create args))]
(let [gc-done (future (th/run-task! :file-gc {:file-id file-id}))]
(t/is (= true (deref scan-started 10000 ::timeout)))
(let [restored (future (do-restore))]
(t/is (= ::timeout (deref reached-insert 10000 ::timeout)))
(deliver release-scan true)
(t/is (some? (deref gc-done 30000 ::timeout)))
(let [out (deref restored 30000 ::timeout)]
(t/is (not= ::timeout out))
(t/is (nil? (:error out))))))))
(let [backup-ids (->> (th/db-query :file-change {:file-id file-id})
(map (juxt :id :label))
(filter (fn [[_ label]]
(and (string? label)
(str/starts-with? label "snapshot-"))))
(map first)
(set))
backup-ids (set/intersection
backup-ids
(into #{}
(map :id)
(th/db-query :file-data {:file-id file-id
:type "snapshot"})))
live (into #{}
(map :id)
(filter #(nil? (:deleted-at %))
(th/db-query :file-data {:file-id file-id
:type "fragment"})))]
(t/is (= 1 (count backup-ids)))
(doseq [backup-id backup-ids
:let [snap (fsnap/get-snapshot th/*system* file-id backup-id)]]
(t/is (every? live (fdata/get-used-pointer-ids (:data snap))))
(let [out (th/command! {::th/type :get-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id backup-id
:features cfeat/supported-features})]
(t/is (nil? (:error out)))
(t/is (empty? (fdata/get-used-pointer-ids
(get-in out [:result :data])))))))))
(t/deftest snapshot-preview-applies-pending-migrations
;; A snapshot taken while a migration was pending stores the old
;; format. The preview must apply the pending migration in memory
;; (the same pure step a normal read runs) instead of handing the old
;; format to the UI, and must not persist anything: the stored
;; version keeps its data so restoring it re-migrates on next read.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file-id (:id file)
page-id (first (get-in file [:data :pages]))
shape-id (uuid/random)]
(update-file! :profile-id (:id profile)
:file-id file-id
:revn 0
:changes [{:type :add-obj
:page-id page-id
:id shape-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (-> (cts/setup-shape {:id shape-id
:name "rect"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect})
(assoc :applied-tokens {:stroke-width "token"}))}])
;; Force the 0031 migration on the next save.
(th/db-delete! :file-migration {:file-id file-id
:name "0031-migrate-stroke-width-token-attr"})
(update-file! :profile-id (:id profile)
:file-id file-id
:revn 1
:changes [{:type :add-page :name "b" :id (uuid/random)}])
(let [snapshot (->> (th/db-query :file-change {:file-id file-id})
(filter #(and (some? (:label %))
(= 1 (:revn %))))
(first))
snapshot-id (:id snapshot)
stored (fdata/realize th/*system*
(assoc (fsnap/get-snapshot th/*system* file-id snapshot-id)
:id file-id))
out (th/command! {::th/type :get-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snapshot-id
:features cfeat/supported-features})]
(t/is (uuid? snapshot-id))
;; The stored version keeps the old format and the pending
;; migration: the preview must not touch the stored row.
(t/is (not (contains? (set (:migrations stored))
"0031-migrate-stroke-width-token-attr")))
(t/is (= {:stroke-width "token"}
(get-in stored [:data :pages-index page-id
:objects shape-id :applied-tokens])))
;; The preview migrates it in memory.
(t/is (nil? (:error out)))
(t/is (= file-id (get-in out [:result :data :id])))
(let [tokens (get-in out [:result :data :pages-index page-id
:objects shape-id :applied-tokens])]
(t/is (not (contains? tokens :stroke-width)))
(t/is (contains? tokens :stroke-width-top))
(t/is (contains? tokens :stroke-width-bottom)))
;; The preview declared the migrated set in the payload.
(t/is (contains? (set (get-in out [:result :migrations]))
"0031-migrate-stroke-width-token-attr")))
;; Nothing was persisted by the preview.
(let [snapshot-id (:id (->> (th/db-query :file-change {:file-id file-id})
(filter #(and (some? (:label %))
(= 1 (:revn %))))
(first)))
stored (fdata/realize th/*system*
(assoc (fsnap/get-snapshot th/*system* file-id snapshot-id)
:id file-id))]
(t/is (= {:stroke-width "token"}
(get-in stored [:data :pages-index page-id
:objects shape-id :applied-tokens]))))))
(t/deftest snapshot-preview-realizes-objects-for-clients-without-the-feature
;; `:features` works like in `get-file`: a client that does not
;; declare `fdata/objects-map` receives plain objects instead of the
;; storage structure of the fragment.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file-id (:id file)
page-id (first (get-in file [:data :pages]))
shape-id (uuid/random)
_ (update-file! :profile-id (:id profile)
:file-id file-id
:revn 0
:changes [{:type :add-obj
:page-id page-id
:id shape-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id shape-id
:name "rect"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect})}])
snapshot-id (:id (:result (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:label "v1"})))
preview (fn [features]
(th/command! {::th/type :get-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snapshot-id
:features features}))
with-feature (preview cfeat/supported-features)
without-feature (preview (disj cfeat/supported-features
"fdata/objects-map"))]
(t/is (nil? (:error with-feature)))
(t/is (nil? (:error without-feature)))
(t/is (omap/objects-map?
(get-in with-feature [:result :data :pages-index page-id :objects])))
(t/is (not (omap/objects-map?
(get-in without-feature [:result :data :pages-index page-id :objects]))))))
(t/deftest snapshot-preview-migrates-legacy-snapshots-without-migrations
;; Snapshots written before the `migrations` column existed (SQL
;; migration 0140) store NULL and the format version of their time.
;; The decoder must hand an ordered set (a vector would make
;; `need-migration?` compare indexes), and the preview must
;; regenerate the applied set from the stored version, migrate the
;; data in memory and leave the row untouched.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
file-id (:id file)
snap-id (:id (:result (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:label "legacy"})))]
(t/is (d/ordered-set? (:migrations (fsnap/get-snapshot th/*system* file-id snap-id))))
;; Turn the version into a pre-0140 snapshot: no applied set and an
;; old format version.
(th/db-exec! ["UPDATE file_change SET migrations = NULL, version = 60 WHERE id = ?"
snap-id])
(let [stored (fsnap/get-snapshot th/*system* file-id snap-id)
out (th/command! {::th/type :get-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:id snap-id
:features cfeat/supported-features})
result (:result out)]
(t/is (nil? (:migrations stored)))
(t/is (= 60 (:version stored)))
(t/is (nil? (:error out)))
(t/is (d/ordered-set? (:migrations result)))
;; The preview regenerates everything the stored version lacks
;; instead of trusting the absent applied set.
(t/is (= cfd/version (:version result)))
(t/is (= (into #{} fmg/available-migrations)
(set (:migrations result))))
(t/is (set/subset? (into #{} (fmg/generate-migrations-from-version cfd/version))
(set (:migrations result))))
;; Nothing is persisted.
(let [stored (fsnap/get-snapshot th/*system* file-id snap-id)]
(t/is (nil? (:migrations stored)))
(t/is (= 60 (:version stored)))))))

147
backend/test/backend_tests/rpc_file_test.clj
View File

@ -158,8 +158,9 @@
(t/is (true? (th/run-task! :file-gc {:file-id (:id file) :revn (:revn file)})))
;; Check the number of fragments before adding the page
;; (no churn: the preventive GC above reuses the single id).
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
(t/is (= 2 (count rows))))
(t/is (= 1 (count rows))))
;; Add page
(update-file!
@ -173,20 +174,29 @@
:id page-id}])
;; Check the number of fragments before adding the page
;; (add-page adds exactly one fragment; the existing page keeps
;; its id).
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
(t/is (= 3 (count rows))))
(t/is (= 2 (count rows))))
;; Snapshots share fragment rows with the live file; drop them so
;; this GC-mechanics test asserts only on unreferenced fragments
;; (snapshot retention itself is covered in file-pointer-snapshot-test).
(th/db-delete! :file-change {:file-id (:id file)})
(th/db-delete! :file-data {:file-id (:id file) :type "snapshot"})
;; The file-gc should mark for remove unused fragments
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; Check the number of fragments
;; Check the number of fragments (no churn: unchanged pages keep
;; their ids, so nothing is marked and nothing new is persisted).
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
(t/is (= 5 (count rows)))
(t/is (= 3 (count (filterv :deleted-at rows)))))
(t/is (= 2 (count rows)))
(t/is (= 0 (count (filterv :deleted-at rows)))))
;; The objects-gc should remove unused fragments
;; The objects-gc has nothing to remove.
(let [res (th/run-task! :objects-gc {})]
(t/is (= 3 (:processed res))))
(t/is (= 0 (:processed res))))
;; Check the number of fragments
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
@ -216,12 +226,18 @@
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
(t/is (= 3 (count rows))))
;; Same snapshot cleanup as above: isolate GC mechanics from
;; snapshot retention.
(th/db-delete! :file-change {:file-id (:id file)})
(th/db-delete! :file-data {:file-id (:id file) :type "snapshot"})
;; The file-gc should mark for remove unused fragments
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; The objects-gc should remove unused fragments
;; Only the replaced page fragment is marked; the live pages keep
;; their ids instead of being re-persisted.
(let [res (th/run-task! :objects-gc {})]
(t/is (= 3 (:processed res))))
(t/is (= 1 (:processed res))))
;; Check the number of fragments;
(let [rows (th/db-query :file-data {:file-id (:id file)
@ -241,14 +257,15 @@
;; snapshots previously deleted.
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; Check the number of fragments;
;; Check the number of fragments; without churn the two live
;; pages simply stay where they are (was 4 with 2 re-persisted).
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
;; (pp/pprint rows)
(t/is (= 4 (count rows)))
(t/is (= 2 (count rows)))
(t/is (= 2 (count (remove :deleted-at rows)))))
(let [res (th/run-task! :objects-gc {})]
(t/is (= 2 (:processed res))))
(t/is (= 0 (:processed res))))
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
(t/is (= 2 (count rows))))))
@ -339,8 +356,10 @@
(t/is (ct/inst? (:deleted-at row2))))
(let [res (th/run-task! :objects-gc {})]
;; delete 2 fragments and 1 media object
(t/is (= 3 (:processed res))))
;; 1 (was 2): no churn orphans anymore, only the unused media
;; row is purged. The replaced page fragment stays pinned by
;; the automatic snapshot.
(t/is (= 1 (:processed res))))
;; check file media objects
(let [rows (th/db-query :file-media-object {:file-id (:id file)})]
@ -366,10 +385,11 @@
;; as deleted.
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; This only clears fragments, the file media objects still referenced because
;; snapshots are preserved
;; The deleted shape's fragment is pinned by the automatic
;; snapshot taken before the deletion, and its media is still
;; referenced there too: nothing is marked, nothing to purge.
(let [res (th/run-task! :objects-gc {})]
(t/is (= 2 (:processed res))))
(t/is (= 0 (:processed res))))
;; Delete all snapshots
(th/db-exec! ["update file_data set deleted_at = now() where file_id = ? and type = 'snapshot'" (:id file)])
@ -384,9 +404,11 @@
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [res (th/run-task! :objects-gc {})]
;; 3 (was 4): the two orphaned page fragments plus the media
;; row, all unreferenced now that the snapshots are purged.
;; this will remove the file media objects marked as deleted
;; on prev file-gc
(t/is (= 2 (:processed res))))
(t/is (= 3 (:processed res))))
;; Now that file-gc have deleted the file-media-object usage,
;; lets execute the touched-gc task, we should see that two of
@ -510,12 +532,15 @@
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [res (th/run-task! :objects-gc {})]
(t/is (= 2 (:processed res))))
;; 0 (was 2, then 1): no churn orphans and every replaced page
;; fragment stays pinned by an automatic snapshot.
(t/is (= 0 (:processed res))))
(let [rows (th/db-query :file-data {:file-id (:id file)
:type "fragment"
:deleted-at nil})]
(t/is (= (count rows) 1)))
;; 2 live (was 1): the snapshot-pinned fragment survives.
(t/is (= (count rows) 2)))
;; retrieve file and check trimmed attribute
(let [row (th/db-get :file {:id (:id file)})]
@ -553,10 +578,11 @@
;; as deleted.
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; This only removes unused fragments, file media are still
;; referenced on snapshots.
;; The deleted shapes' fragments stay pinned by the automatic
;; snapshots taken before the deletion, and the media is still
;; referenced there too: nothing is marked, nothing to purge.
(let [res (th/run-task! :objects-gc {})]
(t/is (= 2 (:processed res))))
(t/is (= 0 (:processed res))))
;; Mark all snapshots to be a non-snapshot file change
(th/db-exec! ["update file set has_media_trimmed = false where id = ?" (:id file)])
@ -567,7 +593,10 @@
;; "expired/deleted"
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [res (th/run-task! :objects-gc {})]
(t/is (= 6 (:processed res))))
;; 7 (was 6, then 8): the two orphaned page fragments plus the
;; five media rows, all unreferenced once the snapshot file_data
;; rows are gone. No churn duplicates are created anymore.
(t/is (= 7 (:processed res))))
(let [rows (th/db-query :file-data {:file-id (:id file)
:type "fragment"
@ -716,9 +745,11 @@
;; Now that file-gc have marked for deletion the object
;; thumbnail lets execute the objects-gc task which remove
;; the rows and mark as touched the storage object rows
;; the rows and mark as touched the storage object rows.
;; 1 (was 5, then 3): without churn there are no orphaned
;; fragment rows to purge, only the deleted thumbnail row.
(let [res (th/run-task! :objects-gc {})]
(t/is (= 5 (:processed res))))
(t/is (= 1 (:processed res))))
;; Now that objects-gc have deleted the object thumbnail lets
;; execute the touched-gc task
@ -749,7 +780,9 @@
(let [res (th/run-task! :objects-gc {})]
;; (pp/pprint res)
(t/is (= 3 (:processed res))))
;; 1 (was 3, then 2): without churn there are no fragment
;; orphans; only the deleted thumbnail row is purged.
(t/is (= 1 (:processed res))))
;; We still have th storage objects in the table
(let [rows (th/db-query :storage-object {:deleted-at nil})]
@ -1387,7 +1420,10 @@
(t/is (= 1 (count (remove :deleted-at rows)))))
(let [res (th/run-task! :objects-gc {})]
(t/is (= 4 (:processed res))))
;; 1 (was 4, then 3): no fragment churn anymore — unchanged
;; pages keep their ids, so only the deleted object-thumbnail
;; row itself is purged.
(t/is (= 1 (:processed res))))
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
@ -1510,7 +1546,9 @@
(t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {})]
(t/is (= 2 (:processed res))))
;; 1 (was 2): without churn there is no re-persisted fragment
;; orphan; only the superseded thumbnail row is purged.
(t/is (= 1 (:processed res))))
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
(t/is (= 1 (count rows)))))))
@ -1530,8 +1568,9 @@
;; Preventive objects-gc
(let [result (th/run-task! :objects-gc {})]
;; deletes the fragment created by file-gc
(t/is (= 1 (:processed result))))
;; nothing to delete: without churn the preventive file-gc above
;; marked and created nothing.
(t/is (= 0 (:processed result))))
;; Check the number of fragments before adding the page
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
@ -1555,9 +1594,10 @@
(t/is (= 2 (:freeze res)))
(t/is (= 0 (:delete res))))
;; Clean objects after file-gc
;; Clean objects after file-gc: nothing to purge, the single
;; fragment was kept (no churn re-persist) and offloaded as is.
(let [result (th/run-task! :objects-gc {})]
(t/is (= 1 (:processed result))))
(t/is (= 0 (:processed result))))
;; Check the number of fragments before adding the page
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
@ -1607,48 +1647,49 @@
;; The file-gc should mark for remove unused fragments
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; The file-gc task, recreates all fragments, so after it we have
;; now the double of fragments, and the old ones are marked as
;; deleted, and the new ones are on DB
(let [[row1 row2 row3 row4 :as rows]
;; The file-gc only marks fragments nothing references: the live
;; pages keep their ids (no churn re-persist), row1 stays alive on
;; cold storage pinned by the automatic snapshot, row2 is the new
;; hot page.
(let [[row1 row2 :as rows]
(th/db-query :file-data
{:file-id (:id file)
:type "fragment"}
{:order-by [:created-at]})]
;; (pp/pprint rows)
(t/is (= 4 (count rows)))
;; No churn: live pages keep their ids, so there are no
;; re-persisted duplicates and nothing is marked. row1 stays on
;; cold storage pinned by the automatic snapshot.
(t/is (= 2 (count rows)))
(t/is (nil? (:data row1)))
(t/is (ct/inst? (:deleted-at row1)))
(t/is (nil? (:deleted-at row1)))
(t/is (= "storage" (:backend row1)))
(t/is (bytes? (:data row2)))
(t/is (= "db" (:backend row2)))
(t/is (ct/inst? (:deleted-at row2)))
(t/is (nil? (:deleted-at row2))))
(t/is (bytes? (:data row3)))
(t/is (= "db" (:backend row3)))
(t/is (nil? (:deleted-at row3)))
(t/is (bytes? (:data row4)))
(t/is (= "db" (:backend row4)))
(t/is (nil? (:deleted-at row4))))
;; The objects-gc should remove the marked to delete fragments
;; The objects-gc has nothing to remove: no fragment was marked.
(let [res (th/run-task! :objects-gc {})]
(t/is (= 2 (:processed res))))
(t/is (= 0 (:processed res))))
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
;; 2 rows (was 3): the snapshot-pinned offloaded fragment plus
;; the single live hot row. No churn duplicates.
(t/is (= 2 (count rows)))
(t/is (every? #(bytes? (:data %)) rows))
(t/is (every? #(= "db" (:backend %)) rows)))
(t/is (= 1 (count (filter #(bytes? (:data %)) rows))))
(t/is (= 1 (count (filter #(= "storage" (:backend %)) rows))))
(t/is (= 1 (count (filter #(= "db" (:backend %)) rows)))))
;; we ensure that once object-gc is passed and marked two storage
;; objects to delete
(let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))]
(th/run-task! :storage-gc-touched {}))]
(t/is (= 0 (:freeze res)))
(t/is (= 2 (:delete res))))
;; 1 (was 2): only one storage object was touched by the purge
;; above, the pinned fragment's object is still referenced.
(t/is (= 1 (:delete res))))
(let [storage (sto/resolve th/*system*)]
(t/is (uuid? (:id @sobject)))

10
backend/test/backend_tests/rpc_file_thumbnails_test.clj
View File

@ -119,8 +119,11 @@
;; thumbnails
(th/run-task! :file-gc {:file-id (:id file)})
;; Only the unused object-thumbnail row is purged: the replaced
;; page fragment stays pinned by the automatic snapshot that shares
;; it, and reattach means file-gc writes no churn fragments.
(let [result (th/run-task! :objects-gc {})]
(t/is (= 3 (:processed result))))
(t/is (= 1 (:processed result))))
;; check if row2 related thumbnail row still exists
(let [[row :as rows] (th/db-query :file-tagged-object-thumbnail
@ -223,8 +226,11 @@
;; thumbnails
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; Only the superseded revn thumbnail row is purged: the file
;; itself is unchanged, so it keeps its fragment ids (no-churn)
;; and no fragment row is marked.
(let [result (th/run-task! :objects-gc {})]
(t/is (= 2 (:processed result))))
(t/is (= 1 (:processed result))))
;; check if row1 related thumbnail row still exists
(let [[row :as rows] (th/db-query :file-thumbnail

17
backend/test/backend_tests/util_pointer_map_test.clj
View File

@ -117,5 +117,20 @@
(t/is (not (contains? obj1 :b)))
(t/is (= 1 (get obj1 :a)))
(t/is (= nil (get obj1 :b)))
(t/is (= ::empty (get obj1 :b ::empty)))))))
(t/is (= ::empty (get obj1 :b ::empty))))))
(t/testing "with-meta"
(binding [pmap/*tracked* (atom {})
pmap/*load-fn* (constantly {})]
(let [obj1 (pmap/create uuid/zero {})
obj2 (with-meta obj1 {:foo :bar})
obj3 (with-meta obj1 {})]
;; A metadata change is a new pointer: fresh id and tracked, so
;; the fragment row is never rewritten under the same id.
(t/is (pmap/modified? obj2))
(t/is (not= (pmap/get-id obj1) (pmap/get-id obj2)))
(t/is (contains? @pmap/*tracked* (pmap/get-id obj2)))
;; The same metadata keeps the pointer untouched.
(t/is (not (pmap/modified? obj3)))
(t/is (= (pmap/get-id obj1) (pmap/get-id obj3)))))))

4
common/src/app/common/files/migrations.cljc
View File

@ -88,7 +88,9 @@
(-> file
(assoc :data data)
(update :migrations set/union diff)
;; `:migrations` is an ordered set everywhere; keep it that way
;; even if a caller hands a plain set.
(update :migrations #(into (d/ordered-set) (set/union % diff)))
(vary-meta assoc ::migrated (not-empty diff)))))
(defn generate-migrations-from-version

17
frontend/src/app/main/data/viewer.cljs
View File

@ -24,6 +24,7 @@
[app.main.data.fonts :as df]
[app.main.data.helpers :as dsh]
[app.main.features :as features]
[app.main.features.pointer-map :as fpmap]
[app.main.repo :as rp]
[app.main.router :as rt]
[app.render-wasm.api :as wasm.api]
@ -120,6 +121,13 @@
[:file-id ::sm/uuid]
[:share-id {:optional true} ::sm/uuid]])
(defn resolve-viewer-fragment
"Resolves one pointer-mapped entry of the view-only bundle into a
[key data] pair. Thin wrapper over the shared `fpmap/resolve-pointer`
with share-link scoping; see it for the failure contract."
[file-id share-id entry]
(fpmap/resolve-pointer file-id share-id entry))
(defn- fetch-bundle
[{:keys [file-id share-id] :as params}]
@ -140,14 +148,7 @@
(uuid? share-id)
(assoc :share-id share-id))
resolve (fn [[key pointer]]
(let [params {:file-id file-id :fragment-id @pointer}
params (cond-> params
(uuid? share-id)
(assoc :share-id share-id))]
(->> (rp/cmd! :get-file-fragment params)
(rx/map :data)
(rx/map #(vector key %)))))]
resolve (partial resolve-viewer-fragment file-id share-id)]
(->> (rp/cmd! :get-view-only-bundle params')
(rx/mapcat

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

@ -21,7 +21,6 @@
[app.common.math :as mth]
[app.common.path-names :as cpn]
[app.common.render-wasm.wasm :as wasm-state]
[app.common.transit :as t]
[app.common.types.component :as ctc]
[app.common.types.components-list :as ctkl]
[app.common.types.shape :as cts]
@ -144,11 +143,11 @@
(log/inf :hint "resolve file"
:file-id (str (:id file))
:features (str/join " " (:features file)))
;; fpmap/resolve-file guarantees resolved data or an error; there is
;; no leftover-pointer case to handle here.
(->> (fpmap/resolve-file file)
(rx/map :data)
(rx/map
(fn [data]
(assoc file :data (d/removem (comp t/pointer? val) data))))))
(rx/map #(assoc file :data %))))
(defn- check-libraries-synchronization
[file-id libraries]

47
frontend/src/app/main/features/pointer_map.cljs
View File

@ -7,27 +7,54 @@
(ns app.main.features.pointer-map
"A frontend specific helpers for work with pointer-map feature"
(:require
[app.common.logging :as log]
[app.common.transit :as t]
[app.main.repo :as rp]
[beicon.v2.core :as rx]))
(defn- unresolved-pointers
[m]
(into [] (comp (filter (fn [[_ v]] (t/pointer? v))) (map key)) m))
(defn resolve-pointer
"Resolves a single [key pointer] entry into a [key data] pair against
`get-file-fragment`. A failing fragment rejects with the original
cause (logged with file-id and fragment-id) instead of resolving to
a silently pruned entry. Pass a share-id for share-link scoped
resolution, as the viewer does."
([file-id entry]
(resolve-pointer file-id nil entry))
([file-id share-id [key pointer :as kv]]
(if (t/pointer? pointer)
(let [params (cond-> {:file-id file-id :fragment-id @pointer}
(uuid? share-id)
(assoc :share-id share-id))]
(->> (rp/cmd! :get-file-fragment params)
(rx/map :data)
(rx/map #(vector key %))
(rx/catch (fn [cause]
(log/error :hint "unable to resolve file fragment"
:file-id (str file-id)
:fragment-id (str @pointer)
:cause cause)
(rx/throw cause)))))
(rx/of kv))))
(defn resolve-file
[{:keys [id data] :as file}]
(letfn [(resolve-pointer [[key val :as kv]]
(if (t/pointer? val)
(->> (rp/cmd! :get-file-fragment {:file-id id :fragment-id @val})
(rx/map #(get % :data))
(rx/map #(vector key %)))
(rx/of kv)))
(resolve-pointers [coll]
(letfn [(resolve-pointers [coll]
(->> (rx/from (seq coll))
(rx/merge-map resolve-pointer)
(rx/merge-map (partial resolve-pointer id))
(rx/reduce conj {})))]
(->> (rx/zip (resolve-pointers data)
(resolve-pointers (:pages-index data)))
(rx/take 1)
(rx/map (fn [[data pages-index]]
(let [data (assoc data :pages-index pages-index)]
(let [data (assoc data :pages-index pages-index)
pending (concat (unresolved-pointers data)
(unresolved-pointers pages-index))]
(when (seq pending)
(throw (ex-info "unresolved file fragments after resolve"
{:file-id id :keys pending})))
(assoc file :data data)))))))

126
frontend/test/frontend_tests/data/pointer_map_test.cljs Normal file
View File

@ -0,0 +1,126 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.data.pointer-map-test
"Unit tests for the fragment resolvers (workspace and viewer): resolved
data comes back whole, and a failing fragment rejects instead of
silently dropping the page."
(:require
[app.common.transit :as tr]
[app.common.uuid :as uuid]
[app.main.data.viewer :as dv]
[app.main.features.pointer-map :as fpmap]
[app.main.repo :as rp]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[frontend-tests.helpers.async :as a]
[frontend-tests.helpers.mock :as mock]))
(def ^:private file-id (uuid/custom 10 10))
(def ^:private frag-id (uuid/custom 20 20))
(def ^:private page-id (uuid/custom 30 30))
(def ^:private fragment-content {:objects {}})
(defn- file-with-pointers
[]
{:id file-id
:data {:options {}
:components (tr/->Pointer frag-id {})
:pages-index {page-id (tr/->Pointer frag-id {})}}})
(defn- cmd-stub
[respond]
(mock/stub
(fn
([command] (respond command nil))
([command params] (respond command params)))))
(t/deftest ^:async resolve-file-resolves-all-fragments
(let [seen (atom nil)]
(await
(mock/with-mocks*
{rp/cmd! (cmd-stub (fn [command _params]
(t/is (= :get-file-fragment command))
(rx/of {:data fragment-content})))}
(await (a/observe (fpmap/resolve-file (file-with-pointers))
:on-next #(reset! seen %)))))
(t/is (some? @seen))
(t/is (= fragment-content (get-in @seen [:data :components])))
(t/is (= fragment-content (get-in @seen [:data :pages-index page-id])))))
(t/deftest ^:async resolve-viewer-fragment-rejects-with-original-cause
(let [failure (ex-info "fragment exploded" {})
seen (atom ::none)
caught (atom nil)]
(await
(mock/with-mocks*
{rp/cmd! (cmd-stub (fn [_command _params] (rx/throw failure)))}
(await (a/observe (dv/resolve-viewer-fragment file-id nil [:k (tr/->Pointer frag-id {})])
:on-next #(reset! seen %)
:on-error #(reset! caught %)))))
(t/is (= ::none @seen))
(t/is (= failure @caught))))
(t/deftest ^:async resolve-viewer-fragment-pairs-key-with-data
(let [seen (atom ::none)]
(await
(mock/with-mocks*
{rp/cmd! (cmd-stub (fn [command params]
(t/is (= :get-file-fragment command))
(t/is (= {:file-id file-id :fragment-id frag-id} params))
(rx/of {:data fragment-content})))}
(await (a/observe (dv/resolve-viewer-fragment file-id nil [:k (tr/->Pointer frag-id {})])
:on-next #(reset! seen %)))))
(t/is (= [:k fragment-content] @seen))))
(t/deftest ^:async resolve-viewer-fragment-forwards-share-id
(let [share-id (uuid/custom 40 40)
seen (atom ::none)]
(await
(mock/with-mocks*
{rp/cmd! (cmd-stub (fn [command params]
(t/is (= :get-file-fragment command))
(t/is (= {:file-id file-id :fragment-id frag-id :share-id share-id} params))
(rx/of {:data fragment-content})))}
(await (a/observe (dv/resolve-viewer-fragment file-id share-id [:k (tr/->Pointer frag-id {})])
:on-next #(reset! seen %)))))
(t/is (= [:k fragment-content] @seen))))
(t/deftest ^:async resolve-file-rejects-unresolved-leftover-pointer
;; A resolved fragment whose content is itself a pointer means the
;; data still holds an unresolvable reference after the merge: the
;; stream must reject with the local ex-info (not the transport
;; cause), and deliver nothing.
(let [seen (atom ::none)
caught (atom nil)]
(await
(mock/with-mocks*
{rp/cmd! (cmd-stub (fn [_command _params]
(rx/of {:data (tr/->Pointer frag-id {})})))}
(await (a/observe (fpmap/resolve-file (file-with-pointers))
:on-next #(reset! seen %)
:on-error #(reset! caught %)))))
(t/is (= ::none @seen))
(t/is (some? @caught))
(let [data (ex-data @caught)]
(t/is (= file-id (:file-id data)))
(t/is (seq (:keys data))))))
(t/deftest ^:async resolve-file-rejects-on-fragment-failure
(let [failure (ex-info "fragment exploded" {})
seen (atom ::none)
caught (atom nil)]
(await
(mock/with-mocks*
{rp/cmd! (cmd-stub (fn [_command _params] (rx/throw failure)))}
(await (a/observe (fpmap/resolve-file (file-with-pointers))
:on-next #(reset! seen %)
:on-error #(reset! caught %)))))
;; The page is never delivered half-resolved and the original cause
;; propagates instead of being swallowed.
(t/is (= ::none @seen))
(t/is (= failure @caught))))

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

@ -21,6 +21,7 @@
[frontend-tests.data.nitrate-test]
[frontend-tests.data.persistence-retry-test]
[frontend-tests.data.persistence-test]
[frontend-tests.data.pointer-map-test]
[frontend-tests.data.profile-test]
[frontend-tests.data.repo-test]
[frontend-tests.data.store-test]
@ -188,6 +189,7 @@
'frontend-tests.data.nitrate-test
'frontend-tests.data.persistence-retry-test
'frontend-tests.data.persistence-test
'frontend-tests.data.pointer-map-test
'frontend-tests.data.profile-test
'frontend-tests.data.repo-test
'frontend-tests.data.store-test