github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-11-08 11:04:44 +00:00
Code Issues Packages Projects Releases Wiki Activity
penpot/backend/test/backend_tests/rpc_file_test.clj
Andrey Antukh 93d36d04d8
✨ Stabilize fragmented file data across snapshots and GC (#12420) 
* ✨ Stabilize fragmented file data across snapshots and GC

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

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

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

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

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

Closes #12410

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

♻️ Pin no-churn behavior for untouched pages

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

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

Closes #12410

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

⚡ Stop loading untouched pages when enabling objects-map

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

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

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

Closes #12410

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

⚡ Keep page fragment ids through pending migrations

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

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

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

Closes #12410

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

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

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

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

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

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

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

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

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

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

Closes #12410

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

* 🐛 Validate debug files with their own pointer loader

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

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

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

* ♻️ Bind the snapshot loader through the fdata helper

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

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

* 📚 Note the pointer-binding exceptions and snapshot ordering

Record what the feature review settled:

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

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

* 🐛 Apply pending migrations when previewing a version

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

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

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

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

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

* 🐛 Decode snapshot migrations as an ordered set

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

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

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

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

* 🐛 Fix flaky waiting-gauge assertion in climit test

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

AI-assisted-by: muse-spark-1.3

---------

Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
Co-authored-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
2026-11-02 15:02:55 +01:00

3238 lines
126 KiB
Clojure
Raw Blame History

;; 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.rpc-file-test
(:require
[app.binfile.common :as bfc]
[app.common.features :as cfeat]
[app.common.files.changes-builder :as pcb]
[app.common.files.tokens :as cfo]
[app.common.pprint :as pp]
[app.common.thumbnails :as thc]
[app.common.time :as ct]
[app.common.types.shape :as cts]
[app.common.types.tokens-lib :as ctob]
[app.common.types.tokens-status :as ctos]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.db.sql :as sql]
[app.features.fdata :as fdata]
[app.http :as http]
[app.loggers.audit :as-alias audit]
[app.rpc :as-alias rpc]
[app.rpc.commands.files :as files]
[app.storage :as sto]
[backend-tests.helpers :as th]
[clojure.test :as t]
[cuerdas.core :as str]))
(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)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))
(t/deftest files-crud
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
page-id (uuid/next)
data {::th/type :create-file
::rpc/profile-id (:id prof)
:project-id proj-id
:name "foobar"
:is-shared false}
out (th/command! data)
file-id (:id (:result out))]
(t/testing "create file"
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (uuid? file-id))
(t/is (= (:name data) (:name result)))
(t/is (= proj-id (:project-id result)))))
(t/testing "rename file"
(let [data {::th/type :rename-file
:id file-id
:name "new name"
::rpc/profile-id (:id prof)}
out (th/command! data)]
;; (th/print-result! out)
(let [result (:result out)]
(t/is (= (:id data) (:id result)))
(t/is (= (:name data) (:name result))))))
(t/testing "query files"
(let [data {::th/type :get-project-files
::rpc/profile-id (:id prof)
:project-id proj-id}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= 1 (count result)))
(t/is (= file-id (get-in result [0 :id])))
(t/is (= "new name" (get-in result [0 :name]))))))
(t/testing "query single file without users"
(let [data {::th/type :get-file
::rpc/profile-id (:id prof)
:id file-id
:components-v2 true}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= file-id (:id result)))
(t/is (= "new name" (:name result)))
(t/is (= 1 (count (get-in result [:data :pages]))))
(t/is (nil? (:users result))))))
(t/testing "delete file"
(let [data {::th/type :delete-file
:id file-id
::rpc/profile-id (:id prof)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(t/testing "query single file after delete"
(let [data {::th/type :get-file
::rpc/profile-id (:id prof)
:id file-id
:components-v2 true}
out (th/command! data)]
(let [error (:error out)
error-data (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found)))))
(t/testing "query list files after delete"
(let [data {::th/type :get-project-files
::rpc/profile-id (:id prof)
:project-id proj-id}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= 0 (count result))))))))
(t/deftest file-gc-with-fragments
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
page-id (uuid/random)
shape-id (uuid/random)]
;; Preventive file-gc
(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 (= 1 (count rows))))
;; Add page
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-page
:name "test"
: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 (= 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 (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 (= 2 (count rows)))
(t/is (= 0 (count (filterv :deleted-at rows)))))
;; The objects-gc has nothing to remove.
(let [res (th/run-task! :objects-gc {})]
(t/is (= 0 (:processed res))))
;; Check the number of fragments
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
(t/is (= 2 (count rows))))
;; Add shape to page that should add a new fragment
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 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 "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect})}])
;; Check the number of fragments
(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)})))
;; 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 (= 1 (:processed res))))
;; Check the number of fragments;
(let [rows (th/db-query :file-data {:file-id (:id file)
:type "fragment"
:deleted-at nil})]
(t/is (= 2 (count rows))))
;; Lets proceed to delete all changes
(th/db-delete! :file-change {:file-id (:id file)})
(th/db-delete! :file-data {:file-id (:id file) :type "snapshot"})
(th/db-update! :file
{:has-media-trimmed false}
{:id (:id file)})
;; The file-gc should remove fragments related to changes
;; snapshots previously deleted.
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; 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 (= 2 (count rows)))
(t/is (= 2 (count (remove :deleted-at rows)))))
(let [res (th/run-task! :objects-gc {})]
(t/is (= 0 (:processed res))))
(let [rows (th/db-query :file-data {:file-id (:id file) :type "fragment"})]
(t/is (= 2 (count rows))))))
(t/deftest file-gc-with-thumbnails
(letfn [(add-file-media-object [& {:keys [profile-id file-id]}]
(let [mfile {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}
params {::th/type :upload-file-media-object
::rpc/profile-id profile-id
:file-id file-id
:is-local true
:name "testfile"
:content mfile}
out (th/multipart-command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))]
(let [storage (:app.storage/storage th/*system*)
profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
fmo1 (add-file-media-object :profile-id (:id profile) :file-id (:id file))
fmo2 (add-file-media-object :profile-id (:id profile) :file-id (:id file))
shid (uuid/random)
page-id (first (get-in file [:data :pages]))]
;; Update file inserting a new image object
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id page-id
:id shid
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id shid
:name "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect
:fills [{:fill-opacity 1
:fill-image {:id (:id fmo1) :width 100 :height 100 :mtype "image/jpeg"}}]})}])
;; Check that reference storage objects on file_media_objects
;; are the same because of deduplication feature.
(t/is (= (:media-id fmo1) (:media-id fmo2)))
(t/is (= (:thumbnail-id fmo1) (:thumbnail-id fmo2)))
;; If we launch gc-touched-task, we should have 2 items to
;; freeze because of the deduplication (we have uploaded 2 times
;; the same files).
(let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))]
(th/run-task! :storage-gc-touched {}))]
(t/is (= 2 (:freeze res)))
(t/is (= 0 (:delete res))))
;; run the task again
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; retrieve file and check trimmed attribute
(let [row (th/db-get :file {:id (:id file)})]
(t/is (true? (:has-media-trimmed row))))
;; check file media objects
(let [[row1 row2 :as rows]
(th/db-query :file-media-object
{:file-id (:id file)}
{:order-by [:created-at]})]
(t/is (= (:id fmo1) (:id row1)))
(t/is (= (:id fmo2) (:id row2)))
(t/is (ct/inst? (:deleted-at row2))))
(let [res (th/run-task! :objects-gc {})]
;; 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)})]
(t/is (= 1 (count rows)))
(t/is (= 1 (count (remove :deleted-at rows)))))
;; The underlying storage objects are still available.
(t/is (some? (sto/get-object storage (:media-id fmo1))))
(t/is (some? (sto/get-object storage (:thumbnail-id fmo1))))
;; proceed to remove usage of the file
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes [{:type :del-obj
:page-id (first (get-in file [:data :pages]))
:id shid}])
;; Now, we have deleted the usage of pointers to the
;; file-media-objects, if we paste file-gc, they should be marked
;; as deleted.
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; 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 (= 0 (:processed res))))
;; Delete all snapshots
(th/db-exec! ["update file_data set deleted_at = now() where file_id = ? and type = 'snapshot'" (:id file)])
(th/db-exec! ["update file_change set deleted_at = now() where file_id = ? and label is not null" (:id file)])
(th/db-exec! ["update file set has_media_trimmed = false where id = ?" (:id file)])
(let [res (th/run-task! :objects-gc {})]
;; this will remove the file change and file data entries for two snapshots
(t/is (= 4 (:processed res))))
;; Rerun the file-gc and objects-gc
(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 (= 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
;; them are marked to be deleted
(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))))
;; Finally, check that some of the objects that are marked as
;; deleted we are unable to retrieve them using standard storage
;; public api
(t/is (nil? (sto/get-object storage (:media-id fmo1))))
(t/is (nil? (sto/get-object storage (:thumbnail-id fmo1)))))))
(t/deftest file-gc-image-fills-and-strokes
(letfn [(add-file-media-object [& {:keys [profile-id file-id]}]
(let [mfile {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}
params {::th/type :upload-file-media-object
::rpc/profile-id profile-id
:file-id file-id
:is-local true
:name "testfile"
:content mfile}
out (th/multipart-command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))]
(let [storage (:app.storage/storage th/*system*)
profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
fmo1 (add-file-media-object :profile-id (:id profile) :file-id (:id file))
fmo2 (add-file-media-object :profile-id (:id profile) :file-id (:id file))
fmo3 (add-file-media-object :profile-id (:id profile) :file-id (:id file))
fmo4 (add-file-media-object :profile-id (:id profile) :file-id (:id file))
fmo5 (add-file-media-object :profile-id (:id profile) :file-id (:id file))
s1-shid (uuid/random)
s2-shid (uuid/random)
t-shid (uuid/random)
page-id (first (get-in file [:data :pages]))]
(let [rows (th/db-query :file-data {:file-id (:id file)
:type "fragment"
:deleted-at nil})]
(t/is (= (count rows) 1)))
;; Update file inserting a new image object
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id page-id
:id s1-shid
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id s1-shid
:name "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect
:fills [{:fill-opacity 1 :fill-image {:id (:id fmo2) :width 101 :height 100 :mtype "image/jpeg"}}]
:strokes [{:stroke-opacity 1 :stroke-image {:id (:id fmo3) :width 102 :height 100 :mtype "image/jpeg"}}]})}
{:type :add-obj
:page-id page-id
:id s2-shid
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id s2-shid
:name "image"
:frame-id uuid/zero
:parent-id uuid/zero
:type :rect
:fills [{:fill-opacity 1 :fill-image {:id (:id fmo1) :width 103 :height 100 :mtype "image/jpeg"}}]})}
{:type :add-obj
:page-id page-id
:id t-shid
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id t-shid
:name "text"
:frame-id uuid/zero
:parent-id uuid/zero
:type :text
:content {:type "root"
:children [{:type "paragraph-set"
:children [{:type "paragraph"
:children [{:fills [{:fill-opacity 1
:fill-image {:id (:id fmo4)
:width 417
:height 354
:mtype "image/png"
:name "text fill image"}}]
:text "hi"}
{:fills [{:fill-opacity 1
:fill-color "#000000"}]
:text "bye"}]}]}]}
:strokes [{:stroke-opacity 1 :stroke-image {:id (:id fmo5) :width 100 :height 100 :mtype "image/jpeg"}}]})}])
;; run the task again
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [res (th/run-task! :objects-gc {})]
;; 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})]
;; 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)})]
(t/is (true? (:has-media-trimmed row))))
;; check file media objects
(let [rows (th/db-exec! ["select * from file_media_object where file_id = ?" (:id file)])]
(t/is (= 5 (count rows))))
;; The underlying storage objects are still available.
(t/is (some? (sto/get-object storage (:media-id fmo5))))
(t/is (some? (sto/get-object storage (:media-id fmo4))))
(t/is (some? (sto/get-object storage (:media-id fmo3))))
(t/is (some? (sto/get-object storage (:media-id fmo2))))
(t/is (some? (sto/get-object storage (:media-id fmo1))))
;; proceed to remove usage of the file
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes [{:type :del-obj
:page-id (first (get-in file [:data :pages]))
:id s1-shid}
{:type :del-obj
:page-id (first (get-in file [:data :pages]))
:id t-shid}
{:type :del-obj
:page-id (first (get-in file [:data :pages]))
:id s2-shid}])
;; Now, we have deleted the usage of pointers to the
;; file-media-objects, if we paste file-gc, they should be marked
;; as deleted.
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; 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 (= 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)])
(th/db-delete! :file-data {:file-id (:id file)
:type "snapshot"})
;; Rerun file-gc and objects-gc task for the same file once all snapshots are
;; "expired/deleted"
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [res (th/run-task! :objects-gc {})]
;; 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"
:deleted-at nil})]
(t/is (= (count rows) 1)))
;; Now that file-gc have deleted the file-media-object usage,
;; lets execute the touched-gc task, we should see that two of
;; them are marked to be deleted.
(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))))
;; Finally, check that some of the objects that are marked as
;; deleted we are unable to retrieve them using standard storage
;; public api.
(t/is (nil? (sto/get-object storage (:media-id fmo5))))
(t/is (nil? (sto/get-object storage (:media-id fmo4))))
(t/is (nil? (sto/get-object storage (:media-id fmo3))))
(t/is (nil? (sto/get-object storage (:media-id fmo2))))
(t/is (nil? (sto/get-object storage (:media-id fmo1)))))))
(t/deftest file-gc-with-object-thumbnails
(letfn [(insert-file-object-thumbnail! [& {:keys [profile-id file-id page-id frame-id]}]
(let [object-id (thc/fmt-object-id file-id page-id frame-id "frame")
mfile {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}
params {::th/type :create-file-object-thumbnail
::rpc/profile-id profile-id
:file-id file-id
:object-id object-id
:tag "frame"
:media mfile}
out (th/multipart-command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))]
(let [storage (:app.storage/storage th/*system*)
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 (get file :id)
page-id (first (get-in file [:data :pages]))
frame-id-1 (uuid/random)
frame-id-2 (uuid/random)
fot-1 (insert-file-object-thumbnail! :profile-id (:id profile)
:file-id file-id
:page-id page-id
:frame-id frame-id-1)
fot-2 (insert-file-object-thumbnail! :profile-id (:id profile)
:page-id page-id
:file-id file-id
:frame-id frame-id-2)]
;; Add a two frames
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id page-id
:id frame-id-1
:parent-id uuid/zero
:frame-id uuid/zero
:obj (cts/setup-shape
{:id frame-id-2
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame})}
{:type :add-obj
:page-id page-id
:id frame-id-2
:parent-id uuid/zero
:frame-id uuid/zero
:obj (cts/setup-shape
{:id frame-id-2
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame})}])
;; Check that reference storage objects are the same because of
;; deduplication feature.
(t/is (= (:media-id fot-1) (:media-id fot-2)))
;; If we launch gc-touched-task, we should have 1 item to freeze
;; because of the deduplication (we have uploaded 2 times the
;; same files).
(let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))]
(th/run-task! :storage-gc-touched {}))]
(t/is (= 1 (:freeze res)))
(t/is (= 0 (:delete res))))
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; retrieve file and check trimmed attribute
(let [row (th/db-get :file {:id (:id file)})]
(t/is (true? (:has-media-trimmed row))))
;; check file media objects
(let [rows (th/db-exec! ["select * from file_tagged_object_thumbnail where file_id = ?" file-id])]
;; (pp/pprint rows)
(t/is (= 2 (count rows))))
;; check file media objects
(let [rows (th/db-exec! ["select * from storage_object where deleted_at is null"])]
;; (pp/pprint rows)
(t/is (= 1 (count rows))))
;; The underlying storage objects are available.
(t/is (some? (sto/get-object storage (:media-id fot-1))))
(t/is (some? (sto/get-object storage (:media-id fot-2))))
;; proceed to remove one frame
(update-file!
:file-id file-id
:profile-id (:id profile)
:revn 0
:vern 0
:changes [{:type :del-obj
:page-id page-id
:id frame-id-2}])
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id file-id})]
(t/is (= 2 (count rows)))
(t/is (= 1 (count (remove (comp some? :deleted-at) rows))))
(t/is (= (thc/fmt-object-id file-id page-id frame-id-1 "frame")
(->> rows (remove (comp some? :deleted-at)) first :object-id))))
;; 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.
;; 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 (= 1 (:processed res))))
;; Now that objects-gc have deleted the object thumbnail lets
;; execute the touched-gc task
(let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))]
(th/run-task! :storage-gc-touched {}))]
(t/is (= 1 (:freeze res))))
;; check file media objects
(let [rows (th/db-query :storage-object {:deleted-at nil})]
;; (pp/pprint rows)
(t/is (= 1 (count rows))))
;; proceed to remove one frame
(update-file!
:file-id file-id
:profile-id (:id profile)
:revn 0
:vern 0
:changes [{:type :del-obj
:page-id page-id
:id frame-id-1}])
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id file-id})]
(t/is (= 1 (count rows)))
(t/is (= 0 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {})]
;; (pp/pprint 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})]
;; (pp/pprint rows)
(t/is (= 1 (count rows))))
;; Now that file-gc have deleted the object thumbnail lets
;; execute the touched-gc task
(let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))]
(th/run-task! :storage-gc-touched {}))]
(t/is (= 1 (:delete res))))
;; check file media objects
(let [rows (th/db-query :storage-object {:deleted-at nil})]
;; (pp/pprint rows)
(t/is (= 0 (count rows)))))))
(t/deftest permissions-checks-creating-file
(let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2)
data {::th/type :create-file
::rpc/profile-id (:id profile2)
:project-id (:default-project-id profile1)
:name "foobar"
:is-shared false}
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found))))
(t/deftest permissions-checks-rename-file
(let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2)
file (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)})
data {::th/type :rename-file
:id (:id file)
::rpc/profile-id (:id profile2)
:name "foobar"}
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found))))
(t/deftest permissions-checks-delete-file
(let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2)
file (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)})
data {::th/type :delete-file
::rpc/profile-id (:id profile2)
:id (:id file)}
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found))))
(t/deftest delete-file-audit-includes-team-id
;; Assert result metadata directly: wrap-audit is inactive in the
;; default test flags, so mocking audit/submit would never see this.
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:project-id (:default-project-id profile)
:profile-id (:id profile)})
result (db/tx-run! th/*system*
(fn [cfg]
(#'files/delete-file cfg {:id (:id file)
:profile-id (:id profile)})))
props (::audit/props (meta result))]
(t/is (= (:default-team-id profile) (:team-id props)))
(t/is (= (:project-id file) (:project-id props)))))
(t/deftest permissions-checks-set-file-shared
(let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2)
file (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)})
data {::th/type :set-file-shared
::rpc/profile-id (:id profile2)
:id (:id file)
:is-shared true}
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found))))
(t/deftest set-file-shared-idempotent
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:project-id (:default-project-id profile)
:profile-id (:id profile)})]
;; Share the file
(let [data {::th/type :set-file-shared
::rpc/profile-id (:id profile)
:id (:id file)
:is-shared true}
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (true? (-> out :result :is-shared))))
;; Calling set-file-shared with is-shared=true again should be a
;; no-op success (idempotent), not an error.
(let [data {::th/type :set-file-shared
::rpc/profile-id (:id profile)
:id (:id file)
:is-shared true}
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (true? (-> out :result :is-shared))))
;; Unshare the file
(let [data {::th/type :set-file-shared
::rpc/profile-id (:id profile)
:id (:id file)
:is-shared false}
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (false? (-> out :result :is-shared))))
;; Calling set-file-shared with is-shared=false again should also
;; be a no-op success (idempotent).
(let [data {::th/type :set-file-shared
::rpc/profile-id (:id profile)
:id (:id file)
:is-shared false}
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (false? (-> out :result :is-shared))))))
(t/deftest permissions-checks-link-to-library-1
(let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2)
file1 (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)
:is-shared true})
file2 (th/create-file* 2 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)})
data {::th/type :link-file-to-library
::rpc/profile-id (:id profile2)
:file-id (:id file2)
:library-id (:id file1)}
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found))))
(t/deftest permissions-checks-link-to-library-2
(let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2)
file1 (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)
:is-shared true})
file2 (th/create-file* 2 {:project-id (:default-project-id profile2)
:profile-id (:id profile2)})
data {::th/type :link-file-to-library
::rpc/profile-id (:id profile2)
:file-id (:id file2)
:library-id (:id file1)}
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found))))
(t/deftest permissions-checks-unlink-library
(let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2)
file1 (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)
:is-shared true})
file2 (th/create-file* 2 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)})]
(let [data {::th/type :unlink-file-from-library
::rpc/profile-id (:id profile2)
:file-id (:id file2)
:library-id (:id file1)}
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found)))))
(t/deftest permissions-checks-update-file-library-status
(let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2)
file1 (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)
:is-shared true})
file2 (th/create-file* 2 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)})]
(let [data {::th/type :update-file-library-sync-status
::rpc/profile-id (:id profile2)
:file-id (:id file2)
:library-id (:id file1)}
out (th/command! data)
error (:error out)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :not-found)))))
(t/deftest link-file-to-library-creates-sync-row
(let [profile (th/create-profile* 1)
file1 (th/create-file* 1 {:project-id (:default-project-id profile)
:profile-id (:id profile)
:is-shared true})
file2 (th/create-file* 2 {:project-id (:default-project-id profile)
:profile-id (:id profile)})
data {::th/type :link-file-to-library
::rpc/profile-id (:id profile)
:file-id (:id file2)
:library-id (:id file1)}
out (th/command! data)
rel (th/db-get :file-library-rel {:file-id (:id file2)
:library-file-id (:id file1)})
sync (th/db-get :file-library-sync {:file-id (:id file2)
:library-file-id (:id file1)})]
(t/is (nil? (:error out)))
(t/is (some? rel))
(t/is (some? sync))
(t/is (some? (:synced-at sync)))))
(t/deftest link-file-to-library-rejects-cross-team
;; N1-08: A file in team2 must not be linked to a library in team1,
;; even when the user has edit permissions on both (BOLA / CWE-639).
(let [prof1 (th/create-profile* 1)
prof2 (th/create-profile* 2)
team1 (th/create-team* 1 {:profile-id (:id prof1)})
team2 (th/create-team* 2 {:profile-id (:id prof2)})
proj1 (th/create-project* 1 {:profile-id (:id prof1)
:team-id (:id team1)})
proj2 (th/create-project* 2 {:profile-id (:id prof2)
:team-id (:id team2)})
lib (th/create-file* 1 {:project-id (:id proj1)
:profile-id (:id prof1)
:is-shared true})
file2 (th/create-file* 2 {:project-id (:id proj2)
:profile-id (:id prof2)})]
;; Add prof2 as editor to team1 so they have edit access to the library
(th/db-insert! :team-profile-rel {:team-id (:id team1)
:profile-id (:id prof2)
:is-owner false
:is-admin false
:can-edit true})
;; prof2 tries to link file2 (team2) to lib (team1) — must fail
(let [data {::th/type :link-file-to-library
::rpc/profile-id (:id prof2)
:file-id (:id file2)
:library-id (:id lib)}
out (th/command! data)]
(t/is (some? (:error out))))))
(t/deftest update-file-library-sync-status-updates-sync-row
(let [profile (th/create-profile* 1)
file1 (th/create-file* 1 {:project-id (:default-project-id profile)
:profile-id (:id profile)
:is-shared true})
file2 (th/create-file* 2 {:project-id (:default-project-id profile)
:profile-id (:id profile)})
_ (th/link-file-to-library* {:file-id (:id file2)
:library-id (:id file1)})
before (th/db-get :file-library-sync {:file-id (:id file2)
:library-file-id (:id file1)})
_ (th/sleep 10)
data {::th/type :update-file-library-sync-status
::rpc/profile-id (:id profile)
:file-id (:id file2)
:library-id (:id file1)}
out (th/command! data)
after (th/db-get :file-library-sync {:file-id (:id file2)
:library-file-id (:id file1)})]
(t/is (nil? (:error out)))
(t/is (some? before))
(t/is (some? after))
(t/is (pos? (compare (:synced-at after) (:synced-at before))))))
(t/deftest update-file-library-sync-status-without-link-creates-sync-row
(let [profile (th/create-profile* 1)
file1 (th/create-file* 1 {:project-id (:default-project-id profile)
:profile-id (:id profile)
:is-shared true})
file2 (th/create-file* 2 {:project-id (:default-project-id profile)
:profile-id (:id profile)})
data {::th/type :update-file-library-sync-status
::rpc/profile-id (:id profile)
:file-id (:id file2)
:library-id (:id file1)}
out (th/command! data)
sync (th/db-get :file-library-sync {:file-id (:id file2)
:library-file-id (:id file1)})]
(t/is (nil? (:error out)))
(t/is (some? sync))
(t/is (some? (:synced-at sync)))))
(t/deftest deletion
(let [profile1 (th/create-profile* 1)
file (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)})]
;; file is not deleted because it does not meet all
;; conditions to be deleted.
(let [result (th/run-task! :objects-gc {})]
(t/is (= 0 (:processed result))))
;; query the list of files
(let [data {::th/type :get-project-files
::rpc/profile-id (:id profile1)
:project-id (:default-project-id profile1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= 1 (count result)))))
;; Request file to be deleted
(let [params {::th/type :delete-file
:id (:id file)
::rpc/profile-id (:id profile1)}
out (th/command! params)]
(t/is (nil? (:error out))))
(th/run-pending-jobs)
;; query the list of files after soft deletion
(let [data {::th/type :get-project-files
::rpc/profile-id (:id profile1)
:project-id (:default-project-id profile1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= 0 (count result)))))
(let [data {::th/type :get-file-libraries
::rpc/profile-id (:id profile1)
:file-id (:id file)}
out (th/command! data)]
;; (th/print-result! out)
(let [error (:error out)
error-data (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found))))
;; run permanent deletion (should be noop)
(let [result (th/run-task! :objects-gc {})]
(t/is (= 0 (:processed result))))
;; run permanent deletion
(binding [ct/*clock* (ct/fixed-clock (ct/in-future {:days 8}))]
(let [result (th/run-task! :objects-gc {})]
(t/is (= 3 (:processed result)))))
;; query the list of file libraries of a after hard deletion
(let [data {::th/type :get-file-libraries
::rpc/profile-id (:id profile1)
:file-id (:id file)}
out (th/command! data)]
;; (th/print-result! out)
(let [error (:error out)
error-data (ex-data error)]
(t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found))))))
(t/deftest object-thumbnails-ops
(let [prof (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id prof)
:is-shared false})
page-id (get-in file [:data :pages 0])
frame1-id (uuid/next)
shape1-id (uuid/next)
frame2-id (uuid/next)
shape2-id (uuid/next)
changes [{:type :add-obj
:page-id page-id
:id frame1-id
:parent-id uuid/zero
:frame-id uuid/zero
:obj (cts/setup-shape
{:id frame1-id
:use-for-thumbnail? true
:name "test-frame1"
:type :frame})}
{:type :add-obj
:page-id page-id
:id shape1-id
:parent-id frame1-id
:frame-id frame1-id
:obj (cts/setup-shape
{:id shape1-id
:name "test-shape1"
:type :rect})}
{:type :add-obj
:page-id page-id
:id frame2-id
:parent-id uuid/zero
:frame-id uuid/zero
:obj (cts/setup-shape
{:id frame2-id
:name "test-frame2"
:type :frame})}
{:type :add-obj
:page-id page-id
:id shape2-id
:parent-id frame2-id
:frame-id frame2-id
:obj (cts/setup-shape
{:id shape2-id
:name "test-shape2"
:type :rect})}]]
;; Update the file
(th/update-file* {:file-id (:id file)
:profile-id (:id prof)
:revn 0
:vern 0
:components-v2 true
:changes changes})
(t/testing "RPC page query (rendering purposes)"
;; Query :page RPC method without passing page-id
(let [data {::th/type :get-page
::rpc/profile-id (:id prof)
:file-id (:id file)
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result))
(t/is (contains? result :objects))
(t/is (contains? (:objects result) frame1-id))
(t/is (contains? (:objects result) shape1-id))
(t/is (contains? (:objects result) frame2-id))
(t/is (contains? (:objects result) shape2-id))
(t/is (contains? (:objects result) uuid/zero)))
;; Query :page RPC method with page-id
(let [data {::th/type :get-page
::rpc/profile-id (:id prof)
:file-id (:id file)
:page-id page-id
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (map? result))
(t/is (contains? result :objects))
(t/is (contains? (:objects result) frame1-id))
(t/is (contains? (:objects result) shape1-id))
(t/is (contains? (:objects result) frame2-id))
(t/is (contains? (:objects result) shape2-id))
(t/is (contains? (:objects result) uuid/zero)))
;; Query :page RPC method with page-id and object-id
(let [data {::th/type :get-page
::rpc/profile-id (:id prof)
:file-id (:id file)
:page-id page-id
:object-id frame1-id
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result))
(t/is (contains? result :objects))
(t/is (contains? (:objects result) frame1-id))
(t/is (contains? (:objects result) shape1-id))
(t/is (not (contains? (:objects result) uuid/zero)))
(t/is (not (contains? (:objects result) frame2-id)))
(t/is (not (contains? (:objects result) shape2-id))))
;; Query :page RPC method with wrong params
(let [data {::th/type :get-page
::rpc/profile-id (:id prof)
:file-id (:id file)
:object-id frame1-id
:features cfeat/supported-features}
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [{:keys [type code]} (-> out :error ex-data)]
(t/is (= :validation type))
(t/is (= :params-validation code)))))
(t/testing "RPC :file-data-for-thumbnail"
;; Insert a thumbnail data for the frame-id
(let [data {::th/type :create-file-object-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:object-id (thc/fmt-object-id (:id file) page-id frame1-id "frame")
:media {:filename "sample.jpg"
:size 7923
:path (th/tempfile "backend_tests/test_files/sample2.jpg")
:mtype "image/jpeg"}}
{:keys [error result] :as out} (th/multipart-command! data)]
(t/is (nil? error))
(t/is (map? result)))
;; Check the result
(let [data {::th/type :get-file-data-for-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result))
(t/is (contains? result :page))
(t/is (contains? result :revn))
(t/is (contains? result :file-id))
(t/is (= (:id file) (:file-id result)))
(t/is (uuid? (get-in result [:page :objects frame1-id :thumbnail-id])))
(t/is (= [] (get-in result [:page :objects frame1-id :shapes]))))
;; Delete thumbnail data
(let [data {::th/type :delete-file-object-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:object-id (thc/fmt-object-id (:id file) page-id frame1-id "frame")}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (nil? result)))
;; Check the result
(let [data {::th/type :get-file-data-for-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:features cfeat/supported-features}
{:keys [error result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (map? result))
(t/is (contains? result :page))
(t/is (contains? result :revn))
(t/is (contains? result :file-id))
(t/is (= (:id file) (:file-id result)))
(t/is (nil? (get-in result [:page :objects frame1-id :thumbnail])))
(t/is (not= [] (get-in result [:page :objects frame1-id :shapes])))))
(t/testing "TASK :file-gc"
;; insert object snapshot for known frame
(let [data {::th/type :create-file-object-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:object-id (thc/fmt-object-id (:id file) page-id frame1-id "frame")
:media {:filename "sample.jpg"
:size 7923
:path (th/tempfile "backend_tests/test_files/sample2.jpg")
:mtype "image/jpeg"}}
{:keys [error result] :as out} (th/multipart-command! data)]
(t/is (nil? error))
(t/is (map? result)))
;; Wait to file be ellegible for GC
(th/sleep 300)
;; run the task
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; check that object thumbnails are still here
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
(t/is (= 1 (count rows))))
;; insert object snapshot for for unknown frame
(let [data {::th/type :create-file-object-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:object-id (thc/fmt-object-id (:id file) page-id (uuid/next) "frame")
:media {:filename "sample.jpg"
:size 7923
:path (th/tempfile "backend_tests/test_files/sample2.jpg")
:mtype "image/jpeg"}}
{:keys [error result] :as out} (th/multipart-command! data)]
(t/is (nil? error))
(t/is (map? result)))
;; Mark file as modified
(th/db-exec! ["update file set has_media_trimmed=false where id=?" (:id file)])
;; check that we have all object thumbnails
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
(t/is (= 2 (count rows))))
;; run the task again
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; check that we have all object thumbnails
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
;; (app.common.pprint/pprint rows)
(t/is (= 2 (count rows))))
;; check that the unknown frame thumbnail is deleted
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
(t/is (= 2 (count rows)))
(t/is (= 1 (count (remove :deleted-at rows)))))
(let [res (th/run-task! :objects-gc {})]
;; 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)
(t/is (= 1 (count rows)))))))
(t/deftest file-data-for-thumbnail-frame-on-other-page
(let [prof (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id prof)
:is-shared false})
page1-id (get-in file [:data :pages 0])
page2-id (uuid/next)
rect-id (uuid/next)
frame-id (uuid/next)
get-data (fn []
(th/command! {::th/type :get-file-data-for-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:features cfeat/supported-features}))]
(th/update-file* {:file-id (:id file)
:profile-id (:id prof)
:revn 0
:vern 0
:changes [{:type :add-obj
:page-id page1-id
:id rect-id
:parent-id uuid/zero
:frame-id uuid/zero
:obj (cts/setup-shape
{:id rect-id
:name "rect"
:type :rect})}
{:type :add-page
:id page2-id
:name "page 2"}
{:type :add-obj
:page-id page2-id
:id frame-id
:parent-id uuid/zero
:frame-id uuid/zero
:obj (cts/setup-shape
{:id frame-id
:name "frame"
:type :frame})}]})
(t/testing "no marked frame falls back to the first page"
(let [{:keys [error result]} (get-data)]
(t/is (nil? error))
(t/is (= page1-id (get-in result [:page :id])))
(t/is (nil? (get-in result [:page :thumbnail-frame-id])))
(t/is (contains? (get-in result [:page :objects]) rect-id))))
(th/update-file* {:file-id (:id file)
:profile-id (:id prof)
:revn 1
:vern 0
:changes [{:type :mod-obj
:page-id page2-id
:id frame-id
:operations [{:type :set
:attr :use-for-thumbnail
:val true}]}]})
(t/testing "marked frame on another page is used"
(let [{:keys [error result]} (get-data)]
(t/is (nil? error))
(t/is (= page2-id (get-in result [:page :id])))
(t/is (= frame-id (get-in result [:page :thumbnail-frame-id])))
(t/is (contains? (get-in result [:page :objects]) frame-id))))))
(t/deftest file-thumbnail-ops
(let [prof (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id prof)
:revn 2
:vern 0
:is-shared false})]
(t/testing "create a file thumbnail"
;; insert object snapshot for known frame
(let [data {::th/type :create-file-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:revn 1
:media {:filename "sample.jpg"
:size 7923
:path (th/tempfile "backend_tests/test_files/sample2.jpg")
:mtype "image/jpeg"}}
{:keys [error result] :as out} (th/multipart-command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result)))
;; insert another thumbnail with different revn
(let [data {::th/type :create-file-thumbnail
::rpc/profile-id (:id prof)
:file-id (:id file)
:revn 2
:media {:filename "sample.jpg"
:size 7923
:path (th/tempfile "backend_tests/test_files/sample2.jpg")
:mtype "image/jpeg"}}
{:keys [error result] :as out} (th/multipart-command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result)))
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
(t/is (= 2 (count rows)))))
(t/testing "gc task"
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
(t/is (= 2 (count rows)))
(t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {})]
;; 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)))))))
(t/deftest file-tiered-storage
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
page-id (uuid/random)
shape-id (uuid/random)
sobject (volatile! nil)]
;; Preventive file-gc
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; Preventive objects-gc
(let [result (th/run-task! :objects-gc {})]
;; 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"})]
(t/is (= 1 (count rows)))
(t/is (every? #(some? (:data %)) rows)))
;; Mark the file ellegible again for GC
(th/db-update! :file
{:has-media-trimmed false}
{:id (:id file)})
;; Run FileGC again, with tiered storage activated
(with-redefs [app.config/flags (conj app.config/flags :tiered-file-data-storage)]
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))))
;; The FileGC task will schedule an inner taskq
(th/run-pending-jobs)
(let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))]
(th/run-task! :storage-gc-touched {}))]
(t/is (= 2 (:freeze res)))
(t/is (= 0 (:delete res))))
;; 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 (= 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"})]
;; (pp/pprint rows)
(t/is (= 1 (count rows)))
(t/is (every? #(nil? (:data %)) rows))
(t/is (every? #(= "storage" (:backend %)) rows)))
(let [file (-> (th/db-get :file-data {:id (:id file) :type "main"})
(update :metadata fdata/decode-metadata))
storage (sto/resolve th/*system*)]
;; (pp/pprint file)
(t/is (= "storage" (:backend file)))
(t/is (nil? (:data file)))
(let [sobj (sto/get-object storage (-> file :metadata :storage-ref-id))]
(vreset! sobject sobj)
;; (pp/pprint (meta sobj))
(t/is (= "file-data" (:bucket (meta sobj))))
(t/is (= (:id file) (:file-id (meta sobj))))))
;; Add shape to page that should load from cold storage again into the hot storage (db)
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-page
:name "test"
:id page-id}])
;; Check the number of fragments
(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 (= 2 (count rows)))
(t/is (nil? (:data row1)))
(t/is (= "storage" (:backend row1)))
(t/is (bytes? (:data row2)))
(t/is (= "db" (:backend row2))))
;; The file-gc should mark for remove unused fragments
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; 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)
;; 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 (nil? (:deleted-at row1)))
(t/is (= "storage" (:backend row1)))
(t/is (bytes? (:data row2)))
(t/is (= "db" (:backend row2)))
(t/is (nil? (:deleted-at row2))))
;; The objects-gc has nothing to remove: no fragment was marked.
(let [res (th/run-task! :objects-gc {})]
(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 (= 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)))
;; 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)))
(t/is (nil? (sto/get-object storage (:id @sobject)))))))
(t/deftest file-gc-with-components-1
(let [storage (:app.storage/storage th/*system*)
profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
s-id-1 (uuid/random)
s-id-2 (uuid/random)
c-id (uuid/random)
page-id (first (get-in file [:data :pages]))]
(let [rows (th/db-query :file-data {:file-id (:id file)
:type "fragment"
:deleted-at nil})]
(t/is (= (count rows) 1)))
;; Update file inserting new component
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id page-id
:id s-id-1
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id s-id-1
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame
:main-instance true
:component-root true
:component-file (:id file)
:component-id c-id})}
{:type :add-obj
:page-id page-id
:id s-id-2
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id s-id-2
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame
:main-instance false
:component-root true
:component-file (:id file)
:component-id c-id})}
{:type :add-component
:path ""
:name "Board"
:main-instance-id s-id-1
:main-instance-page page-id
:id c-id
:anotation nil}])
;; Run the task again
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; Retrieve file and check trimmed attribute
(let [row (th/db-get :file {:id (:id file)})]
(t/is (true? (:has-media-trimmed row))))
;; Check that component exists
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
component (get-in result [:data :components c-id])]
(t/is (some? component))
(t/is (nil? (:objects component)))))
;; Now proceed to delete a component
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :del-component
:id c-id}
{:type :del-obj
:page-id page-id
:id s-id-1
:ignore-touched true}])
;; ;; Check that component is marked as deleted
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
component (get-in result [:data :components c-id])]
(t/is (true? (:deleted component)))
(t/is (some? (not-empty (:objects component))))))
;; Re-run the file-gc task
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
(let [row (th/db-get :file {:id (:id file)})]
(t/is (true? (:has-media-trimmed row))))
;; Check that component is still there after file-gc task
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
component (get-in result [:data :components c-id])]
(t/is (true? (:deleted component)))
(t/is (some? (not-empty (:objects component))))))
;; Now delete the last instance using deleted component
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :del-obj
:page-id page-id
:id s-id-2
:ignore-touched true}])
;; Now, we have deleted the usage of component if we pass file-gc,
;; that component should be deleted
(t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))
;; Check that component is properly removed
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
components (get-in result [:data :components])]
(t/is (not (contains? components c-id)))))))
(t/deftest file-gc-with-components-2
(let [storage (:app.storage/storage th/*system*)
profile (th/create-profile* 1)
file-1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true})
file-2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
rel (th/link-file-to-library*
{:file-id (:id file-2)
:library-id (:id file-1)})
s-id-1 (uuid/random)
s-id-2 (uuid/random)
c-id (uuid/random)
f1-page-id (first (get-in file-1 [:data :pages]))
f2-page-id (first (get-in file-2 [:data :pages]))]
;; Update file library inserting new component
(update-file!
:file-id (:id file-1)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id f1-page-id
:id s-id-1
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id s-id-1
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame
:main-instance true
:component-root true
:component-file (:id file-1)
:component-id c-id})}
{:type :add-component
:path ""
:name "Board"
:main-instance-id s-id-1
:main-instance-page f1-page-id
:id c-id
:anotation nil}])
;; Instanciate a component in a different file
(update-file!
:file-id (:id file-2)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id f2-page-id
:id s-id-2
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id s-id-2
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame
:main-instance false
:component-root true
:component-file (:id file-1)
:component-id c-id})}])
;; Run the file-gc on file and library
(t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)})))
(t/is (true? (th/run-task! :file-gc {:file-id (:id file-2)})))
;; Check that component exists
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file-1)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
component (get-in result [:data :components c-id])]
(t/is (some? component))
(t/is (nil? (:objects component)))))
;; Now proceed to delete a component
(update-file!
:file-id (:id file-1)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :del-component
:id c-id}
{:type :del-obj
:page-id f1-page-id
:id s-id-1
:ignore-touched true}])
;; Check that component is marked as deleted
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file-1)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
component (get-in result [:data :components c-id])]
(t/is (true? (:deleted component)))
(t/is (some? (not-empty (:objects component))))))
;; Re-run the file-gc task
(t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)})))
;; Check that component is still there after file-gc task
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file-1)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
component (get-in result [:data :components c-id])]
(t/is (true? (:deleted component)))
(t/is (some? (not-empty (:objects component))))))
;; Now delete the last instance using deleted component
(update-file!
:file-id (:id file-2)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :del-obj
:page-id f2-page-id
:id s-id-2
:ignore-touched true}])
;; Mark
(th/db-exec! ["update file set has_media_trimmed = false where id = ?" (:id file-1)])
;; Now, we have deleted the usage of component if we pass file-gc,
;; that component should be deleted
(t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)})))
;; Check that component is properly removed
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file-1)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
components (get-in result [:data :components])]
(t/is (not (contains? components c-id)))))))
(defn add-file-media-object
[& {:keys [profile-id file-id]}]
(let [mfile {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}
params {::th/type :upload-file-media-object
::rpc/profile-id profile-id
:file-id file-id
:is-local true
:name "testfile"
:content mfile}
out (th/multipart-command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))
(t/deftest file-gc-with-media-assets-and-absorb-library
(let [storage (:app.storage/storage th/*system*)
profile (th/create-profile* 1)
file-1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true})
file-2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
fmedia (add-file-media-object :profile-id (:id profile) :file-id (:id file-1))
rel (th/link-file-to-library*
{:file-id (:id file-2)
:library-id (:id file-1)})
s-id-1 (uuid/random)
s-id-2 (uuid/random)
c-id (uuid/random)
f1-page-id (first (get-in file-1 [:data :pages]))
f2-page-id (first (get-in file-2 [:data :pages]))
fills
[{:fill-image
{:id (:id fmedia)
:name "test"
:mtype "image/jpeg"
:width 200
:height 200}}]]
;; Update file library inserting new component
(update-file!
:file-id (:id file-1)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id f1-page-id
:id s-id-1
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id s-id-1
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame
:fills fills
:main-instance true
:component-root true
:component-file (:id file-1)
:component-id c-id})}
{:type :add-component
:path ""
:name "Board"
:main-instance-id s-id-1
:main-instance-page f1-page-id
:id c-id
:anotation nil}])
;; Instanciate a component in a different file
(update-file!
:file-id (:id file-2)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id f2-page-id
:id s-id-2
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id s-id-2
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame
:fills fills
:main-instance false
:component-root true
:component-file (:id file-1)
:component-id c-id})}])
;; Check that file media object references are present for both objects
;; the original one and the instance.
(let [rows (th/db-exec! ["SELECT * FROM file_media_object ORDER BY created_at ASC"])]
(t/is (= 2 (count rows)))
(t/is (= (:id file-1) (:file-id (get rows 0))))
(t/is (= (:id file-2) (:file-id (get rows 1))))
(t/is (every? (comp nil? :deleted-at) rows)))
;; Check if the underlying media reference on shape is different
;; from the instantiation
(let [data {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file-2)}
out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)
fill (get-in result [:data :pages-index f2-page-id :objects s-id-2 :fills 0 :fill-image])]
(t/is (some? fill))
(t/is (not= (:id fill) (:id fmedia)))))
;; Run the file-gc on file and library
(t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)})))
(t/is (true? (th/run-task! :file-gc {:file-id (:id file-2)})))
;; Now proceed to delete file and absorb it
(let [data {::th/type :delete-file
::rpc/profile-id (:id profile)
:id (:id file-1)}
out (th/command! data)]
(t/is (th/success? out)))
(th/run-task! :delete-object
{:object :file
:deleted-at (ct/now)
:id (:id file-1)})
;; Check that file media object references are marked all for deletion
(let [rows (th/db-exec! ["SELECT * FROM file_media_object ORDER BY created_at ASC"])]
;; (pp/pprint rows)
(t/is (= 2 (count rows)))
(t/is (= (:id file-1) (:file-id (get rows 0))))
(t/is (some? (:deleted-at (get rows 0))))
(t/is (= (:id file-2) (:file-id (get rows 1))))
(t/is (nil? (:deleted-at (get rows 1)))))
(th/run-task! :objects-gc {})
(let [rows (th/db-exec! ["SELECT * FROM file_media_object ORDER BY created_at ASC"])]
(t/is (= 1 (count rows)))
(t/is (= (:id file-2) (:file-id (get rows 0))))
(t/is (nil? (:deleted-at (get rows 0)))))))
(t/deftest delete-shared-library-with-storage-file-data
(binding [cf/config (assoc cf/config :file-data-backend "storage")]
;; Keep this test focused on the storage-backed file-data fix: create
;; the files without the fdata/pointer-map optimization so the data is
;; stored as a single object and no separate fragments are involved.
(with-redefs [cfeat/get-enabled-features
(fn [& _] (disj cfeat/supported-features "fdata/pointer-map"))]
(let [profile (th/create-profile* 1)
params {:profile-id (:id profile)
:project-id (:default-project-id profile)}
library (th/create-file* 1 (assoc params :is-shared true))
file (th/create-file* 2 params)
c-id (uuid/random)
main-id (uuid/random)
inst-id (uuid/random)
l-page (first (get-in library [:data :pages]))
f-page (first (get-in file [:data :pages]))]
(th/link-file-to-library* {:file-id (:id file)
:library-id (:id library)})
;; Add a component to the library and an instance of it to the
;; referencing file, so absorption has something to move.
(update-file!
:file-id (:id library)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id l-page
:id main-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id main-id
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame
:main-instance true
:component-root true
:component-file (:id library)
:component-id c-id})}
{:type :add-component
:path ""
:name "Board"
:main-instance-id main-id
:main-instance-page l-page
:id c-id
:anotation nil}])
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id f-page
:id inst-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id inst-id
:name "Board"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame
:main-instance false
:component-root true
:component-file (:id library)
:component-id c-id})}])
;; Ensure the test exercises storage reads for both files.
(let [rows (th/db-exec! ["SELECT backend, data FROM file_data WHERE type = 'main'"])]
(t/is (= 2 (count rows)))
(t/is (every? #(= "storage" (:backend %)) rows))
(t/is (every? (comp nil? :data) rows)))
;; Baseline revn after adding the instance to the file.
(let [baseline (get-in (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)})
[:result :revn])]
(th/run-task! :delete-object
{:object :file
:deleted-at (ct/now)
:id (:id library)})
;; The task swallows absorption errors, so verify the persisted result.
;; Absorption runs inside the job, and the job only gets the
;; components of its own cfg, so this also needs
;; `:app.tasks.delete-object/job-def` to carry `::sto/storage`.
(let [deleted (db/get* th/*pool* :file {:id (:id library)}
{::db/remove-deleted false})
out (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id file)})]
(t/is (some? (:deleted-at deleted)))
(t/is (false? (:is-shared deleted)))
(t/is (th/success? out))
(t/is (= (inc baseline) (get-in out [:result :revn])))
(t/is (= (:id file) (get-in out [:result :data :id])))
;; The component must be absorbed into the file local library
;; and the instance must point to the local copy.
(t/is (some? (get-in out [:result :data :components c-id])))
(t/is (= (:id file)
(get-in out [:result :data :pages-index f-page
:objects inst-id :component-file])))))))))
(defn- prepare-tokens-library
"A shared library with a tokens lib, a file linked to it that uses it
as its tokens source, and another linked file that does not."
[profile]
(let [set-id (uuid/next)
theme-id (uuid/next)
tokens-lib (-> (ctob/make-tokens-lib)
(ctob/add-set (ctob/make-token-set :id set-id :name "test-set"))
(ctob/add-theme (ctob/make-token-theme :id theme-id
:name "test-theme"
:sets #{"test-set"}))
(ctob/add-token set-id (ctob/make-token :name "token-radius"
:type :border-radius
:value 10)))
params {:profile-id (:id profile)
:project-id (:default-project-id profile)}
library (th/create-file* 1 (assoc params :is-shared true))
file (th/create-file* 2 params)
other (th/create-file* 3 params)]
(th/link-file-to-library* {:file-id (:id file) :library-id (:id library)})
(th/link-file-to-library* {:file-id (:id other) :library-id (:id library)})
(update-file!
:file-id (:id library)
:profile-id (:id profile)
:changes
(-> (pcb/empty-changes nil)
(pcb/with-library-data (:data library))
(pcb/set-tokens-lib tokens-lib)
(:redo-changes)))
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:changes
(-> (pcb/empty-changes nil)
(pcb/with-library-data (:data file))
(pcb/set-tokens-source (:id library))
(pcb/set-tokens-status (ctos/make-tokens-status :active-theme-ids #{theme-id}
:active-set-ids #{set-id}))
(:redo-changes)))
{:library library :file file :other other :tokens-lib tokens-lib}))
(defn- check-tokens-absorbed
"The file is its own tokens source, with a copy of the tokens lib, and
keeps its tokens status; the other file is not changed."
[{:keys [file other tokens-lib]}]
(let [file-data (:data (bfc/get-file th/*system* (:id file)))
other-data (:data (bfc/get-file th/*system* (:id other)))]
(t/is (nil? (cfo/get-tokens-source file-data)))
(t/is (= (ctob/export-dtcg-json tokens-lib)
(ctob/export-dtcg-json (cfo/get-tokens-lib file-data))))
(t/is (= {:active-themes #{"/test-theme"}
:active-sets #{"test-set"}}
(cfo/ids->names (cfo/get-tokens-status file-data)
(cfo/get-tokens-lib file-data))))
(t/is (nil? (cfo/get-tokens-lib other-data)))))
(t/deftest delete-shared-library-absorbs-its-tokens-lib
(let [profile (th/create-profile* 1)
{:keys [library file] :as prepared} (prepare-tokens-library profile)
out (th/command! {::th/type :delete-file
::rpc/profile-id (:id profile)
:id (:id library)})]
(t/is (nil? (:error out)))
;; The relations are removed at once, the absorption is done by the
;; deletion task.
(t/is (empty? (th/db-query :file-library-rel {:library-file-id (:id library)})))
(t/is (= (:id library)
(cfo/get-tokens-source (:data (bfc/get-file th/*system* (:id file))))))
(th/run-pending-jobs)
(check-tokens-absorbed prepared)))
(t/deftest unpublish-shared-library-absorbs-its-tokens-lib
(let [profile (th/create-profile* 1)
{:keys [library] :as prepared} (prepare-tokens-library profile)
out (th/command! {::th/type :set-file-shared
::rpc/profile-id (:id profile)
:id (:id library)
:is-shared false})]
(t/is (nil? (:error out)))
(check-tokens-absorbed prepared)))
(t/deftest unpublishing-a-library-keeps-its-consumers-readable
;; The test helpers enable all supported features, so these files use
;; fdata/pointer-map and the absorbed page is stored as a fragment
(let [profile (th/create-profile* 1 {:is-active true})
library (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true})
consumer (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
_ (th/link-file-to-library* {:file-id (:id consumer) :library-id (:id library)})
color-id (uuid/random)
page-id (first (get-in consumer [:data :pages]))
shape-id (uuid/random)]
(update-file! :file-id (:id library)
:profile-id (:id profile)
:revn 0
:changes [{:type :add-color
:color {:id color-id :name "Brand" :color "#abcdef" :opacity 1}}])
(update-file!
:file-id (:id consumer)
:profile-id (:id profile)
: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
:fills [{:fill-color "#abcdef"
:fill-opacity 1
:fill-color-ref-id color-id
:fill-color-ref-file (:id library)}]})}])
(let [out (th/command! {::th/type :set-file-shared
::rpc/profile-id (:id profile)
:id (:id library)
:is-shared false})]
(t/is (nil? (:error out))))
;; The absorption changed the page of the shape: the consumer reads
;; it back, with the fill now linked to its own color
(let [out (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id (:id consumer)})
data (-> out :result :data)
fill (get-in data [:pages-index page-id :objects shape-id :fills 0])]
(t/is (nil? (:error out)))
(t/is (contains? (:colors data) color-id))
(t/is (= (:id consumer) (:fill-color-ref-file fill))))))
(t/deftest deleted-files-permanently-delete
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
now (ct/inst "2025-10-31T00:00:00Z")]
(binding [ct/*clock* (ct/fixed-clock now)]
(let [data {::th/type :create-file
::rpc/profile-id (:id prof)
:project-id proj-id
:name "foobar"
:is-shared false}
out (th/command! data)
_ (t/is (nil? (:error out)))
file-id (:id (:result out))]
;; (th/print-result! out)
(let [result (:result out)]
(t/is (= (:name data) (:name result)))
(t/is (= proj-id (:project-id result))))
(let [data {::th/type :delete-file
:id file-id
::rpc/profile-id (:id prof)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out))))
;; get deleted files
(let [data {::th/type :get-team-deleted-files
::rpc/profile-id (:id prof)
:team-id team-id}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [[row1 :as result] (:result out)]
(t/is (= 1 (count result)))
(t/is (= (:will-be-deleted-at row1) #penpot/inst "2025-11-07T00:00:00Z"))
(t/is (= (:created-at row1) #penpot/inst "2025-10-31T00:00:00Z"))
(t/is (= (:modified-at row1) #penpot/inst "2025-10-31T00:00:00Z"))))
(let [data {::th/type :permanently-delete-team-files
::rpc/profile-id (:id prof)
:team-id team-id
:ids #{file-id}}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (fn? result))
(let [[ev1 ev2 :as events] (th/consume-sse result)]
(t/is (= 2 (count events)))
(t/is (= (:ids data) (val ev2)))))
(let [row (th/db-exec-one! ["select * from file where id = ?" file-id])]
(t/is (= (:deleted-at row) now))))))))
(t/deftest restore-deleted-files
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
now (ct/inst "2025-10-31T00:00:00Z")]
(binding [ct/*clock* (ct/fixed-clock now)]
(let [data {::th/type :create-file
::rpc/profile-id (:id prof)
:project-id proj-id
:name "foobar"
:is-shared false}
out (th/command! data)
_ (t/is (nil? (:error out)))
file-id (:id (:result out))]
;; (th/print-result! out)
(let [result (:result out)]
(t/is (= (:name data) (:name result)))
(t/is (= proj-id (:project-id result))))
(let [data {::th/type :delete-file
:id file-id
::rpc/profile-id (:id prof)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out))))
;; get deleted files
(let [data {::th/type :get-team-deleted-files
::rpc/profile-id (:id prof)
:team-id team-id}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [[row1 :as result] (:result out)]
(t/is (= 1 (count result)))
(t/is (= (:will-be-deleted-at row1) #penpot/inst "2025-11-07T00:00:00Z"))
(t/is (= (:created-at row1) #penpot/inst "2025-10-31T00:00:00Z"))
(t/is (= (:modified-at row1) #penpot/inst "2025-10-31T00:00:00Z"))))
(let [data {::th/type :restore-deleted-team-files
::rpc/profile-id (:id prof)
:team-id team-id
:ids #{file-id}}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (fn? result))
(let [events (th/consume-sse result)]
;; (pp/pprint events)
(t/is (= 2 (count events)))
(t/is (= :end (first (last events))))
(t/is (= (:ids data) (last (last events)))))))
(let [row (th/db-exec-one! ["select * from file where id = ?" file-id])]
(t/is (nil? (:deleted-at row))))))))
(t/deftest restore-deleted-files-and-projets
(let [profile (th/create-profile* 1 {:is-active true})
team-id (:default-team-id profile)
now (ct/inst "2025-10-31T00:00:00Z")]
(binding [ct/*clock* (ct/fixed-clock now)]
(let [project (th/create-project* 1 {:profile-id (:id profile)
:team-id team-id})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)})
data {::th/type :delete-project
:id (:id project)
::rpc/profile-id (:id profile)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))
(th/run-pending-jobs)
;; get deleted files
(let [data {::th/type :get-team-deleted-files
::rpc/profile-id (:id profile)
:team-id team-id}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [[row1 :as result] (:result out)]
(t/is (= 1 (count result)))
(t/is (= (:will-be-deleted-at row1) #penpot/inst "2025-11-07T00:00:00Z"))
(t/is (= (:created-at row1) #penpot/inst "2025-10-31T00:00:00Z"))
(t/is (= (:modified-at row1) #penpot/inst "2025-10-31T00:00:00Z"))))
;; Check if project is deleted
(let [[row1 :as rows] (th/db-query :project {:id (:id project)})]
;; (pp/pprint rows)
(t/is (= 1 (count rows)))
(t/is (= (:deleted-at row1) #penpot/inst "2025-11-07T00:00:00Z"))
(t/is (= (:created-at row1) #penpot/inst "2025-10-31T00:00:00Z"))
(t/is (= (:modified-at row1) #penpot/inst "2025-10-31T00:00:00Z")))
;; Restore files
(let [data {::th/type :restore-deleted-team-files
::rpc/profile-id (:id profile)
:team-id team-id
:ids #{(:id file)}}
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (fn? result))
(let [events (th/consume-sse result)]
;; (pp/pprint events)
(t/is (= 2 (count events)))
(t/is (= :end (first (last events))))
(t/is (= (:ids data) (last (last events)))))))
(let [[row1 :as rows] (th/db-query :file {:project-id (:id project)})]
;; (pp/pprint rows)
(t/is (= 1 (count rows)))
(t/is (= (:created-at row1) #penpot/inst "2025-10-31T00:00:00Z"))
(t/is (nil? (:deleted-at row1))))
;; Check if project is restored
(let [[row1 :as rows] (th/db-query :project {:id (:id project)})]
;; (pp/pprint rows)
(t/is (= 1 (count rows)))
(t/is (= (:created-at row1) #penpot/inst "2025-10-31T00:00:00Z"))
(t/is (nil? (:deleted-at row1))))))))
(t/deftest get-file-stats-empty-file
(let [profile (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
out (th/command! {::th/type :get-file-stats
::rpc/profile-id (:id profile)
:id (:id file)})]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (= (:id file) (:file-id result)))
(t/is (pos? (:page-count result)))
(t/is (zero? (:component-count result)))
(t/is (zero? (:deleted-component-count result)))
(t/is (zero? (:color-count result)))
(t/is (zero? (:typography-count result)))
(t/is (zero? (:library-count result)))
(t/is (zero? (:referenced-by-count result)))
(t/is (contains? result :shape-counts))
(t/is (zero? (get-in result [:shape-counts :total])))
(t/is (= {} (get-in result [:shape-counts :by-type]))))))
(t/deftest get-file-stats-with-shapes
(let [profile (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
page-id (-> file :data :pages first)
rect-id (uuid/random)
frame-id (uuid/random)]
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :add-obj
:page-id page-id
:id frame-id
:parent-id uuid/zero
:frame-id uuid/zero
:components-v2 true
:obj (cts/setup-shape
{:id frame-id
:name "frame"
:frame-id uuid/zero
:parent-id uuid/zero
:type :frame})}
{:type :add-obj
:page-id page-id
:id rect-id
:parent-id frame-id
:frame-id frame-id
:components-v2 true
:obj (cts/setup-shape
{:id rect-id
:name "rect"
:frame-id frame-id
:parent-id frame-id
:type :rect})}])
(let [out (th/command! {::th/type :get-file-stats
::rpc/profile-id (:id profile)
:id (:id file)})
result (:result out)]
(t/is (nil? (:error out)))
(t/is (= 2 (get-in result [:shape-counts :total])))
(t/is (= 1 (get-in result [:shape-counts :by-type :rect])))
(t/is (= 1 (get-in result [:shape-counts :by-type :frame]))))))
(t/deftest get-file-stats-forbidden
(let [owner (th/create-profile* 1 {:is-active true})
other (th/create-profile* 2 {:is-active true})
file (th/create-file* 1 {:profile-id (:id owner)
:project-id (:default-project-id owner)
:is-shared false})
out (th/command! {::th/type :get-file-stats
::rpc/profile-id (:id other)
:id (:id file)})]
(t/is (not (nil? (:error out))))
(let [edata (-> out :error ex-data)]
(t/is (= :not-found (:type edata))))))
(t/deftest link-file-to-library-circular-reference
(let [profile (th/create-profile* 1)
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true})
file3 (th/create-file* 3 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
(th/link-file-to-library* {:file-id (:id file3) :library-id (:id file2)})
(th/link-file-to-library* {:file-id (:id file2) :library-id (:id file1)})
(let [data {::th/type :link-file-to-library
::rpc/profile-id (:id profile)
:file-id (:id file1)
:library-id (:id file3)}
out (th/command! data)]
(t/is (th/ex-info? (:error out)))
(t/is (th/ex-of-type? (:error out) :validation))
(let [edata (-> out :error ex-data)]
(t/is (= :circular-library-reference (:code edata)))))))
(t/deftest get-file-etag-includes-deleted-at
(let [profile-id (uuid/random)
file1 {:modified-at (ct/now)
:revn 1
:vern 0
:deleted-at nil
:permissions {:can-edit true}}
file2 (assoc file1 :deleted-at (ct/now))]
(t/is (not= (files/get-file-etag {::rpc/profile-id profile-id} file1)
(files/get-file-etag {::rpc/profile-id profile-id} file2)))))
(t/deftest search-files-with-permission
(let [profile (th/create-profile* 1)
_ (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
data {::th/type :search-files
::rpc/profile-id (:id profile)
:team-id (:default-team-id profile)
:search-term "test"}
out (th/command! data)]
(t/is (nil? (:error out)))
(t/is (vector? (:result out)))))
(t/deftest search-files-forbidden
(let [profile (th/create-profile* 1)
other (th/create-profile* 2)
data {::th/type :search-files
::rpc/profile-id (:id other)
:team-id (:default-team-id profile)
:search-term "test"}
out (th/command! data)]
(t/is (th/ex-info? (:error out)))
(let [edata (-> out :error ex-data)]
(t/is (= :not-found (:type edata))))))
(t/deftest search-files-term-too-long
(let [profile (th/create-profile* 1)
data {::th/type :search-files
::rpc/profile-id (:id profile)
:team-id (:default-team-id profile)
:search-term (apply str (repeat 300 "x"))}
out (th/command! data)]
(t/is (th/ex-info? (:error out)))
(let [edata (-> out :error ex-data)]
(t/is (= :validation (:type edata))))))
(t/deftest get-file-libraries-nonexistent-file
(let [prof (th/create-profile* 1 {:is-active true})
out (th/command! {::th/type :get-file-libraries
::rpc/profile-id (:id prof)
:file-id (uuid/random)})
err (:error out)]
(t/is (th/ex-info? err))
(t/is (th/ex-of-type? err :not-found))))
(t/deftest get-file-libraries-no-permission
(let [owner (th/create-profile* 1 {:is-active true})
other (th/create-profile* 2 {:is-active true})
file (th/create-file* 1 {:profile-id (:id owner)
:project-id (:default-project-id owner)})
out (th/command! {::th/type :get-file-libraries
::rpc/profile-id (:id other)
:file-id (:id file)})
err (:error out)]
(t/is (th/ex-info? err))
(t/is (th/ex-of-type? err :not-found))))
(t/deftest share-link-deletion-idor
(let [owner (th/create-profile* 1 {:is-active true})
editor (th/create-profile* 2 {:is-active true})
admin (th/create-profile* 3 {:is-active true})
proj-id (:default-project-id owner)
team-id (:default-team-id owner)
file (th/create-file* 1 {:profile-id (:id owner)
:project-id proj-id
:is-shared false})
;; Invite editor to the team with edit permissions
_ (th/create-team-role* {:team-id team-id
:profile-id (:id editor)
:role :editor})
;; Invite admin to the team with admin permissions
_ (th/create-team-role* {:team-id team-id
:profile-id (:id admin)
:role :admin})
;; Owner creates a share-link
slink (th/command! {::th/type :create-share-link
::rpc/profile-id (:id owner)
:file-id (:id file)
:pages #{(get-in file [:data :pages 0])}
:who-comment "team"
:who-inspect "all"})
slink-id (get-in slink [:result :id])]
(t/testing "owner can delete their own share-link"
(let [out (th/command! {::th/type :delete-share-link
::rpc/profile-id (:id owner)
:id slink-id})]
(t/is (nil? (:error out)))))
(t/testing "editor CANNOT delete owner's share-link (IDOR)"
;; Recreate the share-link for this test
(let [slink2 (th/command! {::th/type :create-share-link
::rpc/profile-id (:id owner)
:file-id (:id file)
:pages #{}
:who-comment "team"
:who-inspect "team"})
slink2-id (get-in slink2 [:result :id])
;; Editor tries to delete owner's share-link
out (th/command! {::th/type :delete-share-link
::rpc/profile-id (:id editor)
:id slink2-id})
err (:error out)
edata (ex-data err)]
;; Should be denied with authorization error
(t/is (th/ex-info? err))
(t/is (= :authorization (:type edata)))
;; Verify the share-link still exists
(let [check (th/command! {::th/type :get-view-only-bundle
::rpc/profile-id (:id owner)
:file-id (:id file)})
share-links (:share-links (:result check))]
(t/is (some #(= slink2-id (:id %)) share-links)))))))
(t/deftest share-link-page-scope-enforcement
(let [owner (th/create-profile* 1 {:is-active true})
viewer (th/create-profile* 2 {:is-active true})
proj-id (:default-project-id owner)
file (th/create-file* 1 {:profile-id (:id owner)
:project-id proj-id
:is-shared false})
page-a (get-in file [:data :pages 0])
page-b (uuid/random)
;; Add a second page to the file
_ (th/command! {::th/type :update-file
::rpc/profile-id (:id owner)
:id (:id file)
:session-id (uuid/random)
:revn 0
:vern 0
:changes [{:type :add-page
:id page-b
:page {:id page-b
:name "Page B"
:options {}
:objects {}}}]})
;; Create share-link scoped to page A only
share (th/command! {::th/type :create-share-link
::rpc/profile-id (:id owner)
:file-id (:id file)
:pages #{page-a}
:who-comment "team"
:who-inspect "all"})
share-id (get-in share [:result :id])]
(t/testing "share-link holder can access authorized page"
(let [out (th/command! {::th/type :get-page
::rpc/profile-id (:id viewer)
:file-id (:id file)
:page-id page-a
:share-id share-id})]
(t/is (nil? (:error out)))
(t/is (some? (:result out)))))
(t/testing "share-link holder cannot access out-of-scope page"
(let [out (th/command! {::th/type :get-page
::rpc/profile-id (:id viewer)
:file-id (:id file)
:page-id page-b
:share-id share-id})
err (:error out)
edata (ex-data err)]
(t/is (th/ex-info? err))
(t/is (= :not-found (:type edata)))
(t/is (= :object-not-found (:code edata)))))
(t/testing "team member can access all pages"
(let [out-a (th/command! {::th/type :get-page
::rpc/profile-id (:id owner)
:file-id (:id file)
:page-id page-a})
out-b (th/command! {::th/type :get-page
::rpc/profile-id (:id owner)
:file-id (:id file)
:page-id page-b})]
(t/is (nil? (:error out-a)))
(t/is (nil? (:error out-b)))))))
(t/deftest share-link-deletion-escape-hatches
(let [owner (th/create-profile* 1 {:is-active true})
editor (th/create-profile* 2 {:is-active true})
admin (th/create-profile* 3 {:is-active true})
proj-id (:default-project-id owner)
team-id (:default-team-id owner)
file (th/create-file* 1 {:profile-id (:id owner)
:project-id proj-id
:is-shared false})
;; Invite editor to the team with edit permissions
_ (th/create-team-role* {:team-id team-id
:profile-id (:id editor)
:role :editor})
;; Invite admin to the team with admin permissions
_ (th/create-team-role* {:team-id team-id
:profile-id (:id admin)
:role :admin})]
(t/testing "editor CAN delete their own share-link"
(let [slink (th/command! {::th/type :create-share-link
::rpc/profile-id (:id editor)
:file-id (:id file)
:pages #{}
:who-comment "team"
:who-inspect "team"})
slink-id (get-in slink [:result :id])
out (th/command! {::th/type :delete-share-link
::rpc/profile-id (:id editor)
:id slink-id})]
(t/is (nil? (:error out)))))
(t/testing "admin CAN delete editor's share-link"
(let [slink (th/command! {::th/type :create-share-link
::rpc/profile-id (:id editor)
:file-id (:id file)
:pages #{}
:who-comment "team"
:who-inspect "team"})
slink-id (get-in slink [:result :id])
out (th/command! {::th/type :delete-share-link
::rpc/profile-id (:id admin)
:id slink-id})]
(t/is (nil? (:error out)))))
(t/testing "owner CAN delete editor's share-link"
(let [slink (th/command! {::th/type :create-share-link
::rpc/profile-id (:id editor)
:file-id (:id file)
:pages #{}
:who-comment "team"
:who-inspect "team"})
slink-id (get-in slink [:result :id])
out (th/command! {::th/type :delete-share-link
::rpc/profile-id (:id owner)
:id slink-id})]
(t/is (nil? (:error out)))))))
(t/deftest share-link-fragment-access-denied
(let [owner (th/create-profile* 1 {:is-active true})
viewer (th/create-profile* 2 {:is-active true})
proj-id (:default-project-id owner)
file (th/create-file* 1 {:profile-id (:id owner)
:project-id proj-id
:is-shared false})
page-a (get-in file [:data :pages 0])
;; Create share-link
share (th/command! {::th/type :create-share-link
::rpc/profile-id (:id owner)
:file-id (:id file)
:pages #{page-a}
:who-comment "team"
:who-inspect "all"})
share-id (get-in share [:result :id])]
(t/testing "share-link holder cannot access file fragments"
(let [out (th/command! {::th/type :get-file-fragment
::rpc/profile-id (:id viewer)
:file-id (:id file)
:fragment-id (uuid/random)
:share-id share-id})
err (:error out)
edata (ex-data err)]
(t/is (th/ex-info? err))
(t/is (= :not-found (:type edata)))
(t/is (= :object-not-found (:code edata)))))))
(t/deftest create-file-rejects-client-id
(let [prof (th/create-profile* 1 {:is-active true})
sent-id (uuid/next)
out (th/command! {::th/type :create-file
::rpc/profile-id (:id prof)
:project-id (:default-project-id prof)
:name "file with client id"
:id sent-id})]
(t/is (th/ex-info? (:error out)))
(t/is (th/ex-of-type? (:error out) :validation))
(t/is (th/ex-of-code? (:error out) :params-validation))))
(t/deftest get-file-plugin-data
(let [profile (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
;; A file without plugin data returns an empty map
(let [out (th/command! {::th/type :get-file-plugin-data
::rpc/profile-id (:id profile)
:id (:id file)})]
(t/is (nil? (:error out)))
(t/is (= {} (:result out))))
;; Set file-level plugin data through a change
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 0
:vern 0
:changes
[{:type :set-plugin-data
:object-type :file
:namespace :shared/traceability
:key "req-id"
:value "REQ-123"}])
;; The full plugin-data map is returned
(let [out (th/command! {::th/type :get-file-plugin-data
::rpc/profile-id (:id profile)
:id (:id file)})]
(t/is (nil? (:error out)))
(t/is (= {:shared/traceability {"req-id" "REQ-123"}} (:result out))))
;; A namespace filter narrows the result
(let [out (th/command! {::th/type :get-file-plugin-data
::rpc/profile-id (:id profile)
:id (:id file)
:namespace :shared/traceability})]
(t/is (nil? (:error out)))
(t/is (= {:shared/traceability {"req-id" "REQ-123"}} (:result out))))
;; A filter on an absent namespace returns an empty map
(let [out (th/command! {::th/type :get-file-plugin-data
::rpc/profile-id (:id profile)
:id (:id file)
:namespace :plugin/absent})]
(t/is (nil? (:error out)))
(t/is (= {} (:result out))))))
(t/deftest get-file-plugin-data-forbidden
(let [owner (th/create-profile* 1 {:is-active true})
other (th/create-profile* 2 {:is-active true})
file (th/create-file* 1 {:profile-id (:id owner)
:project-id (:default-project-id owner)
:is-shared false})
out (th/command! {::th/type :get-file-plugin-data
::rpc/profile-id (:id other)
:id (:id file)})]
(t/is (not (nil? (:error out))))
(let [edata (-> out :error ex-data)]
(t/is (= :not-found (:type edata))))))
(t/deftest get-file-tokens-without-tokens
(let [profile (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
out (th/command! {::th/type :get-file-tokens
::rpc/profile-id (:id profile)
:file-id (:id file)})]
(t/is (nil? (:error out)))
(t/is (nil? (:result out)))))
(t/deftest get-file-tokens-with-tokens
(let [profile (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
set-id (uuid/next)
token-id (uuid/next)]
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:changes
[{:type :set-token-set
:id set-id
:attrs {:id set-id :name "brand-core"}}
{:type :set-token
:set-id set-id
:token-id token-id
:attrs {:id token-id
:name "color.primary-base"
:type :color
:value "#ff0000"}}])
(update-file!
:file-id (:id file)
:profile-id (:id profile)
:revn 1
:changes
[{:type :set-tokens-status
:theme-ids #{}
:set-ids #{set-id}}])
(let [out (th/command! {::th/type :get-file-tokens
::rpc/profile-id (:id profile)
:file-id (:id file)})
dtcg (:result out)]
(t/is (nil? (:error out)))
(t/is (= "#ff0000" (get-in dtcg ["brand-core" "color" "primary-base" "$value"])))
(t/is (= "color" (get-in dtcg ["brand-core" "color" "primary-base" "$type"])))
(t/is (= ["brand-core"] (get-in dtcg ["$metadata" "tokenSetOrder"])))
(t/is (= #{"brand-core"} (set (get-in dtcg ["$metadata" "activeSets"])))))))
(t/deftest get-file-tokens-forbidden
(let [owner (th/create-profile* 1 {:is-active true})
other (th/create-profile* 2 {:is-active true})
file (th/create-file* 1 {:profile-id (:id owner)
:project-id (:default-project-id owner)
:is-shared false})
out (th/command! {::th/type :get-file-tokens
::rpc/profile-id (:id other)
:file-id (:id file)})]
(t/is (th/ex-info? (:error out)))
(t/is (th/ex-of-type? (:error out) :not-found))))
(t/deftest delete-file-audit-event-carries-team-id
;; The event already carries the project id, so the resolver could find the
;; team; the command has the team row and sets the id without a lookup.
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile)})
project (th/create-project* 1 {:profile-id (:id profile)
:team-id (:id team)})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id project)})
wrapped (th/command-raw! {::th/type :delete-file
::rpc/profile-id (:id profile)
:id (:id file)})]
(t/is (= (:id team)
(get-in (meta wrapped) [:app.loggers.audit/props :team-id])))))
(t/deftest create-file-audit-event-carries-its-id
;; The command returns the new file but did not emit its id, so a consumer
;; could not key a local projection.
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile)})
project (th/create-project* 1 {:profile-id (:id profile)
:team-id (:id team)})
out (th/command! {::th/type :create-file
::rpc/profile-id (:id profile)
:project-id (:id project)
:name "foobar"
:is-shared false})]
(t/is (th/success? out))
(t/is (= (get-in out [:result :id])
(get-in (meta (:result out)) [:app.loggers.audit/props :id])))
(t/is (= (:id team)
(get-in (meta (:result out)) [:app.loggers.audit/props :team-id])))))
(t/deftest get-team-shared-files-skips-files-that-fail-to-load
(let [profile (th/create-profile* 1)
file1 (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true})
file2 (th/create-file* 2 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true})
get-file (deref #'files/get-file-with-summary)
broken (fn [cfg id]
(if (= id (:id file1))
(throw (ex-info "broken file" {:type :assertion}))
(get-file cfg id)))
out (with-redefs-fn {#'files/get-file-with-summary broken}
#(th/command! {::th/type :get-team-shared-files
::rpc/profile-id (:id profile)
:team-id (:default-team-id profile)}))]
(t/is (th/success? out))
(t/is (= #{(:id file2)} (into #{} (map :id) (:result out))))))
Reference in New Issue View Git Blame Copy Permalink