github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-11-07 02:20:36 +00:00
Code Issues Packages Projects Releases Wiki Activity
penpot/backend/test/backend_tests/rpc_file_test.clj
Andrey Antukh 924f2988dc 🐛 Heal corrupt files in file-gc and fix its library loader 
Teach the file-gc task to heal files whose stored data fails schema
or semantic validation instead of failing the nightly run: read once
(sanitize, migrate in memory, check the scheduled revn), run the
shared best-effort repair loop, then take the row lock and persist
the snapshot, marking the file trimmed. A new revision orphaned the
current file thumbnail (the list joins on revn), so a run that
changes bytes touches modified-at instead (the ETag covers it) and
no-op runs touch nothing; the change is detected against the decoded
pre-sanitize data, which get-file now returns as :orig-data. The
handler reports a result map with a keyword reason (:cleaned, :gone,
:stale-revn, :unfixable, :error) and the tiered-storage offload
submit runs outside the result handling, so a queue failure after a
good write stays truthful and only logs its own error. The
library-user scan moved out of the write transaction, so long scans
no longer trip idle-in-transaction timeouts.

Repair convergence lives in one shared loop used by file-gc, the
debug endpoint and the srepl helper: validate, apply the computed
repair changes and repeat up to ten times, returning the input
untouched when it throws or does not converge. file-gc revalidates
after the loop and raises :repair-did-not-converge, so a partial
cleanup is never stored as clean: the classifier reports :unfixable,
the file stays unmarked and the scheduler retries it. Validation
skips shapes without :shape-ref (copy roots legitimately carry
none), so the repair converges instead of crashing on the get-shape
precondition; a dedicated repair for copies that genuinely lost
their ref is future work.

Libraries load through the weak-map loader, and that loader was
broken: the threading macro passed :data to update as the map
itself, so every library load threw and the repair loop swallowed
the exception, silently skipping every repair for files with linked
libraries. The pipeline is now explicit: load, realize pointers
(they take [cfg file], so the reversed -> threading was returning
the Integrant system map) and then sanitize. Unconverted types broke
ref resolution (detaching copies) and hid real uses from
instance-of?, so libraries are sanitized on load, user files are
sanitized inside the library-user scan, and the srepl helper and the
debug endpoint sanitize too. Only migrate when migrations pend.

sanitize-file-data now returns the input instance unchanged when
neither the nil-entry drop nor the schema decode repairs anything:
lazy containers (objects-map) keep their identity and file-gc can
tell a real fix from a no-op by comparing with the pre-sanitize
data. The walk still happens on every call, and that cost is
documented on the loader.

Migration 0027 heals stored data durably with the same recipe the
read path applies: schema-decode unconverted types (precompiled
decoders, explicit component-objects pass) plus the legacy-57 nil
page cleanup that reappeared through a write path. clean-file keeps
only its post-decode fixes and documents the single sanitize pass.
Change-level guards reject :add-page without a valid page id
(structured error, not assert, so release CLJS still enforces it)
and conflicting id/page pairs.

Tests pin the contract with production-shaped corruption builders:
file-gc repair and the outcome matrix, loop convergence and give-up
branches, the :shape-ref guard both ways, page guards, sanitize
idempotence and identity (plain and objects-map), the 0027
migration, a remote copy resolved through the loaded library and the
non-convergence report; existing file suites move to the result map
through the run-file-gc! helper.

Closes #12433

Follow-up:
https://github.com/penpot/penpot/issues/12509

AI-assisted-by: muse-spark-1.3-contributor
AI-assisted-by: glm-5.3-flash
2026-10-23 17:20:15 +02:00

