mirror of
https://github.com/penpot/penpot.git
synced 2026-10-31 15:00:32 +00:00
c1ac1bd4a4
The branch dropped `app.util.pointer-map` from the namespace while the auto-repair path (added to develop before this branch) still rebinds `pmap/*tracked*` around validation and repair in `repair-preexisting-damage` and `process-changes-and-validate`. The namespace did not compile, so the whole backend failed to load. Those toggles do not fit the fdata macros: `with-untracked` binds nil and `with-tracked` creates a fresh atom, while the repair path has to turn tracking off and restore the existing atom (and read it before the repair starts). Restore the require and keep the bindings explicit. Also pin the feature-off path with a test: with `fdata/pointer-map` off (the default), a save creates no fragments, file-gc writes nothing and the snapshot preview still returns plain data. Drop a stray `\n` char literal left at the end of one deftest. Update the memories with the exception to the macro rule, the snapshot FOR SHARE locking and the pre-migration automatic snapshot. Closes #12410 AI-assisted-by: deepseek-v4.1-flash
1006 lines
47 KiB
Clojure
1006 lines
47 KiB
Clojure
;; 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.changes-builder :as pcb]
|
|
[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 features]
|
|
:or {revn 0
|
|
features cfeat/supported-features}}]
|
|
(let [params {::th/type :update-file
|
|
::rpc/profile-id profile-id
|
|
:id file-id
|
|
:session-id (uuid/random)
|
|
:revn revn
|
|
:vern 0
|
|
:features 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)))))
|
|
|
|
(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"}))))))
|
|
|
|
(t/deftest libraries-load-their-pages-with-their-own-loader
|
|
;; Fragment rows are keyed by (file_id, id), and every caller binds the
|
|
;; loader of the file it works on. A library's pages must therefore come
|
|
;; back from the library loader already readable, or the first deref
|
|
;; under the consumer's loader asks the wrong file for the fragment.
|
|
(let [profile (th/create-profile* 1)
|
|
library (th/create-file* 1 {:profile-id (:id profile)
|
|
:project-id (:default-project-id profile)
|
|
:is-shared true})
|
|
file (th/create-file* 2 {:profile-id (:id profile)
|
|
:project-id (:default-project-id profile)
|
|
:is-shared false})
|
|
lib-page (uuid/random)]
|
|
|
|
(th/link-file-to-library* {:file-id (:id file) :library-id (:id library)})
|
|
(update-file! :profile-id (:id profile)
|
|
:file-id (:id library)
|
|
:changes (-> (pcb/empty-changes nil)
|
|
(pcb/with-library-data (:data library))
|
|
(pcb/add-empty-page lib-page "library page")
|
|
(:redo-changes)))
|
|
|
|
;; Precondition: the library stores the page as a fragment pointer.
|
|
(t/is (contains? (page-pointer-ids (:id library)) lib-page))
|
|
|
|
(let [page (db/tx-run! th/*system*
|
|
(fn [cfg]
|
|
(fdata/with-pointers cfg (:id file)
|
|
(let [consumer (bfc/get-file cfg (:id file))
|
|
libs (bfc/get-resolved-file-libraries cfg consumer)]
|
|
(-> (get libs (:id library))
|
|
(get-in [:data :pages-index lib-page])
|
|
(fdata/realize-entry))))))]
|
|
(t/is (= lib-page (:id page)))
|
|
(t/is (contains? (:objects page) uuid/zero)))))
|
|
|
|
(t/deftest feature-off-keeps-plain-snapshots-and-gc
|
|
;; The feature is disabled by default (`fdata/pointer-map` is not in
|
|
;; `cfeat/default-features`, only an explicit flag or team feature
|
|
;; enables it). Pin that the paths this branch touches stay plain for
|
|
;; such a file: a save takes a snapshot without pointers, no fragment
|
|
;; rows appear, file-gc writes nothing, and the preview still resolves.
|
|
(with-redefs [cfeat/get-enabled-features (fn [& _] cfeat/default-features)]
|
|
(let [features (disj cfeat/supported-features
|
|
"fdata/pointer-map"
|
|
"fdata/objects-map")
|
|
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]))]
|
|
|
|
(t/is (not (contains? (:features file) "fdata/pointer-map")))
|
|
(t/is (not (contains? (:features file) "fdata/objects-map")))
|
|
(t/is (empty? (fragment-rows file-id)))
|
|
|
|
(update-file! :profile-id (:id profile)
|
|
:file-id file-id
|
|
:revn 0
|
|
:features features
|
|
:changes (add-rect-change page-id (uuid/random)))
|
|
|
|
(t/is (empty? (fragment-rows file-id)))
|
|
|
|
(let [snapshot (first (snapshots-by-revn file-id 0))
|
|
snap (fsnap/get-snapshot th/*system* file-id (:id snapshot))]
|
|
(t/is (uuid? (:id snapshot)))
|
|
(t/is (empty? (fdata/get-used-pointer-ids (:data snap))))
|
|
(t/is (true? (th/run-task! :file-gc {:file-id file-id})))
|
|
(t/is (empty? (fragment-rows file-id)))
|
|
|
|
(let [out (th/command! {::th/type :get-file-snapshot
|
|
::rpc/profile-id (:id profile)
|
|
:file-id file-id
|
|
:id (:id snapshot)
|
|
:features features})]
|
|
(t/is (nil? (:error out)))
|
|
(t/is (map? (get-in out [:result :data])))
|
|
(t/is (empty? (fdata/get-used-pointer-ids
|
|
(get-in out [:result :data])))))))))
|