penpot/backend/test/backend_tests/objects_gc_test.clj
Andrey Antukh 42f6c952e1 ✨ Cache per-team media storage usage from the audit log
The media-storage-bytes-per-team quota ran a full SUM over
storage_object on every upload, taking seconds on large teams. A new
team_storage_usage table (migration 0158) caches the counter: a third
audit-log consumer (storage-usage) selectively queues the events that
change media storage, marks their teams dirty, and a scheduler turns
the marks into per-team recompute jobs on a dedicated :storage queue.
The quota reads the counter, always answers one row, and fails open
when the row is missing; the three commands that write media bytes pay
it.

The dirty-team stream runs in one read-only transaction and submits
each 50-team chunk through its own writable one (db/own-transaction),
so a killed run keeps what it already enqueued and the next tick
resumes the rest. The recompute only clears marks older than its read,
and the query also returns the rows nobody refreshed for a week, so a
lost mark heals at a bounded rate instead of never.

Producers resolve team ids at emission with one batched lookup, so the
drain never joins production tables: file-gc carries its team, the
delete cascade reports flat and nested ids, moves carry explicit
source/destination teams (mixed origins rejected), restores carry
theirs, and purges carry only their entity key. Selective queueing is
gated per consumer flag on both ingest paths, and telemetry shadows
never queue the admin-console consumer. An audit event that cannot be
stored now fails loudly instead of leaving a consumer stale.

The delete cascade owns library relations: the RPC only marks the file
deleted, and the job captures dependents, removes the relations and
absorbs them under a savepoint, only for survivors. Jobs queued by the
previous release still absorb through a deprecated :file-ids snapshot.

Closes #12462

AI-assisted-by: muse-spark-1.3-contributor
2026-10-23 16:47:55 +02:00