3331 lines
132 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.jobs :as-alias jobs]
[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? (:cleaned (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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (:id file-1)))))
(t/is (true? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (: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? (:cleaned (th/run-file-gc! (:id file-1)))))
(t/is (true? (:cleaned (th/run-file-gc! (: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 stay until the deletion task runs: the job
;; captures the dependents, removes the relations and absorbs
;; them there.
(t/is (not (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)
(t/is (empty? (th/db-query :file-library-rel {:library-file-id (:id library)})))
(check-tokens-absorbed prepared)))
(t/deftest delete-shared-library-absorb-failure-keeps-cascade-going
;; If the absorb blows up, the savepoint rolls it back (relations
;; included) and the cascade goes on: the file is still marked deleted,
;; the relations are intact for the next retry, and the job succeeds.
(let [profile (th/create-profile* 1)
{:keys [library]} (prepare-tokens-library profile)
out (th/command! {::th/type :delete-file
::rpc/profile-id (:id profile)
:id (:id library)})]
(t/is (nil? (:error out)))
(with-redefs [files/absorb-library (fn [& _] (throw (ex-info "boom" {})))]
(th/run-pending-jobs))
(t/is (not (empty? (th/db-query :file-library-rel {:library-file-id (:id library)}))))
(t/is (some? (:deleted-at (th/db-get :file {:id (:id library)} {::db/remove-deleted false}))))))
(t/deftest delete-shared-library-queues-job-without-file-ids
;; The cascade captures the dependents itself: the RPC no longer
;; snapshots them into the job params.
(let [profile (th/create-profile* 1)
{:keys [library]} (prepare-tokens-library profile)
submitted (atom nil)]
(with-redefs [jobs/submit (fn [_ params] (reset! submitted params) (uuid/next))]
(let [out (th/command! {::th/type :delete-file
::rpc/profile-id (:id profile)
:id (:id library)})]
(t/is (nil? (:error out)))))
(t/is (= :delete-object (::jobs/name @submitted)))
(t/is (not (contains? (::jobs/params @submitted) :file-ids)))))
(t/deftest delete-project-skips-absorb-for-files-dying-together
;; When the whole project dies, absorbing the shared library into
;; its own dying files is wasted work: the cascade cleans the
;; relations but leaves the dependents untouched.
(let [profile (th/create-profile* 1)
team-id (:default-team-id profile)
proj (th/create-project* 1 {:profile-id (:id profile) :team-id team-id})
library (th/create-file* 1 {:profile-id (:id profile)
:project-id (:id proj)
:is-shared true})
file (th/create-file* 2 {:profile-id (:id profile)
:project-id (:id proj)})
_ (th/link-file-to-library* {:file-id (:id file)
:library-id (:id library)})
revn (:revn (th/db-get :file {:id (:id file)}))]
(let [out (th/command! {::th/type :delete-project
::rpc/profile-id (:id profile)
:id (:id proj)})]
(t/is (nil? (:error out))))
(th/run-pending-jobs)
;; Nothing outside the cascade uses the library, so the relations
;; stay until the hard delete removes them with their files.
(t/is (not (empty? (th/db-query :file-library-rel {:library-file-id (:id library)}))))
(t/is (= revn (:revn (th/db-get :file {:id (:id file)} {::db/remove-deleted false}))))
;; The hard delete cascades the relations away with their files.
(th/run-task! :objects-gc {:skip-delay true})
(t/is (nil? (th/db-get :file {:id (:id file)} {::db/remove-deleted false})))
(t/is (empty? (th/db-query :file-library-rel {:library-file-id (:id library)})))))
(t/deftest delete-object-absorbs-with-deprecated-file-ids
;; Deploy window: a job queued by the previous release carries the
;; dependents in :file-ids and its RPC already deleted the relations.
;; The live lookup finds nothing, so the worker must trust the
;; snapshot instead of skipping the absorb silently.
(let [profile (th/create-profile* 6 {:is-active true})
team-id (:default-team-id profile)
proj (th/create-project* 6 {:profile-id (:id profile) :team-id team-id})
library (th/create-file* 8 {:profile-id (:id profile)
:project-id (:id proj)
:is-shared true})
dependent (th/create-file* 9 {:profile-id (:id profile)
:project-id (:id proj)})
_ (th/link-file-to-library* {:file-id (:id dependent)
:library-id (:id library)})
revn (:revn (th/db-get :file {:id (:id dependent)}))]
;; What the old RPC did: drop the relations before queueing.
(th/db-delete! :file-library-rel {:library-file-id (:id library)})
(th/run-task! :delete-object {:object :file
:id (:id library)
:deleted-at (ct/now)
:file-ids [(:id dependent)]})
(t/is (> (:revn (th/db-get :file {:id (:id dependent)} {::db/remove-deleted false}))
revn))))
(t/deftest delete-project-absorbs-into-surviving-dependent
;; The doomed-set only skips files that die in the same cascade: a
;; dependent in another project of the team survives, so the library
;; must be absorbed into it (and only into it).
(let [profile (th/create-profile* 5 {:is-active true})
team-id (:default-team-id profile)
proj-a (th/create-project* 5 {:profile-id (:id profile) :team-id team-id})
proj-b (th/create-project* 6 {:profile-id (:id profile) :team-id team-id})
library (th/create-file* 5 {:profile-id (:id profile)
:project-id (:id proj-a)
:is-shared true})
doomed (th/create-file* 6 {:profile-id (:id profile)
:project-id (:id proj-a)})
survivor (th/create-file* 7 {:profile-id (:id profile)
:project-id (:id proj-b)})
_ (th/link-file-to-library* {:file-id (:id survivor)
:library-id (:id library)})
revn-sur (:revn (th/db-get :file {:id (:id survivor)}))
revn-doom (:revn (th/db-get :file {:id (:id doomed)}))]
(let [out (th/command! {::th/type :delete-project
::rpc/profile-id (:id profile)
:id (:id proj-a)})]
(t/is (nil? (:error out))))
(th/run-pending-jobs)
;; The survivor absorbed the library; its relation is gone.
(t/is (> (:revn (th/db-get :file {:id (:id survivor)} {::db/remove-deleted false}))
revn-sur))
(t/is (empty? (th/db-query :file-library-rel {:file-id (:id survivor)})))
;; The doomed file did not absorb anything.
(t/is (= revn-doom (:revn (th/db-get :file {:id (:id doomed)} {::db/remove-deleted false}))))))
(t/deftest delete-team-skips-absorb-for-files-dying-together
;; Team deletions skip absorb entirely (*team-deletion*): a library
;; in project A used from project B dies with the team, so absorb
;; never runs and the relations stay until the hard delete.
(let [profile (th/create-profile* 4 {:is-active true})
team (th/create-team* 4 {:profile-id (:id profile)})
proj-a (th/create-project* 4 {:profile-id (:id profile) :team-id (:id team)})
proj-b (th/create-project* 5 {:profile-id (:id profile) :team-id (:id team)})
library (th/create-file* 6 {:profile-id (:id profile)
:project-id (:id proj-a)
:is-shared true})
file (th/create-file* 7 {:profile-id (:id profile)
:project-id (:id proj-b)})
_ (th/link-file-to-library* {:file-id (:id file)
:library-id (:id library)})
revn (:revn (th/db-get :file {:id (:id file)}))
calls (atom 0)]
(let [out (th/command! {::th/type :delete-team
::rpc/profile-id (:id profile)
:id (:id team)})]
(t/is (nil? (:error out))))
(with-redefs [files/absorb-library (fn [& _] (swap! calls inc) nil)]
(th/run-pending-jobs))
(t/is (zero? @calls))
(t/is (not (empty? (th/db-query :file-library-rel {:library-file-id (:id library)}))))
(t/is (= revn (:revn (th/db-get :file {:id (:id file)} {::db/remove-deleted false}))))
;; The hard delete cascades the relations away with their files.
(th/run-task! :objects-gc {:skip-delay true})
(t/is (nil? (th/db-get :file {:id (:id file)} {::db/remove-deleted false})))
(t/is (empty? (th/db-query :file-library-rel {:library-file-id (:id library)})))))
(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 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