diff --git a/.serena/memories/backend/subtleties.md b/.serena/memories/backend/subtleties.md index a3cf848ace..b6c3c9afb3 100644 --- a/.serena/memories/backend/subtleties.md +++ b/.serena/memories/backend/subtleties.md @@ -91,7 +91,13 @@ - 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 and migration set, and restoring it leaves the next read to migrate the file. +- 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; `file-snapshots/reduce-snapshots` already binds its loader while walking snapshot content. - `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. diff --git a/backend/src/app/binfile/common.clj b/backend/src/app/binfile/common.clj index 170a514704..111db69183 100644 --- a/backend/src/app/binfile/common.clj +++ b/backend/src/app/binfile/common.clj @@ -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 diff --git a/backend/src/app/features/fdata.clj b/backend/src/app/features/fdata.clj index 43484a696b..d18da11ea6 100644 --- a/backend/src/app/features/fdata.clj +++ b/backend/src/app/features/fdata.clj @@ -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)))))) + diff --git a/backend/src/app/features/file_snapshots.clj b/backend/src/app/features/file_snapshots.clj index 14ad5ffad0..ff93eef02b 100644 --- a/backend/src/app/features/file_snapshots.clj +++ b/backend/src/app/features/file_snapshots.clj @@ -22,6 +22,7 @@ [app.jobs :as jobs] [app.storage :as sto] [app.util.blob :as blob] + [app.util.pointer-map :as pmap] [cuerdas.core :as str])) (def sql:snapshots @@ -376,8 +377,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,13 +447,20 @@ (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) + load (partial fdata/load-pointer cfg file-id) xform (comp (map (partial fdata/resolve-file-data cfg)) (map (partial fdata/decode-file-data cfg)) xform)] - (->> (db/plan conn [sql:get-snapshots file-id] {:fetch-size 1}) - (transduce xform f init)))) + (binding [pmap/*load-fn* load] + (->> (db/plan conn [sql:get-snapshots file-id] {:fetch-size 1}) + (transduce xform f init))))) diff --git a/backend/src/app/rpc/commands/comments.clj b/backend/src/app/rpc/commands/comments.clj index fbd460cbb2..c45c06bb97 100644 --- a/backend/src/app/rpc/commands/comments.clj +++ b/backend/src/app/rpc/commands/comments.clj @@ -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 diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj index d538563ad6..4b33b32100 100644 --- a/backend/src/app/rpc/commands/files.clj +++ b/backend/src/app/rpc/commands/files.clj @@ -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) diff --git a/backend/src/app/rpc/commands/files_create.clj b/backend/src/app/rpc/commands/files_create.clj index 23959989af..368f480ec7 100644 --- a/backend/src/app/rpc/commands/files_create.clj +++ b/backend/src/app/rpc/commands/files_create.clj @@ -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} diff --git a/backend/src/app/rpc/commands/files_snapshot.clj b/backend/src/app/rpc/commands/files_snapshot.clj index 032266a8d5..af3494c935 100644 --- a/backend/src/app/rpc/commands/files_snapshot.clj +++ b/backend/src/app/rpc/commands/files_snapshot.clj @@ -13,6 +13,7 @@ [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] @@ -66,9 +67,14 @@ ;; 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. + (let [base-file (bfc/get-file cfg file-id :load-data? false) + data (fdata/realize-pointers cfg file-id (:data snapshot))] (-> base-file - (assoc :data (:data snapshot)) + (assoc :data data) (assoc :version (:version snapshot)) (assoc :features (:features snapshot)) (assoc :revn (:revn snapshot)) @@ -84,10 +90,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 +133,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))))) diff --git a/backend/src/app/rpc/commands/files_thumbnails.clj b/backend/src/app/rpc/commands/files_thumbnails.clj index f156cae1bd..6c5fbc206a 100644 --- a/backend/src/app/rpc/commands/files_thumbnails.clj +++ b/backend/src/app/rpc/commands/files_thumbnails.clj @@ -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) diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index 85a0a58b1f..99ea623b82 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -35,7 +35,6 @@ [app.rpc.doc :as-alias doc] [app.rpc.helpers :as rph] [app.util.blob :as blob] - [app.util.pointer-map :as pmap] [app.util.services :as sv] [clojure.set :as set])) @@ -255,8 +254,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 @@ -363,11 +361,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. @@ -375,8 +375,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] @@ -391,6 +392,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 @@ -401,11 +407,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))) @@ -480,7 +486,7 @@ (finally (record-validation-timing cfg :process-changes-ms "process-changes" (inst-ms (tproc)))))] - (binding [pmap/*tracked* nil] + (fdata/with-untracked (when (contains? cf/flags :soft-file-validation) (let [t (ct/tpoint)] (try diff --git a/backend/src/app/tasks/file_gc.clj b/backend/src/app/tasks/file_gc.clj index 3d77b21045..c8b2e41870 100644 --- a/backend/src/app/tasks/file_gc.clj +++ b/backend/src/app/tasks/file_gc.clj @@ -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?)))) diff --git a/backend/src/app/util/pointer_map.clj b/backend/src/app/util/pointer_map.clj index c8384480ce..75effbee5a 100644 --- a/backend/src/app/util/pointer_map.clj +++ b/backend/src/app/util/pointer_map.clj @@ -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 diff --git a/backend/test/backend_tests/binfile_test.clj b/backend/test/backend_tests/binfile_test.clj index 2043ad6a19..0337a30825 100644 --- a/backend/test/backend_tests/binfile_test.clj +++ b/backend/test/backend_tests/binfile_test.clj @@ -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))))) diff --git a/backend/test/backend_tests/file_pointer_snapshot_test.clj b/backend/test/backend_tests/file_pointer_snapshot_test.clj new file mode 100644 index 0000000000..5ca42b5d4d --- /dev/null +++ b/backend/test/backend_tests/file_pointer_snapshot_test.clj @@ -0,0 +1,919 @@ +;; 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.file-pointer-snapshot-test + "Snapshots share fragment rows with the live file (fdata/pointer-map), + so file-gc must keep fragments referenced by any live snapshot." + (:require + [app.binfile.common :as bfc] + [app.common.features :as cfeat] + [app.common.files.migrations :as fmg] + [app.common.time :as ct] + [app.common.types.objects-map :as omap] + [app.common.types.shape :as cts] + [app.common.uuid :as uuid] + [app.db :as db] + [app.features.fdata :as fdata] + [app.features.file-snapshots :as fsnap] + [app.rpc :as-alias rpc] + [app.util.blob :as blob] + [app.util.pointer-map :as pmap] + [backend-tests.helpers :as th] + [clojure.test :as t])) + +(t/use-fixtures :once th/state-init) +(t/use-fixtures :each th/database-reset) + +(defn- update-file! + [& {:keys [profile-id file-id changes revn] :or {revn 0}}] + (let [params {::th/type :update-file + ::rpc/profile-id profile-id + :id file-id + :session-id (uuid/random) + :revn revn + :vern 0 + :features cfeat/supported-features + :changes changes} + out (th/command! params)] + (t/is (nil? (:error out))) + (:result out))) + +(defn- fragment-rows + [file-id] + (th/db-query :file-data {:file-id file-id :type "fragment"})) + +(defn- live-fragment-ids + [file-id] + (into #{} (map :id) (filter #(nil? (:deleted-at %)) (fragment-rows file-id)))) + +(defn- add-rect-change + [page-id shape-id] + [{: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})}]) + +(defn- add-rect-changes + [page-id n] + (mapv #(first (add-rect-change page-id %)) (repeatedly n uuid/random))) + +(defn- page-pointer-ids + [file-id & {:as opts}] + (let [f (apply bfc/get-file th/*system* file-id (mapcat identity opts))] + (into {} (map (fn [[pid p]] [pid (pmap/get-id p)])) + (:pages-index (:data f))))) + +(defn- fragment-objects + [file-id fragment-id] + (some-> (th/db-get :file-data {:file-id file-id + :id fragment-id + :type "fragment"}) + :data blob/decode :objects)) + +(defn- snapshots-by-revn + [file-id revn] + (th/db-exec! ["select id, label, revn from file_change + where file_id = ? and label is not null and revn = ?" + file-id revn])) + +(t/deftest snapshot-shares-fragments-without-duplicates + (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) + before (live-fragment-ids file-id)] + (t/is (pos? (count before))) + + (let [f0 (bfc/get-file th/*system* file-id) + snapshot (fsnap/create! th/*system* f0 {:profile-id (:id profile)}) + after (live-fragment-ids file-id)] + ;; No new fragment rows: the snapshot reuses the live ones. + (t/is (= before after)) + (t/is (some? (:id snapshot))) + + ;; Snapshot pointers are a subset of the live pointers. + (let [main-ids (fdata/get-used-pointer-ids (:data f0)) + snap (fsnap/get-snapshot th/*system* file-id (:id snapshot)) + snap-ids (fdata/get-used-pointer-ids (:data snap))] + (t/is (pos? (count snap-ids))) + (t/is (every? #(contains? main-ids %) snap-ids)))))) + +(t/deftest gc-keeps-fragments-referenced-by-live-snapshot + (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) + f0 (bfc/get-file th/*system* file-id) + page-id (first (:pages (:data f0))) + snap (fsnap/create! th/*system* f0 {:profile-id (:id profile)}) + old-ids (fdata/get-used-pointer-ids (:data f0))] + + ;; Modify the page: its fragment id changes, the old row is now only + ;; referenced by the snapshot. + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change page-id (uuid/random))) + + (let [f1 (bfc/get-file th/*system* file-id) + new-ids (fdata/get-used-pointer-ids (:data f1)) + orphan (first (remove #(contains? new-ids %) old-ids))] + (t/is (some? orphan)) + + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + + ;; The old fragment is still alive because the snapshot needs it. + (let [rows (fragment-rows file-id) + row (first (filter #(= orphan (:id %)) rows))] + (t/is (some? row)) + (t/is (nil? (:deleted-at row)))) + + ;; The snapshot still restores the pre-change content. + (let [snap-data (:data (fsnap/get-snapshot th/*system* file-id (:id snap))) + snap-ids (fdata/get-used-pointer-ids snap-data)] + (t/is (contains? snap-ids orphan)))))) + +(t/deftest snapshot-release-frees-fragments + ;; Full pin-release lifecycle through the real paths: the replaced + ;; fragment stays alive while the snapshot exists, and the next + ;; file-gc after deleting + purging the snapshot marks it. + ;; Note: every update takes an automatic snapshot, so besides the + ;; manual one there is also an automatic snapshot of the same state; + ;; the release phase deletes all of them. + (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) + f0 (bfc/get-file th/*system* file-id) + page-id (first (:pages (:data f0)))] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change page-id (uuid/random))) + + (let [f1 (bfc/get-file th/*system* file-id) + snap (fsnap/create! th/*system* f1 {:profile-id (:id profile)})] + (t/is (uuid? (:id snap))) + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 1 + :changes (add-rect-change page-id (uuid/random))) + + (let [f2 (bfc/get-file th/*system* file-id) + new-ids (fdata/get-used-pointer-ids (:data f2)) + old-ids (fdata/get-used-pointer-ids (:data f1)) + orphan (first (remove #(contains? new-ids %) old-ids))] + (t/is (some? orphan)) + + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (nil? (:deleted-at (first (filter #(= orphan (:id %)) + (fragment-rows file-id)))))) + + ;; Every update takes an automatic snapshot and each of them may + ;; share the orphan, so release all of them through the real + ;; path: delete! submits a :delete-object job per snapshot that + ;; marks both its file_change and its file_data rows as deleted. + (doseq [{:keys [id]} (filter #(some? (:label %)) + (th/db-query :file-change {:file-id file-id}))] + (fsnap/delete! th/*system* {:id id + :file-id file-id + :deleted-at (ct/minus (ct/now) {:hours 1})})) + (th/run-pending-jobs) + (t/is (pos? (:processed (th/run-task! :objects-gc {})))) + + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (let [row (first (filter #(= orphan (:id %)) (fragment-rows file-id)))] + (t/is (some? row)) + (t/is (some? (:deleted-at row)))))))) + +(t/deftest file-gc-is-idempotent-on-unchanged-file + ;; A file-gc pass over an unchanged file must not create fragment + ;; rows nor mark any: unchanged pages keep their ids. + (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) + before (live-fragment-ids file-id)] + (t/is (pos? (count before))) + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (let [after-first (live-fragment-ids file-id)] + (t/is (= before after-first)) + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (= after-first (live-fragment-ids file-id))) + (t/is (every? #(nil? (:deleted-at %)) (fragment-rows file-id)))))) + +(t/deftest gc-marks-fragments-without-live-reference + (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) + f0 (bfc/get-file th/*system* file-id) + page-id (first (:pages (:data f0))) + old-ids (fdata/get-used-pointer-ids (:data f0))] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change page-id (uuid/random))) + + (let [f1 (bfc/get-file th/*system* file-id) + new-ids (fdata/get-used-pointer-ids (:data f1)) + orphan (first (remove #(contains? new-ids %) old-ids))] + (t/is (some? orphan)) + ;; The update above may have left an automatic snapshot sharing the + ;; replaced fragment; drop snapshot rows first so the fragment is + ;; really unreferenced (same cleanup the rpc-file-test fragment + ;; test performs before asserting GC marking). + (th/db-delete! :file-change {:file-id file-id}) + (th/db-delete! :file-data {:file-id file-id :type "snapshot"}) + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (let [row (first (filter #(= orphan (:id %)) (fragment-rows file-id)))] + (t/is (some? row)) + (t/is (some? (:deleted-at row))))))) + +(t/deftest pointer-context-contract + ;; The invariant the whole backend relies on: a pointer can only be + ;; derefed while a loader is bound; with-pointers binds the loader + ;; for the given file. + (let [pointer (pmap/create (uuid/next) {})] + (t/is (thrown? UnsupportedOperationException (deref pointer))) + (fdata/with-pointers th/*system* (uuid/random) + (try + (deref pointer) + (t/is false "expected a fragment-not-found error") + (catch clojure.lang.ExceptionInfo cause + (t/is (= :fragment-not-found (:code (ex-data cause))))))))) + +(t/deftest restore-returns-snapshot-content + ;; Snapshot, modify the page so the old fragment is snapshot-only, + ;; restore, and compare fully resolved content with the snapshot. + (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) + f0 (bfc/get-file th/*system* file-id) + snap (fsnap/create! th/*system* f0 {:profile-id (:id profile)})] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change + (first (:pages (:data f0))) + (uuid/random))) + + (db/tx-run! th/*system* + (fn [cfg] (fsnap/restore! cfg file-id (:id snap)))) + + (let [snap-data (:data (fsnap/get-snapshot th/*system* file-id (:id snap))) + snap-content (:data (fdata/realize th/*system* + {:id file-id :data snap-data})) + live-content (:data (bfc/get-file th/*system* file-id + :realize? true))] + (t/is (= snap-content live-content))))) + +(t/deftest migrating-save-keeps-snapshot-on-pre-save-content + ;; A save that triggers a file migration must attach the automatic + ;; snapshot before migrating. Otherwise the migration gives the page + ;; pointer a fresh id and `modified?`, the save's change `assoc`s on + ;; that same pointer (which then keeps its id) and the snapshot ends + ;; up naming the fragment the save writes with the post-save content. + (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-a (uuid/random) + page-b (uuid/random) + shape-1 (uuid/random) + shape-2 (uuid/random)] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes [{:type :add-page :name "a" :id page-a} + {:type :add-page :name "b" :id page-b}]) + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 1 + :changes (add-rect-change page-a shape-1)) + + ;; Force a pending migration on the next save: drop one applied + ;; migration row so `need-migration?` is true again. + (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 2 + :changes (add-rect-change page-a shape-2)) + + (let [snapshot (first (snapshots-by-revn file-id 2)) + snap-data (:data (fsnap/get-snapshot th/*system* file-id (:id snapshot))) + snap-id (pmap/get-id (get-in snap-data [:pages-index page-a])) + main-id (pmap/get-id (get-in (:data (bfc/get-file th/*system* file-id)) + [:pages-index page-a])) + snap-objs (:objects (blob/decode + (:data (th/db-get :file-data {:file-id file-id + :id snap-id + :type "fragment"}))))] + + (t/is (uuid? (:id snapshot))) + ;; The snapshot must not share the fragment the save rewrites. + (t/is (not= snap-id main-id)) + (t/is (contains? snap-objs shape-1)) + (t/is (not (contains? snap-objs shape-2))) + + ;; Restoring it gives the pre-save page on a fully migrated file. + (let [out (th/command! {::th/type :restore-file-snapshot + ::rpc/profile-id (:id profile) + :file-id file-id + :id (:id snapshot)}) + restored (bfc/get-file th/*system* file-id :realize? true) + objects (get-in restored [:data :pages-index page-a :objects])] + (t/is (nil? (:error out))) + (t/is (contains? objects shape-1)) + (t/is (not (contains? objects shape-2))) + (t/is (not (fmg/need-migration? restored))))))) + +(t/deftest offload-keeps-fragment-semantics + ;; Every file_data row (main, snapshot, fragments) moves to storage + ;; without changing ids, and reads keep working. + (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) + f0 (bfc/get-file th/*system* file-id) + snap (fsnap/create! th/*system* f0 {:profile-id (:id profile)}) + _ (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change + (first (:pages (:data f0))) + (uuid/random))) + before (into {} (map (juxt :id identity)) + (th/db-query :file-data {:file-id file-id})) + ;; Snapshot rows are born with a future deleted-at (they expire), + ;; and offload only moves rows with deleted-at IS NULL. + live-before (into {} (filter (comp nil? :deleted-at val)) before) + main-before (fdata/get-used-pointer-ids + (:data (bfc/get-file th/*system* file-id)))] + (t/is (pos? (count before))) + (t/is (every? #(= "db" (:backend %)) (vals before))) + + (let [result (th/run-task! :offload-file-data {:file-id file-id})] + (t/is (zero? (:skipped result))) + (t/is (= (count live-before) (:offloaded result)))) + + (let [after (into {} (map (juxt :id identity)) + (th/db-query :file-data {:file-id file-id})) + live-after (into {} (filter (comp nil? :deleted-at val)) after)] + (t/is (= (set (keys live-before)) (set (keys live-after)))) + (t/is (every? #(= "storage" (:backend %)) (vals live-after))) + ;; Same pointers after the move, and the shared snapshot loads. + (t/is (= main-before + (fdata/get-used-pointer-ids + (:data (bfc/get-file th/*system* file-id))))) + (t/is (some? (:data (fsnap/get-snapshot th/*system* file-id (:id snap)))))))) + +(t/deftest gc-reattaches-unchanged-pages-and-marks-orphan + ;; No-churn boundary when content changes: modify exactly one page of + ;; a two-page file and run file-gc. Unmodified pages must keep their + ;; fragment ids (reattach), the replaced fragment must be marked, a + ;; follow-up objects-gc must purge only that row, and the live file + ;; must still resolve fully. + (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) + f0 (bfc/get-file th/*system* file-id) + page-1 (first (:pages (:data f0))) + page-2 (uuid/next) + shape-2 (uuid/random)] + ;; Second page so "unchanged" has a witness. + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes [{:type :add-page + :name "second" + :id page-2} + {:type :add-obj + :page-id page-2 + :id shape-2 + :parent-id uuid/zero + :frame-id uuid/zero + :components-v2 true + :obj (cts/setup-shape + {:id shape-2 + :name "rect" + :frame-id uuid/zero + :parent-id uuid/zero + :type :rect})}]) + (let [f1 (bfc/get-file th/*system* file-id) + pages-1 (:pages-index (:data f1)) + id-1-before (pmap/get-id (get pages-1 page-1)) + id-2-before (pmap/get-id (get pages-1 page-2))] + (t/is (some? id-1-before)) + (t/is (some? id-2-before)) + (t/is (not= id-1-before id-2-before)) + ;; Modify exactly page-1. + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 1 + :changes (add-rect-change page-1 (uuid/random))) + (let [f2 (bfc/get-file th/*system* file-id) + pages-2 (:pages-index (:data f2)) + id-1-after (pmap/get-id (get pages-2 page-1)) + id-2-after (pmap/get-id (get pages-2 page-2)) + orphan id-1-before] + (t/is (not= id-1-before id-1-after)) + (t/is (= id-2-before id-2-after)) + ;; Updates take automatic snapshots that would pin the orphan; + ;; drop them so it is really unreferenced (same cleanup the + ;; gc-marks test performs before asserting marking). + (th/db-delete! :file-change {:file-id file-id}) + (th/db-delete! :file-data {:file-id file-id :type "snapshot"}) + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + ;; Unchanged page kept its id through the pass. + (let [f3 (bfc/get-file th/*system* file-id) + pages-3 (:pages-index (:data f3))] + (t/is (= id-2-after (pmap/get-id (get pages-3 page-2))))) + ;; Orphan marked, nothing else touched. + (let [rows (fragment-rows file-id) + marked (filter #(some? (:deleted-at %)) rows)] + (t/is (= 1 (count marked))) + (t/is (= orphan (:id (first marked))))) + ;; objects-gc purges exactly the orphan row. + (t/is (pos? (:processed (th/run-task! :objects-gc {})))) + (let [rows (fragment-rows file-id)] + (t/is (nil? (some #(= orphan (:id %)) rows))) + (t/is (= #{id-1-after id-2-after} (live-fragment-ids file-id)))) + ;; Live file still resolves fully. + (let [live (:data (bfc/get-file th/*system* file-id :realize? true))] + (t/is (empty? (fdata/get-used-pointer-ids live)))))))) + +(t/deftest snapshot-preview-resolves-after-offload + ;; The preview path must resolve fragments that now live in the + ;; storage backend, not just in db. + (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) + f0 (bfc/get-file th/*system* file-id) + snap (fsnap/create! th/*system* f0 {:profile-id (:id profile)})] + (t/is (uuid? (:id snap))) + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change + (first (:pages (:data f0))) + (uuid/random))) + (let [result (th/run-task! :offload-file-data {:file-id file-id})] + (t/is (zero? (:skipped result))) + (t/is (pos? (:offloaded result)))) + (let [out (th/command! {::th/type :get-file-snapshot + ::rpc/profile-id (:id profile) + :file-id file-id + :id (:id snap) + :features cfeat/supported-features})] + (t/is (nil? (:error out))) + (t/is (empty? (fdata/get-used-pointer-ids + (get-in out [:result :data]))))))) + +(t/deftest with-tracked-tracks-and-fails-loud-without-loader + ;; Direct pin of the with-tracked contract: wrapping tracks the new + ;; pointer, and a pointer that needs loading raises loudly because + ;; no loader is bound. (`wrap` carries its value inline so it + ;; derefs fine; `create` with an id starts unloaded, so it must + ;; load — and there is nothing to load from.) + (fdata/with-tracked + (let [wrapped (pmap/wrap {:a 1}) + unloaded (pmap/create (uuid/next) {})] + (t/is (pmap/pointer-map? wrapped)) + (t/is (pmap/pointer-map? unloaded)) + (t/is (contains? @pmap/*tracked* (pmap/get-id wrapped))) + (t/is (contains? @pmap/*tracked* (pmap/get-id unloaded))) + (t/is (= {:a 1} @wrapped)) + (t/is (thrown? UnsupportedOperationException @unloaded))))) \n +(t/deftest legacy-snapshot-does-not-break-liveness + ;; Snapshots written before the feature carry materialized data in + ;; file_change.data (backend "legacy-db") instead of a file_data row. + ;; file-gc must scan them without failing, and the legacy preview must + ;; still resolve. Setup pins the legacy shape: file_change row with + ;; data, no file_data snapshot row. + (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) + f0 (bfc/get-file th/*system* file-id) + page-id (first (:pages (:data f0)))] + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change page-id (uuid/random))) + ;; Drop every snapshot row so only the manual one below exists. + (th/db-delete! :file-change {:file-id file-id}) + (th/db-delete! :file-data {:file-id file-id :type "snapshot"}) + (let [f1 (bfc/get-file th/*system* file-id) + snap (fsnap/create! th/*system* f1 {:profile-id (:id profile)}) + snap-id (:id snap) + realized (:data (fdata/realize th/*system* {:id file-id :data (:data (fsnap/get-snapshot th/*system* file-id snap-id))}))] + ;; Convert to the legacy shape: materialize into file_change.data, + ;; drop the file_data snapshot row. + (th/db-delete! :file-data {:file-id file-id :type "snapshot"}) + (th/db-update! :file-change {:data (blob/encode realized)} {:id snap-id}) + ;; Pin the legacy shape: data on file_change, no file_data row. + ;; (db-get filters rows with deleted_at set, and system snapshots + ;; carry a future one, so opt out of that filter explicitly.) + (t/is (nil? (seq (th/db-query :file-data {:file-id file-id :type "snapshot"})))) + (t/is (some? (:data (th/db-get :file-change {:id snap-id} {::db/remove-deleted false}))))) + ;; file-gc scans the legacy snapshot without failing... + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + ;; ...the live file still resolves fully... + (let [live (:data (bfc/get-file th/*system* file-id :realize? true))] + (t/is (empty? (fdata/get-used-pointer-ids live)))) + ;; ...and the legacy preview resolves with no leftover pointers. + (let [snap-data (:data (fsnap/get-snapshot th/*system* file-id + (->> (th/db-query :file-change {:file-id file-id}) + (filter #(some? (:data %))) + (first) + (:id))))] + (t/is (some? snap-data)) + (t/is (empty? (fdata/get-used-pointer-ids snap-data)))))) + +(t/deftest offload-edit-gc-cycle-keeps-liveness + ;; Full cycle on one file: offload to cold storage, edit (which brings + ;; rows back hot), file-gc. Liveness must stay correct throughout and + ;; the file must resolve fully at the end. (R1's fix is what lets + ;; metadata-bearing files survive the first step; this file carries no + ;; metadata, so the cycle also passes without 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) + f0 (bfc/get-file th/*system* file-id) + page-id (first (:pages (:data f0))) + before (into {} (map (juxt :id identity)) + (th/db-query :file-data {:file-id file-id}))] + (t/is (pos? (count before))) + (let [result (th/run-task! :offload-file-data {:file-id file-id})] + (t/is (zero? (:skipped result))) + (t/is (pos? (:offloaded result)))) + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change page-id (uuid/random))) + ;; The edit wrote hot rows back: some file_data is db-backed again. + (t/is (pos? (count (filter #(= "db" (:backend %)) + (th/db-query :file-data {:file-id file-id}))))) + (th/db-delete! :file-change {:file-id file-id}) + (th/db-delete! :file-data {:file-id file-id :type "snapshot"}) + (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (let [live (:data (bfc/get-file th/*system* file-id :realize? true))] + (t/is (empty? (fdata/get-used-pointer-ids live)))) + ;; Every referenced fragment is live. + (let [used (fdata/get-used-pointer-ids (:data (bfc/get-file th/*system* file-id))) + live (live-fragment-ids file-id)] + (t/is (pos? (count used))) + (t/is (every? live used))))) + +(t/deftest save-keeps-untouched-page-fragments + ;; A save must not rewrite the fragments of pages it does not touch, + ;; even when the page's :objects map is a hash map (45 shapes), the + ;; page itself has more than 8 keys (PersistentHashMap) and the + ;; :pages-index is a hash map (9 pages). Re-assoc with an identical + ;; value keeps map and pointer identity in array and hash maps alike. + (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-a (uuid/random) + others (vec (repeatedly 8 uuid/random)) + page-b (first others) + guide (uuid/random) + flow (uuid/random) + thread (uuid/random)] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (into [{:type :add-page :name "a" :id page-a}] + (map-indexed (fn [i pid] + {:type :add-page + :name (str "p" i) + :id pid}) + others))) + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 1 + :changes (into [{:type :mod-page + :id page-a + :background "#ffffff" + :background-token "token" + :pixel-grid-color "#000000" + :pixel-grid-opacity 0.5} + {:type :set-plugin-data + :object-type :page + :object-id page-a + :page-id page-a + :namespace "probe" + :key "k" + :value "1"} + {:type :set-guide + :page-id page-a + :id guide + :params {:id guide :axis :x :position 10}} + {:type :set-flow + :page-id page-a + :id flow + :params {:id flow + :name "flow" + :starting-frame uuid/zero}} + {:type :set-comment-thread-position + :page-id page-a + :comment-thread-id thread + :frame-id uuid/zero + :position {:x 10 :y 10}}] + (add-rect-changes page-a 45))) + + (let [ids-before (page-pointer-ids file-id) + page (fdata/with-pointers th/*system* file-id + (deref (get-in (:data (bfc/get-file th/*system* file-id)) + [:pages-index page-a])))] + + ;; The page is a hash map and its objects map is a hash map: the + ;; scenario the churn suspicion was about. + (t/is (instance? clojure.lang.PersistentHashMap page)) + (t/is (= 46 (count (:objects page)))) + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 2 + :changes (add-rect-change page-b (uuid/random))) + + (let [ids-after (page-pointer-ids file-id)] + (t/is (= (get ids-before page-a) (get ids-after page-a))) + (t/is (not= (get ids-before page-b) (get ids-after page-b)))) + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 3 + :changes (add-rect-change page-b (uuid/random))) + + (t/is (= (get ids-before page-a) + (get (page-pointer-ids file-id) page-a)))))) + +(t/deftest objects-map-flip-leaves-unloaded-pages-until-edited + ;; A data-level flip of `fdata/objects-map` does not rewrite pages the + ;; save does not load: `enable-objects-map` skips unloaded pointers, so + ;; the page keeps its plain fragment until it is edited. The first edit + ;; wraps it once and later saves keep the new id. + (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-a (uuid/random) + page-b (uuid/random)] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (into [{:type :add-page :name "a" :id page-a} + {:type :add-page :name "b" :id page-b}] + (add-rect-changes page-a 45))) + + ;; Simulate a file created with pointer-map only: strip the objects + ;; maps, drop the feature and persist through the same encode path. + (db/tx-run! th/*system* + (fn [cfg] + (fdata/with-tracked-pointers cfg file-id + (let [file (bfc/get-file cfg file-id) + file (fdata/disable-objects-map file)] + (bfc/update-file! cfg file))))) + + (let [page-plain (get (page-pointer-ids file-id) page-a)] + (t/is (not (omap/objects-map? (fragment-objects file-id page-plain)))) + + ;; Add the feature at data level, the way a migration would. + (th/db-exec! ["update file + set features = array_append(features, 'fdata/objects-map') + where id = ?" + file-id]) + + ;; A save on another page must leave the unloaded page alone. + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 1 + :changes (add-rect-change page-b (uuid/random))) + + (t/is (= page-plain (get (page-pointer-ids file-id) page-a))) + (t/is (not (omap/objects-map? (fragment-objects file-id page-plain)))) + + ;; The first edit of page A loads it and wraps it once. + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 2 + :changes (add-rect-change page-a (uuid/random))) + + (let [page-wrapped (get (page-pointer-ids file-id) page-a)] + (t/is (not= page-plain page-wrapped)) + (t/is (omap/objects-map? (fragment-objects file-id page-wrapped))) + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 3 + :changes (add-rect-change page-b (uuid/random))) + + ;; Converged: no further rewrite. + (t/is (= page-wrapped (get (page-pointer-ids file-id) page-a))))))) + +(t/deftest save-loads-only-edited-page + ;; With objects-map enabled, encoding a save must not load the + ;; fragments of pages the change does not touch: each fragment was + ;; already wrapped when it was written. A three-page file with a + ;; one-page edit loads exactly one fragment (the edited page). + (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) + f0 (bfc/get-file th/*system* file-id) + page-1 (first (:pages (:data f0))) + page-2 (uuid/random) + page-3 (uuid/random)] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes [{:type :add-page :name "b" :id page-2} + {:type :add-page :name "c" :id page-3} + (first (add-rect-change page-2 (uuid/random)))]) + + (let [loads (atom 0) + load fdata/load-pointer] + (with-redefs [fdata/load-pointer + (fn [cfg file-id id] + (swap! loads inc) + (load cfg file-id id))] + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 1 + :changes (add-rect-change page-2 (uuid/random)))) + + (t/is (= 1 @loads)) + + (let [ids (page-pointer-ids file-id)] + (t/is (some? (get ids page-1))) + (t/is (some? (get ids page-3))))))) + +(t/deftest restore-does-not-load-shared-pages + ;; Restoring a snapshot reuses the shared fragments; encoding the + ;; restored file must not load the pages it does not change. + (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-1 (first (:pages (:data (bfc/get-file th/*system* file-id)))) + page-2 (uuid/random)] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes [{:type :add-page :name "b" :id page-2} + (first (add-rect-change page-2 (uuid/random)))]) + + (let [f1 (bfc/get-file th/*system* file-id) + snap (fsnap/create! th/*system* f1 {:profile-id (:id profile)}) + page-2-id (get (page-pointer-ids file-id) page-2)] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 1 + :changes (add-rect-change page-1 (uuid/random))) + + (let [loads (atom 0) + load fdata/load-pointer] + (with-redefs [fdata/load-pointer + (fn [cfg file-id id] + (swap! loads inc) + (load cfg file-id id))] + (db/tx-run! th/*system* + (fn [cfg] (fsnap/restore! cfg file-id (:id snap))))) + + (t/is (zero? @loads)) + (t/is (= page-2-id (get (page-pointer-ids file-id) page-2))))))) + +(t/deftest migration-keeps-unchanged-page-fragments + ;; Applying a pending migration on read keeps the fragment ids of the + ;; pages the migration does not change; a page it changes gets a new + ;; id. The caller still receives realized data, not pointers. + (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-a (uuid/random) + page-b (uuid/random) + shape-b (uuid/random)] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes [{:type :add-page :name "a" :id page-a} + {:type :add-page :name "b" :id page-b} + (first (add-rect-change page-a (uuid/random))) + (-> (first (add-rect-change page-b shape-b)) + (update :obj assoc :applied-tokens + {:stroke-width "token"}))]) + + (let [ids-before (page-pointer-ids file-id)] + ;; Force the 0031 migration on the next read. + (th/db-delete! :file-migration + {:file-id file-id + :name "0031-migrate-stroke-width-token-attr"}) + + (let [returned (db/tx-run! th/*system* + (fn [cfg] (bfc/get-file cfg file-id)))] + (t/is (not (pmap/pointer-map? (get-in returned [:data :pages-index page-a])))) + (t/is (not (pmap/pointer-map? (get-in returned [:data :pages-index page-b])))) + (t/is (not (fmg/need-migration? returned))) + + (let [tokens (get-in returned [:data :pages-index page-b + :objects shape-b :applied-tokens])] + (t/is (contains? tokens :stroke-width-top)) + (t/is (not (contains? tokens :stroke-width))))) + + (let [ids-after (page-pointer-ids file-id)] + (t/is (= (get ids-before page-a) (get ids-after page-a))) + (t/is (not= (get ids-before page-b) (get ids-after page-b)))) + + ;; A second read neither migrates nor changes ids again. + (let [ids-after (page-pointer-ids file-id) + returned (db/tx-run! th/*system* + (fn [cfg] (bfc/get-file cfg file-id)))] + (t/is (= ids-after (page-pointer-ids file-id))) + (t/is (not (fmg/need-migration? returned))))))) + +(t/deftest migration-read-only-keeps-fragments-untouched + ;; A read-only migration returns realized data but does not persist: + ;; the stored pointers and the pending migration stay as they were. + (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-1 (first (:pages (:data (bfc/get-file th/*system* file-id))))] + + (update-file! :profile-id (:id profile) + :file-id file-id + :revn 0 + :changes (add-rect-change page-1 (uuid/random))) + + (th/db-delete! :file-migration + {:file-id file-id + :name "0031-migrate-stroke-width-token-attr"}) + + (let [ids-before (page-pointer-ids file-id {:migrate? false}) + returned (db/tx-run! th/*system* + (fn [cfg] (bfc/get-file cfg file-id + :read-only? true)))] + (t/is (not (pmap/pointer-map? (get-in returned [:data :pages-index page-1])))) + (t/is (empty? (th/db-query :file-migration + {:file-id file-id + :name "0031-migrate-stroke-width-token-attr"}))) + (t/is (= ids-before (page-pointer-ids file-id {:migrate? false})))) + + ;; A normal read migrates, and the unchanged page keeps its id. + (let [ids-before (page-pointer-ids file-id {:migrate? false})] + (db/tx-run! th/*system* (fn [cfg] (bfc/get-file cfg file-id))) + (t/is (= ids-before (page-pointer-ids file-id))) + (t/is (seq (th/db-query :file-migration + {:file-id file-id + :name "0031-migrate-stroke-width-token-attr"})))))) diff --git a/backend/test/backend_tests/rpc_file_snapshot_test.clj b/backend/test/backend_tests/rpc_file_snapshot_test.clj index a04e7c407b..025c1dc290 100644 --- a/backend/test/backend_tests/rpc_file_snapshot_test.clj +++ b/backend/test/backend_tests/rpc_file_snapshot_test.clj @@ -6,6 +6,7 @@ (ns backend-tests.rpc-file-snapshot-test (:require + [app.binfile.common :as bfc] [app.common.features :as cfeat] [app.common.pprint :as pp] [app.common.thumbnails :as thc] @@ -15,10 +16,13 @@ [app.config :as cf] [app.db :as db] [app.db.sql :as sql] + [app.features.fdata :as fdata] + [app.features.file-snapshots :as fsnap] [app.http :as http] [app.rpc :as-alias rpc] [app.storage :as sto] [backend-tests.helpers :as th] + [clojure.set :as set] [clojure.test :as t] [cuerdas.core :as str])) @@ -138,6 +142,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 +374,178 @@ ;; (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]))))))))) diff --git a/backend/test/backend_tests/rpc_file_test.clj b/backend/test/backend_tests/rpc_file_test.clj index 2d222f7add..991cea67b0 100644 --- a/backend/test/backend_tests/rpc_file_test.clj +++ b/backend/test/backend_tests/rpc_file_test.clj @@ -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))) diff --git a/backend/test/backend_tests/rpc_file_thumbnails_test.clj b/backend/test/backend_tests/rpc_file_thumbnails_test.clj index 9863c0acbb..6025849773 100644 --- a/backend/test/backend_tests/rpc_file_thumbnails_test.clj +++ b/backend/test/backend_tests/rpc_file_thumbnails_test.clj @@ -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 diff --git a/backend/test/backend_tests/util_pointer_map_test.clj b/backend/test/backend_tests/util_pointer_map_test.clj index ce39715c4b..2b0d98babb 100644 --- a/backend/test/backend_tests/util_pointer_map_test.clj +++ b/backend/test/backend_tests/util_pointer_map_test.clj @@ -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))))))) diff --git a/frontend/src/app/main/data/viewer.cljs b/frontend/src/app/main/data/viewer.cljs index 683bbcf8b9..e90bcfc2eb 100644 --- a/frontend/src/app/main/data/viewer.cljs +++ b/frontend/src/app/main/data/viewer.cljs @@ -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 diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index c8e538560f..7533b71b3d 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -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] diff --git a/frontend/src/app/main/features/pointer_map.cljs b/frontend/src/app/main/features/pointer_map.cljs index 176cbbb8c3..062998791c 100644 --- a/frontend/src/app/main/features/pointer_map.cljs +++ b/frontend/src/app/main/features/pointer_map.cljs @@ -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))))))) diff --git a/frontend/test/frontend_tests/data/pointer_map_test.cljs b/frontend/test/frontend_tests/data/pointer_map_test.cljs new file mode 100644 index 0000000000..8902d6b517 --- /dev/null +++ b/frontend/test/frontend_tests/data/pointer_map_test.cljs @@ -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)))) diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index 5e18876e88..e00a8d7596 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -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] @@ -181,6 +182,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