249 lines
11 KiB
Clojure

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC Sucursal en España SL
(ns backend-tests.objects-gc-test
(:require
[app.common.logging :as l]
[app.common.time :as ct]
[app.config :as cf]
[app.db :as db]
[app.rpc :as-alias rpc]
[app.storage :as sto]
[app.tasks.objects-gc :as ogc]
[backend-tests.helpers :as th]
[clojure.test :as t]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(defn- create-deleted-file!
"Creates a file and applies the deletion cascade on it (the same task the RPC
uses), so its children are marked as deleted for the given date. Returns the
file."
[profile i deleted-at]
(let [file (th/create-file* i {:profile-id (:id profile)
:project-id (:default-project-id profile)})]
(th/run-task! :delete-object {:object :file
:deleted-at deleted-at
:id (:id file)})
file))
(defn- block-file!
"Leaves an unmarked `file_media_object` pointing at the file, which is what
happens in production: a child that the deletion cascade did not mark. Its
foreign key towards `file` is `NO ACTION`, so it blocks the file deletion."
[file]
(let [media (sto/put-object! (::sto/storage th/*system*)
{::sto/content (sto/content "media")
:content-type "text/plain"
:bucket "file-media-object"})]
(th/create-file-media-object* {:file-id (:id file)
:media-id (:id media)})))
(defn- find-file
[id]
(th/db-get :file {:id id} {::db/remove-deleted false}))
(defn- chunk-error
"The first captured log record that reports a skipped chunk for `obj`,
waiting for it because logging is asynchronous."
[records obj]
(let [deadline (+ (System/currentTimeMillis) 5000)]
(loop []
(let [record (first (filter (fn [record]
(let [props (::l/props record)]
(and (= obj (get props :obj))
(= "error on chunk deletion, skipping it"
(get props :hint)))))
@records))]
(cond
record record
(> (System/currentTimeMillis) deadline) nil
:else (do (Thread/sleep 10) (recur)))))))
(t/deftest deletes-the-pending-files
(let [profile (th/create-profile* 1)
file (create-deleted-file! profile 1 (ct/in-past "10m"))
result (th/run-task! :objects-gc {})]
(t/is (pos? (:processed result)))
(t/is (nil? (find-file (:id file))))))
(t/deftest profile-cascade-keeps-profile-deletion-date
;; The cascade marks the owned rows with the deletion date of the profile,
;; like the RPC delete-profile flow does, not with the timestamp of the run.
;; The team survives because only the profiles chunk runs here, so its row
;; still shows that date.
(let [profile (th/create-profile* 1)
_ (th/db-update! :profile {:deleted-at (ct/in-past "30m")} {:id (:id profile)})
deleted-at (:deleted-at (th/db-get :profile {:id (:id profile)}
{::db/remove-deleted false}))
cfg {::db/pool th/*pool*
::sto/storage (::sto/storage th/*system*)
::ogc/threshold deleted-at}
total (#'ogc/delete-profiles-chunk cfg [(:id profile)])]
(t/testing "the profile is gone and the chunk reports it"
(t/is (= 1 total))
(t/is (nil? (th/db-get :profile {:id (:id profile)} {::db/remove-deleted false}))))
(t/testing "the owned team keeps the deletion date of the profile"
(t/is (= deleted-at (:deleted-at (th/db-get :team {:id (:default-team-id profile)}
{::db/remove-deleted false})))))))
(t/deftest blocked-chunk-does-not-stop-the-run
;; Chunks of one file: the blocked file takes down its own chunk and nothing
;; else, so the clean file of the next chunk is still deleted and the run
;; finishes. The next run retries the blocked file.
(let [profile (th/create-profile* 1)
blocked (create-deleted-file! profile 1 (ct/in-past "30m"))
clean (create-deleted-file! profile 2 (ct/in-past "20m"))
_ (block-file! blocked)
records (atom [])
_ (add-watch l/log-record ::capture
(fn [_ _ _ record] (swap! records conj record)))
result (try
(th/run-task! :objects-gc {:chunk-size 1})
(finally
(remove-watch l/log-record ::capture)))]
(t/testing "the clean file of the next chunk is deleted"
(t/is (nil? (find-file (:id clean)))))
(t/testing "the blocked file is still pending"
(t/is (some? (find-file (:id blocked)))))
(t/testing "the failed chunk is reported"
(t/is (some? (chunk-error records "file"))))
(t/testing "the run finishes"
(t/is (pos? (:processed result))))))
(defn- submitted-events
[audit-mock]
(->> (:call-args-list @audit-mock)
(map second)))
(defn- events-named
[audit-mock event-name]
(filter #(= event-name (:name %))
(submitted-events audit-mock)))
(t/deftest gc-emits-hard-delete-objects-for-teams
;; When the GC physically deletes a team, the projection must drop its row,
;; so the event carries the purged ids.
(with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}]
(with-redefs [cf/flags (conj cf/flags :audit-log)]
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 71 {:profile-id (:id profile)})]
(th/command! {::th/type :delete-team
::rpc/profile-id (:id profile)
:id (:id team)})
;; Run the queued cascade so the default project is marked deleted too,
;; then purge everything the way production does.
(th/run-pending-jobs)
(th/reset-mock! audit-mock)
(th/run-task! :objects-gc {:skip-delay true})
(t/is (nil? (th/db-get :team {:id (:id team)} {::db/remove-deleted false})))
(let [events (filter #(= #{:team-ids} (set (keys (:props %))))
(events-named audit-mock "hard-delete-objects"))]
;; Every chunk carries exactly its own entity key and nothing
;; else: no flat team-ids are resolved after the delete.
(t/is (= 1 (count events)))
(let [event (first events)]
(t/is (= "command" (:type event)))
(t/is (= [(:id team)] (get-in event [:props :team-ids])))
(t/is (= "objects-gc" (get-in event [:context :triggered-by])))))))))
(t/deftest gc-emits-hard-delete-objects-for-projects
(with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}]
(with-redefs [cf/flags (conj cf/flags :audit-log)]
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 72 {:profile-id (:id profile)})
project (th/create-project* 72 {:profile-id (:id profile)
:team-id (:id team)})]
(th/command! {::th/type :delete-project
::rpc/profile-id (:id profile)
:id (:id project)})
(th/run-pending-jobs)
(th/reset-mock! audit-mock)
(th/run-task! :objects-gc {:skip-delay true})
(t/is (nil? (th/db-get :project {:id (:id project)} {::db/remove-deleted false})))
(let [events (filter #(contains? (:props %) :project-ids)
(events-named audit-mock "hard-delete-objects"))]
(t/is (= 1 (count events)))
(let [event (first events)]
(t/is (= "command" (:type event)))
(t/is (= #{:project-ids} (set (keys (:props event)))))
(t/is (= [(:id project)] (get-in event [:props :project-ids])))
(t/is (= "objects-gc" (get-in event [:context :triggered-by])))))))))
(t/deftest gc-emits-hard-delete-objects-for-files
(with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}]
(with-redefs [cf/flags (conj cf/flags :audit-log)]
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 73 {:profile-id (:id profile)})
project (th/create-project* 73 {:profile-id (:id profile)
:team-id (:id team)})
file (th/create-file* 73 {:profile-id (:id profile)
:project-id (:id project)})]
(th/command! {::th/type :delete-file
::rpc/profile-id (:id profile)
:id (:id file)})
(th/run-pending-jobs)
(th/reset-mock! audit-mock)
(th/run-task! :objects-gc {:skip-delay true})
(t/is (nil? (th/db-get :file {:id (:id file)} {::db/remove-deleted false})))
(let [events (filter #(contains? (:props %) :file-ids)
(events-named audit-mock "hard-delete-objects"))]
(t/is (= 1 (count events)))
(let [event (first events)]
(t/is (= "command" (:type event)))
(t/is (= #{:file-ids} (set (keys (:props event)))))
(t/is (= [(:id file)] (get-in event [:props :file-ids])))
(t/is (= "objects-gc" (get-in event [:context :triggered-by])))))))))
(t/deftest gc-emits-no-event-without-audit-log-flag
;; The GC must stay silent when the audit log is off, even though the row is
;; still purged.
(with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}]
(let [profile (th/create-profile* 1 {:is-active true})
team (th/create-team* 74 {:profile-id (:id profile)})]
(th/command! {::th/type :delete-team
::rpc/profile-id (:id profile)
:id (:id team)})
(th/run-pending-jobs)
(th/reset-mock! audit-mock)
(th/run-task! :objects-gc {:skip-delay true})
(t/is (nil? (th/db-get :team {:id (:id team)} {::db/remove-deleted false})))
(t/is (empty? (:call-args-list @audit-mock))))))
(t/deftest gc-emits-events-only-for-committed-chunks
(with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}]
(with-redefs [cf/flags (conj cf/flags :audit-log)]
(let [profile (th/create-profile* 1)
rolled-back (create-deleted-file! profile 1 (ct/in-past "30m"))
blocked (create-deleted-file! profile 2 (ct/in-past "20m"))
clean (create-deleted-file! profile 3 (ct/in-past "10m"))]
(block-file! blocked)
(th/reset-mock! audit-mock)
(let [result (th/run-task! :objects-gc {:chunk-size 2})
events (filter #(contains? (:props %) :file-ids)
(events-named audit-mock "hard-delete-objects"))]
(t/testing "the failed chunk keeps both files"
(t/is (some? (find-file (:id rolled-back))))
(t/is (some? (find-file (:id blocked)))))
(t/testing "the next chunk commits and reports only its deleted file"
(t/is (nil? (find-file (:id clean))))
(t/is (pos? (:processed result)))
(t/is (= 1 (count events)))
(t/is (= [(:id clean)] (get-in (first events) [:props :file-ids])))))))))