3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-25 11:26:12 +02:00
Code Issues Projects Releases Packages Wiki Activity

✨ Add safety mechanism for direct object deletion

Browse source 
The main objective is prevent deletion of objects that can leave
unreachable orphan objects which we are unable to correctly track.

Additionally, this commit includes:

1. Properly implement safe cascade deletion of all participating
   tables on soft deletion in the objects-gc task;

2. Make the file thumbnail related tables also participate in the
   touch/refcount mechanism applyign to the same safety checks;

3. Add helper for db query lazy iteration using PostgreSQL support
   for server side cursors;

4. Fix efficiency issues on gc related task using server side
   cursors instead of custom chunked iteration for processing data.

   The problem resided when a large chunk of rows that has identical
   value on the deleted_at column and the chunk size is small (the
   default); when the custom chunked iteration only reads a first N
   items and skip the rest of the set to the next run.

   This has caused many objects to remain pending to be eliminated,
   taking up space for longer than expected. The server side cursor
   based iteration does not has this problem and iterates correctly
   over all objects.

5. Fix refcount issues on font variant deletion RPC methods
This commit is contained in:
Andrey Antukh 2023-12-29 15:21:14 +01:00
parent e6fb96c4c2
commit addb392ecc
37 changed files with 1918 additions and 1026 deletions
Download patch file Download diff file Expand all files Collapse all files

19
backend/src/app/db.clj
View file

@ -341,6 +341,25 @@
(-> (get-connectable ds) (-> (get-connectable ds)
(jdbc/plan sql sql/default-opts))) (jdbc/plan sql sql/default-opts)))
(defn cursor
"Return a lazy seq of rows using server side cursors"
[conn query & {:keys [chunk-size] :or {chunk-size 25}}]
(let [cname (str (gensym "cursor_"))
fquery [(str "FETCH " chunk-size " FROM " cname)]]
;; declare cursor
(exec-one! conn
(if (vector? query)
(into [(str "DECLARE " cname " CURSOR FOR " (nth query 0))]
(rest query))
[(str "DECLARE " cname " CURSOR FOR " query)]))
;; return a lazy seq
((fn fetch-more []
(lazy-seq
(when-let [chunk (seq (exec! conn fquery))]
(concat chunk (fetch-more))))))))
(defn get-by-id (defn get-by-id
[ds table id & {:as opts}] [ds table id & {:as opts}]
(get ds table {:id id} opts)) (get ds table {:id id} opts))

48
backend/src/app/loggers/audit.clj
View file

@ -133,7 +133,7 @@
[_ {:keys [::db/pool] :as cfg}] [_ {:keys [::db/pool] :as cfg}]
(cond (cond
(db/read-only? pool) (db/read-only? pool)
(l/warn :hint "audit: disabled (db is read-only)") (l/warn :hint "audit disabled (db is read-only)")
:else :else
cfg)) cfg))
@ -187,8 +187,7 @@
false)})) false)}))
(defn- handle-event! (defn- handle-event!
[conn-or-pool event] [cfg event]
(us/verify! ::event event)
(let [params {:id (uuid/next) (let [params {:id (uuid/next)
:name (::name event) :name (::name event)
:type (::type event) :type (::type event)
@ -201,19 +200,22 @@
;; NOTE: this operation may cause primary key conflicts on inserts ;; NOTE: this operation may cause primary key conflicts on inserts
;; because of the timestamp precission (two concurrent requests), in ;; because of the timestamp precission (two concurrent requests), in
;; this case we just retry the operation. ;; this case we just retry the operation.
(rtry/with-retry {::rtry/when rtry/conflict-exception? (let [cfg (-> cfg
::rtry/max-retries 6 (assoc ::rtry/when rtry/conflict-exception?)
::rtry/label "persist-audit-log" (assoc ::rtry/max-retries 6)
::db/conn (dm/check db/connection? conn-or-pool)} (assoc ::rtry/label "persist-audit-log"))
(let [now (dt/now)] params (-> params
(db/insert! conn-or-pool :audit-log (update :props db/tjson)
(-> params (update :context db/tjson)
(update :props db/tjson) (update :ip-addr db/inet)
(update :context db/tjson) (assoc :source "backend"))]
(update :ip-addr db/inet)
(assoc :created-at now) (rtry/invoke cfg (fn [cfg]
(assoc :tracked-at now) (let [tnow (dt/now)
(assoc :source "backend")))))) params (-> params
(assoc :created-at tnow)
(assoc :tracked-at tnow))]
(db/insert! cfg :audit-log params))))))
(when (and (contains? cf/flags :webhooks) (when (and (contains? cf/flags :webhooks)
(::webhooks/event? event)) (::webhooks/event? event))
@ -226,7 +228,7 @@
:else label) :else label)
dedupe? (boolean (and batch-key batch-timeout))] dedupe? (boolean (and batch-key batch-timeout))]
(wrk/submit! ::wrk/conn conn-or-pool (wrk/submit! ::wrk/conn (::db/conn cfg)
::wrk/task :process-webhook-event ::wrk/task :process-webhook-event
::wrk/queue :webhooks ::wrk/queue :webhooks
::wrk/max-retries 0 ::wrk/max-retries 0
@ -243,12 +245,12 @@
(defn submit! (defn submit!
"Submit audit event to the collector." "Submit audit event to the collector."
[cfg params] [cfg params]
(let [conn (or (::db/conn cfg) (::db/pool cfg))] (try
(us/assert! ::db/pool-or-conn conn) (let [event (d/without-nils params)]
(try (us/verify! ::event event)
(handle-event! conn (d/without-nils params)) (db/tx-run! cfg handle-event! event))
(catch Throwable cause (catch Throwable cause
(l/error :hint "audit: unexpected error processing event" :cause cause))))) (l/error :hint "unexpected error processing event" :cause cause))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TASK: ARCHIVE ;; TASK: ARCHIVE

17
backend/src/app/main.clj
View file

@ -34,6 +34,8 @@
[app.srepl :as-alias srepl] [app.srepl :as-alias srepl]
[app.storage :as-alias sto] [app.storage :as-alias sto]
[app.storage.fs :as-alias sto.fs] [app.storage.fs :as-alias sto.fs]
[app.storage.gc-deleted :as-alias sto.gc-deleted]
[app.storage.gc-touched :as-alias sto.gc-touched]
[app.storage.s3 :as-alias sto.s3] [app.storage.s3 :as-alias sto.s3]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
@ -202,11 +204,11 @@
:app.storage.tmp/cleaner :app.storage.tmp/cleaner
{::wrk/executor (ig/ref ::wrk/executor)} {::wrk/executor (ig/ref ::wrk/executor)}
::sto/gc-deleted-task ::sto.gc-deleted/handler
{::db/pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)} ::sto/storage (ig/ref ::sto/storage)}
::sto/gc-touched-task ::sto.gc-touched/handler
{::db/pool (ig/ref ::db/pool)} {::db/pool (ig/ref ::db/pool)}
::http.client/client ::http.client/client
@ -337,12 +339,13 @@
::wrk/tasks ::wrk/tasks
{:sendmail (ig/ref ::email/handler) {:sendmail (ig/ref ::email/handler)
:objects-gc (ig/ref :app.tasks.objects-gc/handler) :objects-gc (ig/ref :app.tasks.objects-gc/handler)
:orphan-teams-gc (ig/ref :app.tasks.orphan-teams-gc/handler)
:file-gc (ig/ref :app.tasks.file-gc/handler) :file-gc (ig/ref :app.tasks.file-gc/handler)
:file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler) :file-xlog-gc (ig/ref :app.tasks.file-xlog-gc/handler)
:storage-gc-deleted (ig/ref ::sto/gc-deleted-task)
:storage-gc-touched (ig/ref ::sto/gc-touched-task)
:tasks-gc (ig/ref :app.tasks.tasks-gc/handler) :tasks-gc (ig/ref :app.tasks.tasks-gc/handler)
:telemetry (ig/ref :app.tasks.telemetry/handler) :telemetry (ig/ref :app.tasks.telemetry/handler)
:storage-gc-deleted (ig/ref ::sto.gc-deleted/handler)
:storage-gc-touched (ig/ref ::sto.gc-touched/handler)
:session-gc (ig/ref ::session.tasks/gc) :session-gc (ig/ref ::session.tasks/gc)
:audit-log-archive (ig/ref ::audit.tasks/archive) :audit-log-archive (ig/ref ::audit.tasks/archive)
:audit-log-gc (ig/ref ::audit.tasks/gc) :audit-log-gc (ig/ref ::audit.tasks/gc)
@ -373,6 +376,9 @@
{::db/pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)} ::sto/storage (ig/ref ::sto/storage)}
:app.tasks.orphan-teams-gc/handler
{::db/pool (ig/ref ::db/pool)}
:app.tasks.file-gc/handler :app.tasks.file-gc/handler
{::db/pool (ig/ref ::db/pool) {::db/pool (ig/ref ::db/pool)
::sto/storage (ig/ref ::sto/storage)} ::sto/storage (ig/ref ::sto/storage)}
@ -458,6 +464,9 @@
{:cron #app/cron "0 0 0 * * ?" ;; daily {:cron #app/cron "0 0 0 * * ?" ;; daily
:task :objects-gc} :task :objects-gc}
{:cron #app/cron "0 0 0 * * ?" ;; daily
:task :orphan-teams-gc}
{:cron #app/cron "0 0 0 * * ?" ;; daily {:cron #app/cron "0 0 0 * * ?" ;; daily
:task :storage-gc-deleted} :task :storage-gc-deleted}

35
backend/src/app/migrations.clj
View file

@ -337,7 +337,40 @@
:fn (mg/resource "app/migrations/sql/0106-mod-team-table.sql")} :fn (mg/resource "app/migrations/sql/0106-mod-team-table.sql")}
{:name "0107-mod-file-tagged-object-thumbnail-table" {:name "0107-mod-file-tagged-object-thumbnail-table"
:fn (mg/resource "app/migrations/sql/0107-mod-file-tagged-object-thumbnail-table.sql")}]) :fn (mg/resource "app/migrations/sql/0107-mod-file-tagged-object-thumbnail-table.sql")}
{:name "0107-add-deletion-protection-trigger-function"
:fn (mg/resource "app/migrations/sql/0107-add-deletion-protection-trigger-function.sql")}
{:name "0108-mod-file-thumbnail-table"
:fn (mg/resource "app/migrations/sql/0108-mod-file-thumbnail-table.sql")}
{:name "0109-mod-file-tagged-object-thumbnail-table"
:fn (mg/resource "app/migrations/sql/0109-mod-file-tagged-object-thumbnail-table.sql")}
{:name "0110-mod-file-media-object-table"
:fn (mg/resource "app/migrations/sql/0110-mod-file-media-object-table.sql")}
{:name "0111-mod-file-data-fragment-table"
:fn (mg/resource "app/migrations/sql/0111-mod-file-data-fragment-table.sql")}
{:name "0112-mod-profile-table"
:fn (mg/resource "app/migrations/sql/0112-mod-profile-table.sql")}
{:name "0113-mod-team-font-variant-table"
:fn (mg/resource "app/migrations/sql/0113-mod-team-font-variant-table.sql")}
{:name "0114-mod-team-table"
:fn (mg/resource "app/migrations/sql/0114-mod-team-table.sql")}
{:name "0115-mod-project-table"
:fn (mg/resource "app/migrations/sql/0115-mod-project-table.sql")}
{:name "0116-mod-file-table"
:fn (mg/resource "app/migrations/sql/0116-mod-file-table.sql")}
{:name "0117-mod-file-object-thumbnail-table"
:fn (mg/resource "app/migrations/sql/0117-mod-file-object-thumbnail-table.sql")}])
(defn apply-migrations! (defn apply-migrations!
[pool name migrations] [pool name migrations]

8
backend/src/app/migrations/sql/0107-add-deletion-protection-trigger-function.sql Normal file
View file

@ -0,0 +1,8 @@
CREATE OR REPLACE FUNCTION raise_deletion_protection()
RETURNS TRIGGER AS $$
BEGIN
RAISE EXCEPTION 'unable to proceed to delete row on "%"', TG_TABLE_NAME
USING HINT = 'disable deletion protection with "SET rules.deletion_protection TO off"';
RETURN NULL;
END;
$$ LANGUAGE plpgsql;

25
backend/src/app/migrations/sql/0108-mod-file-thumbnail-table.sql Normal file
View file

@ -0,0 +1,25 @@
--- Add missing index for deleted_at column, we include all related
--- columns because we expect the index to be small and expect use
--- index-only scans.
CREATE INDEX IF NOT EXISTS file_thumbnail__deleted_at__idx
ON file_thumbnail (deleted_at, file_id, revn, media_id)
WHERE deleted_at IS NOT NULL;
--- Add missing for media_id column, used mainly for refs checking
CREATE INDEX IF NOT EXISTS file_thumbnail__media_id__idx ON file_thumbnail (media_id);
--- Remove CASCADE from media_id and file_id foreign constraint
ALTER TABLE file_thumbnail
DROP CONSTRAINT file_thumbnail_file_id_fkey,
ADD FOREIGN KEY (file_id) REFERENCES file(id) DEFERRABLE;
ALTER TABLE file_thumbnail
DROP CONSTRAINT file_thumbnail_media_id_fkey,
ADD FOREIGN KEY (media_id) REFERENCES storage_object(id) DEFERRABLE;
--- Add deletion protection
CREATE OR REPLACE TRIGGER deletion_protection__tgr
BEFORE DELETE ON file_thumbnail FOR EACH STATEMENT
WHEN ((current_setting('rules.deletion_protection', true) IN ('on', '')) OR
(current_setting('rules.deletion_protection', true) IS NULL))
EXECUTE PROCEDURE raise_deletion_protection();

26
backend/src/app/migrations/sql/0109-mod-file-tagged-object-thumbnail-table.sql Normal file
View file

@ -0,0 +1,26 @@
ALTER TABLE file_tagged_object_thumbnail
ADD COLUMN updated_at timestamptz NULL,
ADD COLUMN deleted_at timestamptz NULL;
--- Add index for deleted_at column, we include all related columns
--- because we expect the index to be small and expect use index-only
--- scans.
CREATE INDEX IF NOT EXISTS file_tagged_object_thumbnail__deleted_at__idx
ON file_tagged_object_thumbnail (deleted_at, file_id, object_id, media_id)
WHERE deleted_at IS NOT NULL;
--- Remove CASCADE from media_id and file_id foreign constraint
ALTER TABLE file_tagged_object_thumbnail
DROP CONSTRAINT file_tagged_object_thumbnail_media_id_fkey,
ADD FOREIGN KEY (media_id) REFERENCES storage_object(id) DEFERRABLE;
ALTER TABLE file_tagged_object_thumbnail
DROP CONSTRAINT file_tagged_object_thumbnail_file_id_fkey,
ADD FOREIGN KEY (file_id) REFERENCES file(id) DEFERRABLE;
--- Add deletion protection
CREATE OR REPLACE TRIGGER deletion_protection__tgr
BEFORE DELETE ON file_tagged_object_thumbnail FOR EACH STATEMENT
WHEN ((current_setting('rules.deletion_protection', true) IN ('on', '')) OR
(current_setting('rules.deletion_protection', true) IS NULL))
EXECUTE PROCEDURE raise_deletion_protection();

27
backend/src/app/migrations/sql/0110-mod-file-media-object-table.sql Normal file
View file

@ -0,0 +1,27 @@
--- Fix legacy naming
ALTER INDEX media_object_pkey RENAME TO file_media_object_pkey;
ALTER INDEX media_object__file_id__idx RENAME TO file_media_object__file_id__idx;
--- Create index for the deleted_at column
CREATE INDEX IF NOT EXISTS file_media_object__deleted_at__idx
ON file_media_object (deleted_at, id, media_id)
WHERE deleted_at IS NOT NULL;
--- Drop now unnecesary trigger because this will be handled by the
--- application code
DROP TRIGGER file_media_object__on_delete__tgr ON file_media_object;
DROP FUNCTION on_delete_file_media_object ( ) CASCADE;
DROP TRIGGER file_media_object__on_insert__tgr ON file_media_object;
DROP FUNCTION on_media_object_insert () CASCADE;
--- Remove CASCADE from file FOREIGN KEY
ALTER TABLE file_media_object
DROP CONSTRAINT file_media_object_file_id_fkey,
ADD FOREIGN KEY (file_id) REFERENCES file(id) DEFERRABLE;
--- Add deletion protection
CREATE OR REPLACE TRIGGER deletion_protection__tgr
BEFORE DELETE ON file_media_object FOR EACH STATEMENT
WHEN ((current_setting('rules.deletion_protection', true) IN ('on', '')) OR
(current_setting('rules.deletion_protection', true) IS NULL))
EXECUTE PROCEDURE raise_deletion_protection();

9
backend/src/app/migrations/sql/0111-mod-file-data-fragment-table.sql Normal file
View file

@ -0,0 +1,9 @@
ALTER TABLE file_data_fragment
ADD COLUMN deleted_at timestamptz NULL;
--- Add index for deleted_at column, we include all related columns
--- because we expect the index to be small and expect use index-only
--- scans.
CREATE INDEX IF NOT EXISTS file_data_fragment__deleted_at__idx
ON file_data_fragment (deleted_at, file_id, id)
WHERE deleted_at IS NOT NULL;

15
backend/src/app/migrations/sql/0112-mod-profile-table.sql Normal file
View file

@ -0,0 +1,15 @@
ALTER TABLE profile
DROP CONSTRAINT profile_photo_id_fkey,
ADD FOREIGN KEY (photo_id) REFERENCES storage_object(id) DEFERRABLE,
DROP CONSTRAINT profile_default_project_id_fkey,
ADD FOREIGN KEY (default_project_id) REFERENCES project(id) DEFERRABLE,
DROP CONSTRAINT profile_default_team_id_fkey,
ADD FOREIGN KEY (default_team_id) REFERENCES team(id) DEFERRABLE;
--- Add deletion protection
CREATE OR REPLACE TRIGGER deletion_protection__tgr
BEFORE DELETE ON profile FOR EACH STATEMENT
WHEN ((current_setting('rules.deletion_protection', true) IN ('on', '')) OR
(current_setting('rules.deletion_protection', true) IS NULL))
EXECUTE PROCEDURE raise_deletion_protection();

20
backend/src/app/migrations/sql/0113-mod-team-font-variant-table.sql Normal file
View file

@ -0,0 +1,20 @@
--- Remove ON DELETE SET NULL from foreign constraint on
--- storage_object table
ALTER TABLE team_font_variant
DROP CONSTRAINT team_font_variant_otf_file_id_fkey,
ADD FOREIGN KEY (otf_file_id) REFERENCES storage_object(id) DEFERRABLE,
DROP CONSTRAINT team_font_variant_ttf_file_id_fkey,
ADD FOREIGN KEY (ttf_file_id) REFERENCES storage_object(id) DEFERRABLE,
DROP CONSTRAINT team_font_variant_woff1_file_id_fkey,
ADD FOREIGN KEY (woff1_file_id) REFERENCES storage_object(id) DEFERRABLE,
DROP CONSTRAINT team_font_variant_woff2_file_id_fkey,
ADD FOREIGN KEY (woff2_file_id) REFERENCES storage_object(id) DEFERRABLE,
DROP CONSTRAINT team_font_variant_team_id_fkey,
ADD FOREIGN KEY (team_id) REFERENCES team(id) DEFERRABLE;
--- Add deletion protection
CREATE OR REPLACE TRIGGER deletion_protection__tgr
BEFORE DELETE ON team_font_variant FOR EACH STATEMENT
WHEN ((current_setting('rules.deletion_protection', true) IN ('on', '')) OR
(current_setting('rules.deletion_protection', true) IS NULL))
EXECUTE PROCEDURE raise_deletion_protection();

10
backend/src/app/migrations/sql/0114-mod-team-table.sql Normal file
View file

@ -0,0 +1,10 @@
--- Add deletion protection
CREATE OR REPLACE TRIGGER deletion_protection__tgr
BEFORE DELETE ON team FOR EACH STATEMENT
WHEN ((current_setting('rules.deletion_protection', true) IN ('on', '')) OR
(current_setting('rules.deletion_protection', true) IS NULL))
EXECUTE PROCEDURE raise_deletion_protection();
ALTER TABLE team
DROP CONSTRAINT team_photo_id_fkey,
ADD FOREIGN KEY (photo_id) REFERENCES storage_object(id) DEFERRABLE;

3
backend/src/app/migrations/sql/0115-mod-project-table.sql Normal file
View file

@ -0,0 +1,3 @@
ALTER TABLE project
DROP CONSTRAINT project_team_id_fkey,
ADD FOREIGN KEY (team_id) REFERENCES team(id) DEFERRABLE;

3
backend/src/app/migrations/sql/0116-mod-file-table.sql Normal file
View file

@ -0,0 +1,3 @@
ALTER TABLE file
DROP CONSTRAINT file_project_id_fkey,
ADD FOREIGN KEY (project_id) REFERENCES project(id) DEFERRABLE;

12
backend/src/app/migrations/sql/0117-mod-file-object-thumbnail-table.sql Normal file
View file

@ -0,0 +1,12 @@
ALTER TABLE file_object_thumbnail
DROP CONSTRAINT file_object_thumbnail_file_id_fkey,
ADD FOREIGN KEY (file_id) REFERENCES file(id) DEFERRABLE,
DROP CONSTRAINT file_object_thumbnail_media_id_fkey,
ADD FOREIGN KEY (media_id) REFERENCES storage_object(id) DEFERRABLE;
--- Mark all related storage_object row as touched
-- UPDATE storage_object SET touched_at = now()
-- WHERE id IN (SELECT DISTINCT media_id
-- FROM file_object_thumbnail
-- WHERE media_id IS NOT NULL)
-- AND touched_at IS NULL;

4
backend/src/app/rpc/commands/auth.clj
View file

@ -54,7 +54,9 @@
:hint "the current account does not have password") :hint "the current account does not have password")
(let [result (profile/verify-password cfg password (:password profile))] (let [result (profile/verify-password cfg password (:password profile))]
(when (:update result) (when (:update result)
(l/trace :hint "updating profile password" :id (:id profile) :email (:email profile)) (l/trc :hint "updating profile password"
:id (str (:id profile))
:email (:email profile))
(profile/update-profile-password! conn (assoc profile :password password))) (profile/update-profile-password! conn (assoc profile :password password)))
(:valid result)))) (:valid result))))

26
backend/src/app/rpc/commands/comments.clj
View file

@ -309,23 +309,21 @@
::quotes/project-id project-id ::quotes/project-id project-id
::quotes/file-id file-id})) ::quotes/file-id file-id}))
(rtry/with-retry {::rtry/when rtry/conflict-exception?
::rtry/max-retries 3
::rtry/label "create-comment-thread"
::db/conn conn}
(create-comment-thread conn
{:created-at request-at
:profile-id profile-id
:file-id file-id
:page-id page-id
:page-name page-name
:position position
:content content
:frame-id frame-id}))))))
(-> cfg
(assoc ::rtry/when rtry/conflict-exception?)
(assoc ::rtry/label "create-comment-thread")
(rtry/invoke create-comment-thread {:created-at request-at
:profile-id profile-id
:file-id file-id
:page-id page-id
:page-name page-name
:position position
:content content
:frame-id frame-id}))))))
(defn- create-comment-thread (defn- create-comment-thread
[conn {:keys [profile-id file-id page-id page-name created-at position content frame-id]}] [{:keys [::db/conn]} {:keys [profile-id file-id page-id page-name created-at position content frame-id]}]
(let [;; NOTE: we take the next seq number from a separate query because the whole (let [;; NOTE: we take the next seq number from a separate query because the whole
;; operation can be retried on conflict, and in this case the new seq shold be ;; operation can be retried on conflict, and in this case the new seq shold be
;; retrieved from the database. ;; retrieved from the database.

2
backend/src/app/rpc/commands/files.clj
View file

@ -516,7 +516,7 @@
ft.media_id ft.media_id
from file as f from file as f
inner join project as p on (p.id = f.project_id) inner join project as p on (p.id = f.project_id)
left join file_thumbnail as ft on (ft.file_id = f.id and ft.revn = f.revn) left join file_thumbnail as ft on (ft.file_id = f.id and ft.revn = f.revn and ft.deleted_at is null)
where f.is_shared = true where f.is_shared = true
and f.deleted_at is null and f.deleted_at is null
and p.deleted_at is null and p.deleted_at is null

179
backend/src/app/rpc/commands/files_thumbnails.clj
View file

@ -27,6 +27,7 @@
[app.rpc.commands.teams :as teams] [app.rpc.commands.teams :as teams]
[app.rpc.cond :as-alias cond] [app.rpc.cond :as-alias cond]
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.retry :as rtry]
[app.storage :as sto] [app.storage :as sto]
[app.util.pointer-map :as pmap] [app.util.pointer-map :as pmap]
[app.util.services :as sv] [app.util.services :as sv]
@ -46,7 +47,7 @@
(let [sql (str/concat (let [sql (str/concat
"select object_id, media_id, tag " "select object_id, media_id, tag "
" from file_tagged_object_thumbnail" " from file_tagged_object_thumbnail"
" where file_id=? and tag=?") " where file_id=? and tag=? and deleted_at is null")
res (db/exec! conn [sql file-id tag])] res (db/exec! conn [sql file-id tag])]
(->> res (->> res
(d/index-by :object-id (fn [row] (d/index-by :object-id (fn [row]
@ -58,7 +59,7 @@
(let [sql (str/concat (let [sql (str/concat
"select object_id, media_id, tag " "select object_id, media_id, tag "
" from file_tagged_object_thumbnail" " from file_tagged_object_thumbnail"
" where file_id=?") " where file_id=? and deleted_at is null")
res (db/exec! conn [sql file-id])] res (db/exec! conn [sql file-id])]
(->> res (->> res
(d/index-by :object-id (fn [row] (d/index-by :object-id (fn [row]
@ -69,7 +70,7 @@
(let [sql (str/concat (let [sql (str/concat
"select object_id, media_id, tag " "select object_id, media_id, tag "
" from file_tagged_object_thumbnail" " from file_tagged_object_thumbnail"
" where file_id=? and object_id = ANY(?)") " where file_id=? and object_id = ANY(?) and deleted_at is null")
ids (db/create-array conn "text" (seq object-ids)) ids (db/create-array conn "text" (seq object-ids))
res (db/exec! conn [sql file-id ids])] res (db/exec! conn [sql file-id ids])]
@ -226,34 +227,54 @@
;; MUTATION COMMANDS ;; MUTATION COMMANDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- MUTATION COMMAND: create-file-object-thumbnail ;; MUTATION COMMAND: create-file-object-thumbnail
(def ^:private sql:create-object-thumbnail
"insert into file_tagged_object_thumbnail(file_id, object_id, media_id, tag)
values (?, ?, ?, ?)
on conflict(file_id, tag, object_id) do
update set media_id = ?
returning *;")
(defn- create-file-object-thumbnail! (defn- create-file-object-thumbnail!
[{:keys [::db/conn ::sto/storage]} file-id object-id media tag] [{:keys [::db/conn ::sto/storage]} file-id object-id media tag]
(let [path (:path media) (let [thumb (db/get* conn :file-tagged-object-thumbnail
{:file-id file-id
:object-id object-id
:tag tag}
{::db/remove-deleted? false
::db/for-update? true})
path (:path media)
mtype (:mtype media) mtype (:mtype media)
hash (sto/calculate-hash path) hash (sto/calculate-hash path)
data (-> (sto/content path) data (-> (sto/content path)
(sto/wrap-with-hash hash)) (sto/wrap-with-hash hash))
tnow (dt/now)
media (sto/put-object! storage media (sto/put-object! storage
{::sto/content data {::sto/content data
::sto/deduplicate? true ::sto/deduplicate? true
::sto/touched-at (dt/now) ::sto/touched-at tnow
:content-type mtype :content-type mtype
:bucket "file-object-thumbnail"})] :bucket "file-object-thumbnail"})]
(db/exec-one! conn [sql:create-object-thumbnail file-id object-id (if (some? thumb)
(:id media) tag (:id media)]))) (do
;; We mark the old media id as touched if it does not matches
(when (not= (:id media) (:media-id thumb))
(sto/touch-object! storage (:media-id thumb)))
(db/update! conn :file-tagged-object-thumbnail
{:media-id (:id media)
:deleted-at nil
:updated-at tnow}
{:file-id file-id
:object-id object-id
:tag tag}))
(db/insert! conn :file-tagged-object-thumbnail
{:file-id file-id
:object-id object-id
:created-at tnow
:updated-at tnow
:tag tag
:media-id (:id media)}))))
(def schema:create-file-object-thumbnail (def ^:private
schema:create-file-object-thumbnail
[:map {:title "create-file-object-thumbnail"} [:map {:title "create-file-object-thumbnail"}
[:file-id ::sm/uuid] [:file-id ::sm/uuid]
[:object-id :string] [:object-id :string]
@ -268,32 +289,37 @@
::audit/skip true ::audit/skip true
::sm/params schema:create-file-object-thumbnail} ::sm/params schema:create-file-object-thumbnail}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id object-id media tag]}] [cfg {:keys [::rpc/profile-id file-id object-id media tag]}]
(db/with-atomic [conn pool] (db/tx-run! cfg
(files/check-edition-permissions! conn profile-id file-id) (fn [{:keys [::db/conn] :as cfg}]
(media/validate-media-type! media) (files/check-edition-permissions! conn profile-id file-id)
(media/validate-media-size! media) (media/validate-media-type! media)
(media/validate-media-size! media)
(when-not (db/read-only? conn) (when-not (db/read-only? conn)
(-> cfg (let [cfg (-> cfg
(update ::sto/storage media/configure-assets-storage) (update ::sto/storage media/configure-assets-storage)
(assoc ::db/conn conn) (assoc ::rtry/when rtry/conflict-exception?)
(create-file-object-thumbnail! file-id object-id media (or tag "frame")))))) (assoc ::rtry/max-retries 5)
(assoc ::rtry/label "create-file-object-thumbnail"))]
(rtry/invoke cfg create-file-object-thumbnail!
file-id object-id media (or tag "frame")))))))
;; --- MUTATION COMMAND: delete-file-object-thumbnail ;; --- MUTATION COMMAND: delete-file-object-thumbnail
(defn- delete-file-object-thumbnail! (defn- delete-file-object-thumbnail!
[{:keys [::db/conn ::sto/storage]} file-id object-id] [{:keys [::db/conn ::sto/storage]} file-id object-id]
(when-let [{:keys [media-id]} (db/get* conn :file-tagged-object-thumbnail (when-let [{:keys [media-id tag]} (db/get* conn :file-tagged-object-thumbnail
{:file-id file-id {:file-id file-id
:object-id object-id} :object-id object-id}
{::db/for-update? true})] {::db/for-update? true})]
(sto/touch-object! storage media-id) (sto/touch-object! storage media-id)
(db/delete! conn :file-tagged-object-thumbnail (db/update! conn :file-tagged-object-thumbnail
{:deleted-at (dt/now)}
{:file-id file-id {:file-id file-id
:object-id object-id}) :object-id object-id
nil)) :tag tag}
{::db/return-keys? false})))
(s/def ::delete-file-object-thumbnail (s/def ::delete-file-object-thumbnail
(s/keys :req [::rpc/profile-id] (s/keys :req [::rpc/profile-id]
@ -302,29 +328,21 @@
(sv/defmethod ::delete-file-object-thumbnail (sv/defmethod ::delete-file-object-thumbnail
{::doc/added "1.19" {::doc/added "1.19"
::doc/module :files ::doc/module :files
::doc/deprecated "1.20"
::climit/id :file-thumbnail-ops ::climit/id :file-thumbnail-ops
::climit/key-fn ::rpc/profile-id ::climit/key-fn ::rpc/profile-id
::audit/skip true} ::audit/skip true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id object-id]}] [cfg {:keys [::rpc/profile-id file-id object-id]}]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(db/with-atomic [conn pool] (files/check-edition-permissions! conn profile-id file-id)
(files/check-edition-permissions! conn profile-id file-id) (when-not (db/read-only? conn)
(-> cfg
(when-not (db/read-only? conn) (update ::sto/storage media/configure-assets-storage conn)
(-> cfg (delete-file-object-thumbnail! file-id object-id))
(update ::sto/storage media/configure-assets-storage) nil))))
(assoc ::db/conn conn)
(delete-file-object-thumbnail! file-id object-id))
nil)))
;; --- MUTATION COMMAND: create-file-thumbnail ;; --- MUTATION COMMAND: create-file-thumbnail
(def ^:private sql:create-file-thumbnail
"insert into file_thumbnail (file_id, revn, media_id, props)
values (?, ?, ?, ?::jsonb)
on conflict(file_id, revn) do
update set media_id=?, props=?, updated_at=now();")
(defn- create-file-thumbnail! (defn- create-file-thumbnail!
[{:keys [::db/conn ::sto/storage]} {:keys [file-id revn props media] :as params}] [{:keys [::db/conn ::sto/storage]} {:keys [file-id revn props media] :as params}]
(media/validate-media-type! media) (media/validate-media-type! media)
@ -336,14 +354,42 @@
hash (sto/calculate-hash path) hash (sto/calculate-hash path)
data (-> (sto/content path) data (-> (sto/content path)
(sto/wrap-with-hash hash)) (sto/wrap-with-hash hash))
tnow (dt/now)
media (sto/put-object! storage media (sto/put-object! storage
{::sto/content data {::sto/content data
::sto/deduplicate? false ::sto/deduplicate? true
::sto/touched-at tnow
:content-type mtype :content-type mtype
:bucket "file-thumbnail"})] :bucket "file-thumbnail"})
(db/exec-one! conn [sql:create-file-thumbnail file-id revn
(:id media) props thumb (db/get* conn :file-thumbnail
(:id media) props]) {:file-id file-id
:revn revn}
{::db/remove-deleted? false
::db/for-update? true})]
(if (some? thumb)
(do
;; We mark the old media id as touched if it does not match
(when (not= (:id media) (:media-id thumb))
(sto/touch-object! storage (:media-id thumb)))
(db/update! conn :file-thumbnail
{:media-id (:id media)
:deleted-at nil
:updated-at tnow
:props props}
{:file-id file-id
:revn revn}))
(db/insert! conn :file-thumbnail
{:file-id file-id
:revn revn
:created-at tnow
:updated-at tnow
:props props
:media-id (:id media)}))
media)) media))
(sv/defmethod ::create-file-thumbnail (sv/defmethod ::create-file-thumbnail
@ -359,13 +405,14 @@
[:revn :int] [:revn :int]
[:media ::media/upload]]} [:media ::media/upload]]}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}] [cfg {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool] (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(files/check-edition-permissions! conn profile-id file-id) (files/check-edition-permissions! conn profile-id file-id)
(when-not (db/read-only? conn) (when-not (db/read-only? conn)
(let [media (-> cfg (let [cfg (-> cfg
(update ::sto/storage media/configure-assets-storage) (update ::sto/storage media/configure-assets-storage)
(assoc ::db/conn conn) (assoc ::rtry/when rtry/conflict-exception?)
(create-file-thumbnail! params))] (assoc ::rtry/max-retries 5)
(assoc ::rtry/label "create-thumbnail"))
{:uri (files/resolve-public-uri (:id media))})))) media (rtry/invoke cfg create-file-thumbnail! params)]
{:uri (files/resolve-public-uri (:id media))})))))

214
backend/src/app/rpc/commands/fonts.clj
View file

@ -8,7 +8,7 @@
(:require (:require
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.schema :as sm]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
@ -25,39 +25,27 @@
[app.storage :as sto] [app.storage :as sto]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk] [app.worker :as-alias wrk]))
[clojure.spec.alpha :as s]))
(def valid-weight #{100 200 300 400 500 600 700 800 900 950}) (def valid-weight #{100 200 300 400 500 600 700 800 900 950})
(def valid-style #{"normal" "italic"}) (def valid-style #{"normal" "italic"})
(s/def ::data (s/map-of ::us/string any?))
(s/def ::file-id ::us/uuid)
(s/def ::font-id ::us/uuid)
(s/def ::id ::us/uuid)
(s/def ::name ::us/not-empty-string)
(s/def ::project-id ::us/uuid)
(s/def ::share-id ::us/uuid)
(s/def ::style valid-style)
(s/def ::team-id ::us/uuid)
(s/def ::weight valid-weight)
;; --- QUERY: Get font variants ;; --- QUERY: Get font variants
(s/def ::get-font-variants (def ^:private
(s/and schema:get-font-variants
(s/keys :req [::rpc/profile-id] [:schema {:title "get-font-variants"}
:opt-un [::team-id [:and
::file-id [:map
::project-id [:team-id {:optional true} ::sm/uuid]
::share-id]) [:file-id {:optional true} ::sm/uuid]
(fn [o] [:project-id {:optional true} ::sm/uuid]
(or (contains? o :team-id) [:share-id {:optional true} ::sm/uuid]]
(contains? o :file-id) [::sm/contains-any #{:team-id :file-id :project-id}]]])
(contains? o :project-id)))))
(sv/defmethod ::get-font-variants (sv/defmethod ::get-font-variants
{::doc/added "1.18"} {::doc/added "1.18"
::sm/params schema:get-font-variants}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id project-id share-id] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id project-id share-id] :as params}]
(dm/with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(cond (cond
@ -87,28 +75,31 @@
(declare create-font-variant) (declare create-font-variant)
(s/def ::create-font-variant (def ^:private schema:create-font-variant
(s/keys :req [::rpc/profile-id] [:map {:title "create-font-variant"}
:req-un [::team-id [:team-id ::sm/uuid]
::data [:data [:map-of :string :any]]
::font-id [:font-id ::sm/uuid]
::font-family [:font-family :string]
::font-weight [:font-weight [::sm/one-of {:format "number"} valid-weight]]
::font-style])) [:font-style [::sm/one-of {:format "string"} valid-style]]])
(sv/defmethod ::create-font-variant (sv/defmethod ::create-font-variant
{::doc/added "1.18" {::doc/added "1.18"
::webhooks/event? true} ::webhooks/event? true
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}] ::sm/params schema:create-font-variant}
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)] [cfg {:keys [::rpc/profile-id team-id] :as params}]
(teams/check-edition-permissions! pool profile-id team-id) (db/tx-run! cfg
(quotes/check-quote! pool {::quotes/id ::quotes/font-variants-per-team (fn [{:keys [::db/conn] :as cfg}]
::quotes/profile-id profile-id (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
::quotes/team-id team-id}) (teams/check-edition-permissions! conn profile-id team-id)
(create-font-variant cfg (assoc params :profile-id profile-id)))) (quotes/check-quote! conn {::quotes/id ::quotes/font-variants-per-team
::quotes/profile-id profile-id
::quotes/team-id team-id})
(create-font-variant cfg (assoc params :profile-id profile-id))))))
(defn create-font-variant (defn create-font-variant
[{:keys [::sto/storage ::db/pool] :as cfg} {:keys [data] :as params}] [{:keys [::sto/storage ::db/conn] :as cfg} {:keys [data] :as params}]
(letfn [(generate-missing! [data] (letfn [(generate-missing! [data]
(let [data (media/run {:cmd :generate-fonts :input data})] (let [data (media/run {:cmd :generate-fonts :input data})]
(when (and (not (contains? data "font/otf")) (when (and (not (contains? data "font/otf"))
@ -136,6 +127,7 @@
ttf-params (prepare-font data "font/ttf") ttf-params (prepare-font data "font/ttf")
wf1-params (prepare-font data "font/woff") wf1-params (prepare-font data "font/woff")
wf2-params (prepare-font data "font/woff2")] wf2-params (prepare-font data "font/woff2")]
(cond-> {} (cond-> {}
(some? otf-params) (some? otf-params)
(assoc :otf (sto/put-object! storage otf-params)) (assoc :otf (sto/put-object! storage otf-params))
@ -147,7 +139,7 @@
(assoc :woff2 (sto/put-object! storage wf2-params))))) (assoc :woff2 (sto/put-object! storage wf2-params)))))
(insert-font-variant! [{:keys [woff1 woff2 otf ttf]}] (insert-font-variant! [{:keys [woff1 woff2 otf ttf]}]
(db/insert! pool :team-font-variant (db/insert! conn :team-font-variant
{:id (uuid/next) {:id (uuid/next)
:team-id (:team-id params) :team-id (:team-id params)
:font-id (:font-id params) :font-id (:font-id params)
@ -168,63 +160,109 @@
;; --- UPDATE FONT FAMILY ;; --- UPDATE FONT FAMILY
(s/def ::update-font (def ^:private
(s/keys :req [::rpc/profile-id] schema:update-font
:req-un [::team-id ::id ::name])) [:map {:title "update-font"}
[:team-id ::sm/uuid]
[:id ::sm/uuid]
[:name :string]])
(sv/defmethod ::update-font (sv/defmethod ::update-font
{::doc/added "1.18" {::doc/added "1.18"
::webhooks/event? true} ::webhooks/event? true
[{:keys [::db/pool]} {:keys [::rpc/profile-id team-id id name]}] ::sm/params schema:update-font}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id team-id id name]}]
(teams/check-edition-permissions! conn profile-id team-id) (db/tx-run! cfg
(rph/with-meta (fn [{:keys [::db/conn]}]
(db/update! conn :team-font-variant (teams/check-edition-permissions! conn profile-id team-id)
{:font-family name}
{:font-id id (db/update! conn :team-font-variant
:team-id team-id}) {:font-family name}
{::audit/replace-props {:id id {:font-id id
:name name :team-id team-id}
:team-id team-id {::db/return-keys? false})
:profile-id profile-id}})))
(rph/with-meta (rph/wrap nil)
{::audit/replace-props {:id id
:name name
:team-id team-id
:profile-id profile-id}}))))
;; --- DELETE FONT ;; --- DELETE FONT
(s/def ::delete-font (def ^:private
(s/keys :req [::rpc/profile-id] schema:delete-font
:req-un [::team-id ::id])) [:map {:title "delete-font"}
[:team-id ::sm/uuid]
[:id ::sm/uuid]])
(sv/defmethod ::delete-font (sv/defmethod ::delete-font
{::doc/added "1.18" {::doc/added "1.18"
::webhooks/event? true} ::webhooks/event? true
[{:keys [::db/pool]} {:keys [::rpc/profile-id id team-id]}] ::sm/params schema:delete-font}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id id team-id]}]
(teams/check-edition-permissions! conn profile-id team-id)
(let [font (db/update! conn :team-font-variant (db/tx-run! cfg
{:deleted-at (dt/now)} (fn [{:keys [::db/conn ::sto/storage] :as cfg}]
{:font-id id :team-id team-id})] (teams/check-edition-permissions! conn profile-id team-id)
(rph/with-meta (rph/wrap) (let [fonts (db/query conn :team-font-variant
{::audit/props {:id id {:team-id team-id
:team-id team-id :font-id id
:name (:font-family font) :deleted-at nil}
:profile-id profile-id}})))) {::db/for-update? true})
storage (media/configure-assets-storage storage conn)
tnow (dt/now)]
(when-not (seq fonts)
(ex/raise :type :not-found
:code :object-not-found))
(doseq [font fonts]
(db/update! conn :team-font-variant
{:deleted-at tnow}
{:id (:id font)}
{::db/return-keys? false})
(some->> (:woff1-file-id font) (sto/touch-object! storage))
(some->> (:woff2-file-id font) (sto/touch-object! storage))
(some->> (:ttf-file-id font) (sto/touch-object! storage))
(some->> (:otf-file-id font) (sto/touch-object! storage)))
(rph/with-meta (rph/wrap)
{::audit/props {:id id
:team-id team-id
:name (:font-family (peek fonts))
:profile-id profile-id}})))))
;; --- DELETE FONT VARIANT ;; --- DELETE FONT VARIANT
(s/def ::delete-font-variant (def ^:private schema:delete-font-variant
(s/keys :req [::rpc/profile-id] [:map {:title "delete-font-variant"}
:req-un [::team-id ::id])) [:team-id ::sm/uuid]
[:id ::sm/uuid]])
(sv/defmethod ::delete-font-variant (sv/defmethod ::delete-font-variant
{::doc/added "1.18" {::doc/added "1.18"
::webhooks/event? true} ::webhooks/event? true
[{:keys [::db/pool]} {:keys [::rpc/profile-id id team-id]}] ::sm/params schema:delete-font-variant}
(db/with-atomic [conn pool] [cfg {:keys [::rpc/profile-id id team-id]}]
(teams/check-edition-permissions! conn profile-id team-id) (db/tx-run! cfg
(let [variant (db/update! conn :team-font-variant (fn [{:keys [::db/conn ::sto/storage] :as cfg}]
{:deleted-at (dt/now)} (teams/check-edition-permissions! conn profile-id team-id)
{:id id :team-id team-id})] (let [variant (db/get conn :team-font-variant
(rph/with-meta (rph/wrap) {:id id :team-id team-id}
{::audit/props {:font-family (:font-family variant) {::db/for-update? true})
:font-id (:font-id variant)}})))) storage (media/configure-assets-storage storage conn)]
(db/update! conn :team-font-variant
{:deleted-at (dt/now)}
{:id (:id variant)}
{::db/return-keys? false})
(some->> (:woff1-file-id variant) (sto/touch-object! storage))
(some->> (:woff2-file-id variant) (sto/touch-object! storage))
(some->> (:ttf-file-id variant) (sto/touch-object! storage))
(some->> (:otf-file-id variant) (sto/touch-object! storage))
(rph/with-meta (rph/wrap)
{::audit/props {:font-family (:font-family variant)
:font-id (:font-id variant)}})))))

7
backend/src/app/rpc/commands/media.clj
View file

@ -23,6 +23,7 @@
[app.storage :as sto] [app.storage :as sto]
[app.storage.tmp :as tmp] [app.storage.tmp :as tmp]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt]
[app.worker :as-alias wrk] [app.worker :as-alias wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
@ -153,6 +154,12 @@
thumb (when-let [params (::thumb result)] thumb (when-let [params (::thumb result)]
(sto/put-object! storage params))] (sto/put-object! storage params))]
(db/update! conn :file
{:modified-at (dt/now)
:has-media-trimmed false}
{:id file-id}
{::db/return-keys? false})
(db/exec-one! conn [sql:create-file-media-object (db/exec-one! conn [sql:create-file-media-object
(or id (uuid/next)) (or id (uuid/next))
file-id is-local name file-id is-local name

77
backend/src/app/rpc/retry.clj
View file

@ -18,46 +18,47 @@
(and (instance? PSQLException e) (and (instance? PSQLException e)
(= "23505" (.getSQLState ^PSQLException e)))) (= "23505" (.getSQLState ^PSQLException e))))
(def ^:private always-false (constantly false)) (def ^:private always-false
(constantly false))
(defn wrap-retry (defn wrap-retry
[_ f {:keys [::matches ::sv/name] :or {matches always-false} :as mdata}] [_ f {:keys [::sv/name] :as mdata}]
(when (::enabled mdata) (if (::enabled mdata)
(l/debug :hint "wrapping retry" :name name)) (let [max-retries (get mdata ::max-retries 3)
matches? (get mdata ::when always-false)]
(if-let [max-retries (::max-retries mdata)] (l/dbg :hint "wrapping retry" :name name :max-retries max-retries)
(fn [cfg params] (fn [cfg params]
((fn run [retry] ((fn recursive-invoke [retry]
(try (try
(f cfg params) (f cfg params)
(catch Throwable cause (catch Throwable cause
(if (matches cause) (if (matches? cause)
(let [current-retry (inc retry)] (let [current-retry (inc retry)]
(l/trace :hint "running retry algorithm" :retry current-retry) (l/wrn :hint "retrying operation" :retry current-retry :service name)
(if (<= current-retry max-retries) (if (<= current-retry max-retries)
(run current-retry) (recursive-invoke current-retry)
(throw cause))) (throw cause)))
(throw cause))))) 1)) (throw cause))))) 1)))
f)) f))
(defmacro with-retry (defn invoke
[{:keys [::when ::max-retries ::label ::db/conn] :or {max-retries 3}} & body] [{:keys [::db/conn ::max-retries] :or {max-retries 3} :as cfg} f & args]
`(let [conn# ~conn] (assert (db/connection? conn) "invalid database connection")
(assert (or (nil? conn#) (db/connection? conn#)) "invalid database connection") (loop [rnum 1]
(loop [tnum# 1] (let [match? (get cfg ::when always-false)
(let [result# (let [sp# (some-> conn# db/savepoint)] result (let [spoint (db/savepoint conn)]
(try (try
(let [result# (do ~@body)] (let [result (apply f cfg args)]
(some->> sp# (db/release! conn#)) (db/release! conn spoint)
result#) result)
(catch Throwable cause# (catch Throwable cause
(some->> sp# (db/rollback! conn#)) (db/rollback! conn spoint)
(if (and (~when cause#) (<= tnum# ~max-retries)) (if (and (match? cause) (<= rnum max-retries))
::retry ::retry
(throw cause#)))))] (throw cause)))))]
(if (= ::retry result#) (if (= ::retry result)
(do (let [label (get cfg ::label "anonymous")]
(l/warn :hint "retrying operation" :label ~label :retry tnum#) (l/warn :hint "retrying operation" :label label :retry rnum)
(recur (inc tnum#))) (recur (inc rnum)))
result#))))) result))))

224
backend/src/app/storage.clj
View file

@ -9,8 +9,6 @@
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.db :as db] [app.db :as db]
@ -228,225 +226,3 @@
(dm/export impl/resolve-backend) (dm/export impl/resolve-backend)
(dm/export impl/calculate-hash) (dm/export impl/calculate-hash)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Garbage Collection: Permanently delete objects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; A task responsible to permanently delete already marked as deleted
;; storage files. The storage objects are practically never marked to
;; be deleted directly by the api call. The touched-gc is responsible
;; of collecting the usage of the object and mark it as deleted. Only
;; the TMP files are are created with expiration date in future.
(declare sql:retrieve-deleted-objects-chunk)
(defmethod ig/pre-init-spec ::gc-deleted-task [_]
(s/keys :req [::storage ::db/pool]))
(defmethod ig/prep-key ::gc-deleted-task
[_ cfg]
(assoc cfg ::min-age (dt/duration {:hours 2})))
(defmethod ig/init-key ::gc-deleted-task
[_ {:keys [::db/pool ::storage ::min-age]}]
(letfn [(get-to-delete-chunk [cursor]
(let [sql (str "select s.* "
" from storage_object as s "
" where s.deleted_at is not null "
" and s.deleted_at < ? "
" order by s.deleted_at desc "
" limit 25")
rows (db/exec! pool [sql cursor])]
[(some-> rows peek :deleted-at)
(some->> (seq rows) (d/group-by #(-> % :backend keyword) :id #{}) seq)]))
(get-to-delete-chunks [min-age]
(d/iteration get-to-delete-chunk
:initk (dt/minus (dt/now) min-age)
:vf second
:kf first))
(delete-in-bulk! [backend-id ids]
(try
(db/with-atomic [conn pool]
(let [sql "delete from storage_object where id = ANY(?)"
ids' (db/create-array conn "uuid" ids)
total (-> (db/exec-one! conn [sql ids'])
(db/get-update-count))]
(-> (impl/resolve-backend storage backend-id)
(impl/del-objects-in-bulk ids))
(doseq [id ids]
(l/dbg :hint "gc-deleted: permanently delete storage object" :backend backend-id :id id))
total))
(catch Throwable cause
(l/err :hint "gc-deleted: unexpected error on bulk deletion"
:ids (vec ids)
:cause cause)
0)))]
(fn [params]
(let [min-age (or (some-> params :min-age dt/duration) min-age)]
(loop [total 0
chunks (get-to-delete-chunks min-age)]
(if-let [[backend-id ids] (first chunks)]
(let [deleted (delete-in-bulk! backend-id ids)]
(recur (+ total deleted)
(rest chunks)))
(do
(l/inf :hint "gc-deleted: task finished"
:min-age (dt/format-duration min-age)
:total total)
{:deleted total})))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Garbage Collection: Analyze touched objects
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; This task is part of the garbage collection process of storage
;; objects and is responsible on analyzing the touched objects and
;; mark them for deletion if corresponds.
;;
;; For example: when file_media_object is deleted, the depending
;; storage_object are marked as touched. This means that some files
;; that depend on a concrete storage_object are no longer exists and
;; maybe this storage_object is no longer necessary and can be
;; eligible for elimination. This task periodically analyzes touched
;; objects and mark them as freeze (means that has other references
;; and the object is still valid) or deleted (no more references to
;; this object so is ready to be deleted).
(declare sql:retrieve-file-media-object-nrefs)
(declare sql:retrieve-file-object-thumbnail-nrefs)
(declare sql:retrieve-profile-nrefs)
(declare sql:retrieve-team-font-variant-nrefs)
(declare sql:retrieve-touched-objects-chunk)
(defmethod ig/pre-init-spec ::gc-touched-task [_]
(s/keys :req [::db/pool]))
(defmethod ig/init-key ::gc-touched-task
[_ {:keys [::db/pool]}]
(letfn [(get-team-font-variant-nrefs [conn id]
(-> (db/exec-one! conn [sql:retrieve-team-font-variant-nrefs id id id id]) :nrefs))
(get-file-media-object-nrefs [conn id]
(-> (db/exec-one! conn [sql:retrieve-file-media-object-nrefs id id]) :nrefs))
(get-profile-nrefs [conn id]
(-> (db/exec-one! conn [sql:retrieve-profile-nrefs id id]) :nrefs))
(get-file-object-thumbnails [conn id]
(-> (db/exec-one! conn [sql:retrieve-file-object-thumbnail-nrefs id]) :nrefs))
(mark-freeze-in-bulk [conn ids]
(db/exec-one! conn ["update storage_object set touched_at=null where id = ANY(?)"
(db/create-array conn "uuid" ids)]))
(mark-delete-in-bulk [conn ids]
(db/exec-one! conn ["update storage_object set deleted_at=now(), touched_at=null where id = ANY(?)"
(db/create-array conn "uuid" ids)]))
;; NOTE: A getter that retrieves the key witch will be used
;; for group ids; previously we have no value, then we
;; introduced the `:reference` prop, and then it is renamed
;; to `:bucket` and now is string instead. This is
;; implemented in this way for backward comaptibilty.
;; NOTE: we use the "file-media-object" as default value for
;; backward compatibility because when we deploy it we can
;; have old backend instances running in the same time as
;; the new one and we can still have storage-objects created
;; without bucket value. And we know that if it does not
;; have value, it means :file-media-object.
(get-bucket [{:keys [metadata]}]
(or (some-> metadata :bucket)
(some-> metadata :reference d/name)
"file-media-object"))
(retrieve-touched-chunk [conn cursor]
(let [rows (->> (db/exec! conn [sql:retrieve-touched-objects-chunk cursor])
(mapv #(d/update-when % :metadata db/decode-transit-pgobject)))]
(when (seq rows)
[(-> rows peek :created-at)
(d/group-by get-bucket :id #{} rows)])))
(retrieve-touched [conn]
(d/iteration (partial retrieve-touched-chunk conn)
:initk (dt/now)
:vf second
:kf first))
(process-objects! [conn get-fn ids bucket]
(loop [to-freeze #{}
to-delete #{}
ids (seq ids)]
(if-let [id (first ids)]
(let [nrefs (get-fn conn id)]
(if (pos? nrefs)
(do
(l/debug :hint "gc-touched: processing storage object"
:id id :status "freeze"
:bucket bucket :refs nrefs)
(recur (conj to-freeze id) to-delete (rest ids)))
(do
(l/debug :hint "gc-touched: processing storage object"
:id id :status "delete"
:bucket bucket :refs nrefs)
(recur to-freeze (conj to-delete id) (rest ids)))))
(do
(some->> (seq to-freeze) (mark-freeze-in-bulk conn))
(some->> (seq to-delete) (mark-delete-in-bulk conn))
[(count to-freeze) (count to-delete)]))))]
(fn [_]
(db/with-atomic [conn pool]
(loop [to-freeze 0
to-delete 0
groups (retrieve-touched conn)]
(if-let [[bucket ids] (first groups)]
(let [[f d] (case bucket
"file-media-object" (process-objects! conn get-file-media-object-nrefs ids bucket)
"team-font-variant" (process-objects! conn get-team-font-variant-nrefs ids bucket)
"file-object-thumbnail" (process-objects! conn get-file-object-thumbnails ids bucket)
"profile" (process-objects! conn get-profile-nrefs ids bucket)
(ex/raise :type :internal
:code :unexpected-unknown-reference
:hint (dm/fmt "unknown reference %" bucket)))]
(recur (+ to-freeze (long f))
(+ to-delete (long d))
(rest groups)))
(do
(l/info :hint "gc-touched: task finished" :to-freeze to-freeze :to-delete to-delete)
{:freeze to-freeze :delete to-delete})))))))
(def sql:retrieve-touched-objects-chunk
"SELECT so.*
FROM storage_object AS so
WHERE so.touched_at IS NOT NULL
AND so.created_at < ?
ORDER by so.created_at DESC
LIMIT 500;")
(def sql:retrieve-file-media-object-nrefs
"select ((select count(*) from file_media_object where media_id = ?) +
(select count(*) from file_media_object where thumbnail_id = ?)) as nrefs")
(def sql:retrieve-file-object-thumbnail-nrefs
"select (select count(*) from file_tagged_object_thumbnail where media_id = ?) as nrefs")
(def sql:retrieve-team-font-variant-nrefs
"select ((select count(*) from team_font_variant where woff1_file_id = ?) +
(select count(*) from team_font_variant where woff2_file_id = ?) +
(select count(*) from team_font_variant where otf_file_id = ?) +
(select count(*) from team_font_variant where ttf_file_id = ?)) as nrefs")
(def sql:retrieve-profile-nrefs
"select ((select count(*) from profile where photo_id = ?) +
(select count(*) from team where photo_id = ?)) as nrefs")

128
backend/src/app/storage/gc_deleted.clj Normal file
View file

@ -0,0 +1,128 @@
;; 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
(ns app.storage.gc-deleted
"A task responsible to permanently delete already marked as deleted
storage files. The storage objects are practically never marked to
be deleted directly by the api call.
The touched-gc is responsible of collecting the usage of the object
and mark it as deleted. Only the TMP files are are created with
expiration date in future."
(:require
[app.common.data :as d]
[app.common.logging :as l]
[app.db :as db]
[app.storage :as-alias sto]
[app.storage.impl :as impl]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
(def ^:private sql:lock-sobjects
"SELECT id FROM storage_object
WHERE id = ANY(?::uuid[])
FOR UPDATE
SKIP LOCKED")
(defn- lock-ids
"Perform a select before delete for proper object locking and
prevent concurrent operations and we proceed only with successfully
locked objects."
[conn ids]
(let [ids (db/create-array conn "uuid" ids)]
(->> (db/exec! conn [sql:lock-sobjects ids])
(into #{} (map :id))
(not-empty))))
(def ^:private sql:delete-sobjects
"DELETE FROM storage_object
WHERE id = ANY(?::uuid[])")
(defn- delete-sobjects!
[conn ids]
(let [ids (db/create-array conn "uuid" ids)]
(-> (db/exec-one! conn [sql:delete-sobjects ids])
(db/get-update-count))))
(defn- delete-in-bulk!
[cfg backend-id ids]
;; We run the deletion on a separate transaction. This is
;; because if some exception is raised inside procesing
;; one chunk, it does not affects the rest of the chunks.
(try
(db/tx-run! cfg
(fn [{:keys [::db/conn ::sto/storage]}]
(when-let [ids (lock-ids conn ids)]
(let [total (delete-sobjects! conn ids)]
(-> (impl/resolve-backend storage backend-id)
(impl/del-objects-in-bulk ids))
(doseq [id ids]
(l/dbg :hint "permanently delete storage object"
:id (str id)
:backend (name backend-id)))
total))))
(catch Throwable cause
(l/err :hint "unexpected error on bulk deletion"
:ids ids
:cause cause))))
(defn- group-by-backend
[items]
(d/group-by (comp keyword :backend) :id #{} items))
(def ^:private sql:get-deleted-sobjects
"SELECT s.* FROM storage_object AS s
WHERE s.deleted_at IS NOT NULL
AND s.deleted_at < now() - ?::interval
ORDER BY s.deleted_at ASC")
(defn- get-buckets
[conn min-age]
(let [age (db/interval min-age)]
(sequence
(comp (partition-all 25)
(mapcat group-by-backend))
(db/cursor conn [sql:get-deleted-sobjects age]))))
(defn- clean-deleted!
[{:keys [::db/conn ::min-age] :as cfg}]
(reduce (fn [total [backend-id ids]]
(let [deleted (delete-in-bulk! cfg backend-id ids)]
(+ total (or deleted 0))))
0
(get-buckets conn min-age)))
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req [::sto/storage ::db/pool]))
(defmethod ig/prep-key ::handler
[_ cfg]
(assoc cfg ::min-age (dt/duration {:hours 2})))
(defmethod ig/init-key ::handler
[_ {:keys [::min-age] :as cfg}]
(fn [params]
(let [min-age (dt/duration (or (:min-age params) min-age))]
(db/tx-run! cfg (fn [cfg]
(let [cfg (assoc cfg ::min-age min-age)
total (clean-deleted! cfg)]
(l/inf :hint "task finished"
:min-age (dt/format-duration min-age)
:total total)
{:deleted total}))))))

208
backend/src/app/storage/gc_touched.clj Normal file
View file

@ -0,0 +1,208 @@
;; 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
(ns app.storage.gc-touched
"This task is part of the garbage collection process of storage
objects and is responsible on analyzing the touched objects and mark
them for deletion if corresponds.
For example: when file_media_object is deleted, the depending
storage_object are marked as touched. This means that some files
that depend on a concrete storage_object are no longer exists and
maybe this storage_object is no longer necessary and can be eligible
for elimination. This task periodically analyzes touched objects and
mark them as freeze (means that has other references and the object
is still valid) or deleted (no more references to this object so is
ready to be deleted)."
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.db :as db]
[app.storage :as-alias sto]
[app.storage.impl :as impl]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
(def ^:private sql:get-team-font-variant-nrefs
"SELECT ((SELECT count(*) FROM team_font_variant WHERE woff1_file_id = ?) +
(SELECT count(*) FROM team_font_variant WHERE woff2_file_id = ?) +
(SELECT count(*) FROM team_font_variant WHERE otf_file_id = ?) +
(SELECT count(*) FROM team_font_variant WHERE ttf_file_id = ?)) AS nrefs")
(defn- get-team-font-variant-nrefs
[conn id]
(-> (db/exec-one! conn [sql:get-team-font-variant-nrefs id id id id])
(get :nrefs)))
(def ^:private
sql:get-file-media-object-nrefs
"SELECT ((SELECT count(*) FROM file_media_object WHERE media_id = ?) +
(SELECT count(*) FROM file_media_object WHERE thumbnail_id = ?)) AS nrefs")
(defn- get-file-media-object-nrefs
[conn id]
(-> (db/exec-one! conn [sql:get-file-media-object-nrefs id id])
(get :nrefs)))
(def ^:private sql:get-profile-nrefs
"SELECT ((SELECT count(*) FROM profile WHERE photo_id = ?) +
(SELECT count(*) FROM team WHERE photo_id = ?)) AS nrefs")
(defn- get-profile-nrefs
[conn id]
(-> (db/exec-one! conn [sql:get-profile-nrefs id id])
(get :nrefs)))
(def ^:private
sql:get-file-object-thumbnail-nrefs
"SELECT (SELECT count(*) FROM file_tagged_object_thumbnail WHERE media_id = ?) AS nrefs")
(defn- get-file-object-thumbnails
[conn id]
(-> (db/exec-one! conn [sql:get-file-object-thumbnail-nrefs id])
(get :nrefs)))
(def ^:private
sql:get-file-thumbnail-nrefs
"SELECT (SELECT count(*) FROM file_thumbnail WHERE media_id = ?) AS nrefs")
(defn- get-file-thumbnails
[conn id]
(-> (db/exec-one! conn [sql:get-file-thumbnail-nrefs id])
(get :nrefs)))
(def ^:private sql:mark-freeze-in-bulk
"UPDATE storage_object
SET touched_at = NULL
WHERE id = ANY(?::uuid[])")
(defn- mark-freeze-in-bulk!
[conn ids]
(let [ids (db/create-array conn "uuid" ids)]
(db/exec-one! conn [sql:mark-freeze-in-bulk ids])))
(def ^:private sql:mark-delete-in-bulk
"UPDATE storage_object
SET deleted_at = now(),
touched_at = NULL
WHERE id = ANY(?::uuid[])")
(defn- mark-delete-in-bulk!
[conn ids]
(let [ids (db/create-array conn "uuid" ids)]
(db/exec-one! conn [sql:mark-delete-in-bulk ids])))
;; NOTE: A getter that retrieves the key which will be used for group
;; ids; previously we have no value, then we introduced the
;; `:reference` prop, and then it is renamed to `:bucket` and now is
;; string instead. This is implemented in this way for backward
;; comaptibilty.
;; NOTE: we use the "file-media-object" as default value for
;; backward compatibility because when we deploy it we can
;; have old backend instances running in the same time as
;; the new one and we can still have storage-objects created
;; without bucket value. And we know that if it does not
;; have value, it means :file-media-object.
(defn- lookup-bucket
[{:keys [metadata]}]
(or (some-> metadata :bucket)
(some-> metadata :reference d/name)
"file-media-object"))
(defn- process-objects!
[conn get-fn ids bucket]
(loop [to-freeze #{}
to-delete #{}
ids (seq ids)]
(if-let [id (first ids)]
(let [nrefs (get-fn conn id)]
(if (pos? nrefs)
(do
(l/debug :hint "processing object"
:id (str id)
:status "freeze"
:bucket bucket :refs nrefs)
(recur (conj to-freeze id) to-delete (rest ids)))
(do
(l/debug :hint "processing object"
:id (str id)
:status "delete"
:bucket bucket :refs nrefs)
(recur to-freeze (conj to-delete id) (rest ids)))))
(do
(some->> (seq to-freeze) (mark-freeze-in-bulk! conn))
(some->> (seq to-delete) (mark-delete-in-bulk! conn))
[(count to-freeze) (count to-delete)]))))
(defn- process-bucket!
[conn bucket ids]
(case bucket
"file-media-object" (process-objects! conn get-file-media-object-nrefs ids bucket)
"team-font-variant" (process-objects! conn get-team-font-variant-nrefs ids bucket)
"file-object-thumbnail" (process-objects! conn get-file-object-thumbnails ids bucket)
"file-thumbnail" (process-objects! conn get-file-thumbnails ids bucket)
"profile" (process-objects! conn get-profile-nrefs ids bucket)
(ex/raise :type :internal
:code :unexpected-unknown-reference
:hint (dm/fmt "unknown reference %" bucket))))
(def ^:private
sql:get-touched-storage-objects
"SELECT so.*
FROM storage_object AS so
WHERE so.touched_at IS NOT NULL
ORDER BY touched_at ASC
FOR UPDATE
SKIP LOCKED")
(defn- group-by-bucket
[row]
(d/group-by lookup-bucket :id #{} row))
(defn- get-buckets
[conn]
(sequence
(comp (map impl/decode-row)
(partition-all 25)
(mapcat group-by-bucket))
(db/cursor conn sql:get-touched-storage-objects)))
(defn- process-touched!
[{:keys [::db/conn]}]
(loop [buckets (get-buckets conn)
freezed 0
deleted 0]
(if-let [[bucket ids] (first buckets)]
(let [[nfo ndo] (process-bucket! conn bucket ids)]
(recur (rest buckets)
(+ freezed nfo)
(+ deleted ndo)))
(do
(l/inf :hint "task finished"
:to-freeze freezed
:to-delete deleted)
{:freeze freezed :delete deleted}))))
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req [::db/pool]))
(defmethod ig/init-key ::handler
[_ cfg]
(fn [_]
(db/tx-run! cfg process-touched!)))

9
backend/src/app/storage/impl.clj
View file

@ -9,7 +9,7 @@
(:require (:require
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.db :as-alias db] [app.db :as db]
[app.storage :as-alias sto] [app.storage :as-alias sto]
[buddy.core.codecs :as bc] [buddy.core.codecs :as bc]
[buddy.core.hash :as bh] [buddy.core.hash :as bh]
@ -22,6 +22,13 @@
java.nio.file.Path java.nio.file.Path
java.util.UUID)) java.util.UUID))
(defn decode-row
"Decode the storage-object row fields"
[{:keys [metadata] :as row}]
(cond-> row
(some? metadata)
(assoc :metadata (db/decode-transit-pgobject metadata))))
;; --- API Definition ;; --- API Definition
(defmulti put-object (fn [cfg _ _] (::sto/type cfg))) (defmulti put-object (fn [cfg _ _] (::sto/type cfg)))

317
backend/src/app/tasks/file_gc.clj
View file

@ -10,7 +10,6 @@
file is eligible to be garbage collected after some period of file is eligible to be garbage collected after some period of
inactivity (the default threshold is 72h)." inactivity (the default threshold is 72h)."
(:require (:require
[app.common.data :as d]
[app.common.files.migrations :as pmg] [app.common.files.migrations :as pmg]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.thumbnails :as thc] [app.common.thumbnails :as thc]
@ -30,7 +29,7 @@
[integrant.core :as ig])) [integrant.core :as ig]))
(declare ^:private get-candidates) (declare ^:private get-candidates)
(declare ^:private process-file) (declare ^:private clean-file!)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HANDLER ;; HANDLER
@ -44,67 +43,61 @@
(assoc cfg ::min-age cf/deletion-delay)) (assoc cfg ::min-age cf/deletion-delay))
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ {:keys [::db/pool] :as cfg}] [_ cfg]
(fn [{:keys [file-id] :as params}] (fn [{:keys [file-id] :as params}]
(db/tx-run! cfg
(fn [{:keys [::db/conn] :as cfg}]
(let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
cfg (-> cfg
(update ::sto/storage media/configure-assets-storage conn)
(assoc ::file-id file-id)
(assoc ::min-age min-age))
(db/with-atomic [conn pool] total (reduce (fn [total file]
(let [min-age (dt/duration (or (:min-age params) (::min-age cfg))) (clean-file! cfg file)
cfg (-> cfg (inc total))
(update ::sto/storage media/configure-assets-storage conn) 0
(assoc ::db/conn conn) (get-candidates cfg))]
(assoc ::file-id file-id)
(assoc ::min-age min-age))
total (reduce (fn [total file] (l/inf :hint "task finished"
(process-file cfg file) :min-age (dt/format-duration min-age)
(inc total)) :processed total)
0
(get-candidates cfg))]
(l/info :hint "task finished" :min-age (dt/format-duration min-age) :processed total) ;; Allow optional rollback passed by params
(when (:rollback? params)
(db/rollback! conn))
;; Allow optional rollback passed by params {:processed total})))))
(when (:rollback? params)
(db/rollback! conn))
{:processed total}))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; IMPL ;; IMPL
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private (def ^:private
sql:get-candidates-chunk sql:get-candidates
"select f.id, "SELECT f.id,
f.data, f.data,
f.revn, f.revn,
f.features, f.features,
f.modified_at f.modified_at
from file as f FROM file AS f
where f.has_media_trimmed is false WHERE f.has_media_trimmed IS false
and f.modified_at < now() - ?::interval AND f.modified_at < now() - ?::interval
and f.modified_at < ? ORDER BY f.modified_at DESC
order by f.modified_at desc FOR UPDATE
limit 1 SKIP LOCKED")
for update skip locked")
(defn- get-candidates (defn- get-candidates
[{:keys [::db/conn ::min-age ::file-id]}] [{:keys [::db/conn ::min-age ::file-id]}]
(if (uuid? file-id) (if (uuid? file-id)
(do (do
(l/warn :hint "explicit file id passed on params" :file-id file-id) (l/warn :hint "explicit file id passed on params" :file-id (str file-id))
(->> (db/query conn :file {:id file-id}) (->> (db/query conn :file {:id file-id})
(map #(update % :features db/decode-pgarray #{})))) (map #(update % :features db/decode-pgarray #{}))))
(let [interval (db/interval min-age)
get-chunk (fn [cursor]
(let [rows (db/exec! conn [sql:get-candidates-chunk interval cursor])]
[(some->> rows peek :modified-at)
(map #(update % :features db/decode-pgarray #{}) rows)]))]
(d/iteration get-chunk (let [min-age (db/interval min-age)]
:vf second (->> (db/cursor conn [sql:get-candidates min-age] {:chunk-size 1})
:kf first (map #(update % :features db/decode-pgarray #{}))))))
:initk (dt/now)))))
(defn collect-used-media (defn collect-used-media
"Given a fdata (file data), returns all media references." "Given a fdata (file data), returns all media references."
@ -134,101 +127,93 @@
(into xform pages) (into xform pages)
(into (keys (:media data)))))) (into (keys (:media data))))))
(def ^:private sql:mark-file-media-object-deleted
"UPDATE file_media_object
SET deleted_at = now()
WHERE file_id = ? AND id != ALL(?::uuid[])
RETURNING id")
(defn- clean-file-media! (defn- clean-file-media!
"Performs the garbage collection of file media objects." "Performs the garbage collection of file media objects."
[conn file-id data] [conn file-id data]
(let [used (collect-used-media data) (let [used (collect-used-media data)
unused (->> (db/query conn :file-media-object {:file-id file-id}) ids (db/create-array conn "uuid" used)
(remove #(contains? used (:id %))))] unused (->> (db/exec! conn [sql:mark-file-media-object-deleted file-id ids])
(into #{} (map :id)))]
(doseq [mobj unused] (doseq [id unused]
(l/dbg :hint "delete file media object" (l/trc :hint "mark deleted"
:id (:id mobj) :rel "file-media-object"
:media-id (:media-id mobj) :id (str id)
:thumbnail-id (:thumbnail-id mobj)) :file-id (str file-id)))
;; NOTE: deleting the file-media-object in the database (count unused)))
;; automatically marks as touched the referenced storage
;; objects. The touch mechanism is needed because many files can
;; point to the same storage objects and we can't just delete (def ^:private sql:mark-file-object-thumbnails-deleted
;; them. "UPDATE file_tagged_object_thumbnail
(db/delete! conn :file-media-object {:id (:id mobj)})))) SET deleted_at = now()
WHERE file_id = ? AND object_id != ALL(?::text[])
RETURNING object_id")
(defn- clean-file-object-thumbnails! (defn- clean-file-object-thumbnails!
[{:keys [::db/conn ::sto/storage]} file-id data] [{:keys [::db/conn]} file-id data]
(let [stored (->> (db/query conn :file-tagged-object-thumbnail (let [using (->> (vals (:pages-index data))
{:file-id file-id} (into #{} (comp
{:columns [:object-id]}) (mapcat (fn [{:keys [id objects]}]
(into #{} (map :object-id))) (->> (ctt/get-frames objects)
(map #(assoc % :page-id id)))))
(mapcat (fn [{:keys [id page-id]}]
(list
(thc/fmt-object-id file-id page-id id "frame")
(thc/fmt-object-id file-id page-id id "component")))))))
using (into #{} ids (db/create-array conn "text" using)
(comp unused (->> (db/exec! conn [sql:mark-file-object-thumbnails-deleted file-id ids])
(mapcat (fn [{:keys [id objects]}] (into #{} (map :object-id)))]
(->> (ctt/get-frames objects)
(map #(assoc % :page-id id)))))
(mapcat (fn [{:keys [id page-id]}]
(list
(thc/fmt-object-id file-id page-id id "frame")
(thc/fmt-object-id file-id page-id id "component")))))
(vals (:pages-index data))) (doseq [object-id unused]
(l/trc :hint "mark deleted"
:rel "file-tagged-object-thumbnail"
:object-id object-id
:file-id (str file-id)))
unused (set/difference stored using)] (count unused)))
(when (seq unused)
(let [sql (str "delete from file_tagged_object_thumbnail "
" where file_id=? and object_id=ANY(?)"
" returning media_id")
res (db/exec! conn [sql file-id (db/create-array conn "text" unused)])]
(l/dbg :hint "delete file object thumbnails" (def ^:private sql:mark-file-thumbnails-deleted
:file-id (str file-id) "UPDATE file_thumbnail
:total (count res)) SET deleted_at = now()
WHERE file_id = ? AND revn < ?
(doseq [media-id (into #{} (keep :media-id) res)] RETURNING revn")
;; Mark as deleted the storage object related with the
;; photo-id field.
(l/trc :hint "touch file object thumbnail storage object" :id (str media-id))
(sto/touch-object! storage media-id))))))
(defn- clean-file-thumbnails! (defn- clean-file-thumbnails!
[{:keys [::db/conn ::sto/storage]} file-id revn] [{:keys [::db/conn]} file-id revn]
(let [sql (str "delete from file_thumbnail " (let [unused (->> (db/exec! conn [sql:mark-file-thumbnails-deleted file-id revn])
" where file_id=? and revn < ? " (into #{} (map :revn)))]
" returning media_id")
res (db/exec! conn [sql file-id revn])]
(when (seq res) (doseq [revn unused]
(l/dbg :hint "delete file thumbnails" (l/trc :hint "mark deleted"
:file-id (str file-id) :rel "file-thumbnail"
:total (count res)) :revn revn
:file-id (str file-id)))
(doseq [media-id (into #{} (keep :media-id) res)] (count unused)))
;; Mark as deleted the storage object related with the
;; media-id field.
(l/trc :hint "delete file thumbnail storage object" :id (str media-id))
(sto/del-object! storage media-id)))))
(def ^:private
sql:get-files-for-library (def ^:private sql:get-files-for-library
"select f.data, f.modified_at "SELECT f.id, f.data, f.modified_at
from file as f FROM file AS f
left join file_library_rel as fl on (fl.file_id = f.id) LEFT JOIN file_library_rel AS fl ON (fl.file_id = f.id)
where fl.library_file_id = ? WHERE fl.library_file_id = ?
and f.modified_at < ? AND f.deleted_at IS null
and f.deleted_at is null ORDER BY f.modified_at ASC")
order by f.modified_at desc
limit 1")
(defn- clean-deleted-components! (defn- clean-deleted-components!
"Performs the garbage collection of unreferenced deleted components." "Performs the garbage collection of unreferenced deleted components."
[conn file-id data] [{:keys [::db/conn] :as cfg} file-id data]
(letfn [(get-files-chunk [cursor] (letfn [(get-used-components [fdata components]
(let [rows (db/exec! conn [sql:get-files-for-library file-id cursor])]
[(some-> rows peek :modified-at)
(map (comp blob/decode :data) rows)]))
(get-used-components [fdata components]
;; Find which of the components are used in the file. ;; Find which of the components are used in the file.
(into #{} (into #{}
(filter #(ctf/used-in? fdata file-id % :component)) (filter #(ctf/used-in? fdata file-id % :component))
@ -246,69 +231,91 @@
files-data))] files-data))]
(let [deleted (into #{} (ctkl/deleted-components-seq data)) (let [deleted (into #{} (ctkl/deleted-components-seq data))
unused (->> (d/iteration get-files-chunk :vf second :kf first :initk (dt/now)) unused (->> (db/cursor conn [sql:get-files-for-library file-id] {:chunk-size 1})
(map (fn [{:keys [id data] :as file}]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
(-> (blob/decode data)
(feat.fdata/process-pointers deref)))))
(cons data) (cons data)
(get-unused-components deleted) (get-unused-components deleted)
(mapv :id))] (mapv :id))]
(when (seq unused) (doseq [id unused]
(l/dbg :hint "clean deleted components" :total (count unused)) (l/trc :hint "delete component" :component-id (str id) :file-id (str file-id)))
(let [data (reduce ctkl/delete-component data unused)]
(db/update! conn :file (when-let [data (some->> (seq unused)
{:data (blob/encode data)} (reduce ctkl/delete-component data)
{:id file-id})))))) (blob/encode))]
(db/update! conn :file
{:data data}
{:id file-id}
{::db/return-keys? false}))
(count unused))))
(def ^:private sql:get-changes
"SELECT id, data FROM file_change
WHERE file_id = ? AND data IS NOT NULL
ORDER BY created_at ASC")
(def ^:private sql:mark-deleted-data-fragments
"UPDATE file_data_fragment
SET deleted_at = now()
WHERE file_id = ?
AND id != ALL(?::uuid[])
RETURNING id")
(defn- clean-data-fragments! (defn- clean-data-fragments!
[conn file-id data] [conn file-id data]
(letfn [(get-pointers-chunk [cursor] (let [used (->> (db/cursor conn [sql:get-changes file-id])
(let [sql (str "select id, data, created_at " (into (feat.fdata/get-used-pointer-ids data)
" from file_change " (comp (map :data)
" where file_id = ? " (map blob/decode)
" and data is not null " (mapcat feat.fdata/get-used-pointer-ids))))
" and created_at < ? "
" order by created_at desc "
" limit 1;")
rows (db/exec! conn [sql file-id cursor])]
[(some-> rows peek :created-at)
(mapcat (comp feat.fdata/get-used-pointer-ids blob/decode :data) rows)]))]
(let [used (into (feat.fdata/get-used-pointer-ids data) unused (let [ids (db/create-array conn "uuid" used)]
(d/iteration get-pointers-chunk (->> (db/exec! conn [sql:mark-deleted-data-fragments file-id ids])
:vf second (into #{} (map :id))))]
:kf first
:initk (dt/now)))
sql (str "select id from file_data_fragment " (doseq [id unused]
" where file_id = ? AND id != ALL(?::uuid[])") (l/trc :hint "mark deleted"
used (db/create-array conn "uuid" used) :rel "file-data-fragment"
rows (db/exec! conn [sql file-id used])] :id (str id)
:file-id (str file-id)))
(doseq [fragment-id (map :id rows)] (count unused)))
(l/trc :hint "remove unused file data fragment" :id (str fragment-id))
(db/delete! conn :file-data-fragment {:id fragment-id :file-id file-id})))))
(defn- process-file
[{:keys [::db/conn] :as cfg} {:keys [id data revn modified-at features] :as file}] (defn- clean-file!
(l/dbg :hint "processing file" :file-id (str id) :modified-at modified-at) [{:keys [::db/conn] :as cfg} {:keys [id data revn modified-at] :as file}]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id) (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* (pmap/create-tracked)] pmap/*tracked* (pmap/create-tracked)]
(let [data (-> (blob/decode data) (let [data (-> (blob/decode data)
(assoc :id id) (assoc :id id)
(pmg/migrate-data))] (pmg/migrate-data))
(clean-file-media! conn id data) nfm (clean-file-media! conn id data)
(clean-file-object-thumbnails! cfg id data) nfot (clean-file-object-thumbnails! cfg id data)
(clean-file-thumbnails! cfg id revn) nft (clean-file-thumbnails! cfg id revn)
(clean-deleted-components! conn id data) nc (clean-deleted-components! cfg id data)
ndf (clean-data-fragments! conn id data)]
(when (contains? features "fdata/pointer-map") (l/dbg :hint "file clened"
(clean-data-fragments! conn id data)) :file-id (str id)
:modified-at (dt/format-instant modified-at)
:media-objects nfm
:thumbnails nft
:object-thumbnails nfot
:components nc
:data-fragments ndf)
;; Mark file as trimmed ;; Mark file as trimmed
(db/update! conn :file (db/update! conn :file
{:has-media-trimmed true} {:has-media-trimmed true}
{:id id}) {:id id}
{::db/return-keys? false})
(feat.fdata/persist-pointers! cfg id)))) (feat.fdata/persist-pointers! cfg id))))

465
backend/src/app/tasks/objects_gc.clj
View file

@ -8,7 +8,6 @@
"A maintenance task that performs a general purpose garbage collection "A maintenance task that performs a general purpose garbage collection
of deleted or unreachable objects." of deleted or unreachable objects."
(:require (:require
[app.common.data :as d]
[app.common.logging :as l] [app.common.logging :as l]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
@ -18,12 +17,15 @@
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig])) [integrant.core :as ig]))
(declare ^:private delete-profiles!) (declare ^:private delete-file-data-fragments!)
(declare ^:private delete-teams!) (declare ^:private delete-file-media-objects!)
(declare ^:private delete-fonts!) (declare ^:private delete-file-object-thumbnails!)
(declare ^:private delete-projects!) (declare ^:private delete-file-thumbnails!)
(declare ^:private delete-files!) (declare ^:private delete-files!)
(declare ^:private delete-orphan-teams!) (declare ^:private delete-fonts!)
(declare ^:private delete-profiles!)
(declare ^:private delete-projects!)
(declare ^:private delete-teams!)
(defmethod ig/pre-init-spec ::handler [_] (defmethod ig/pre-init-spec ::handler [_]
(s/keys :req [::db/pool ::sto/storage])) (s/keys :req [::db/pool ::sto/storage]))
@ -33,211 +35,320 @@
(assoc cfg ::min-age cf/deletion-delay)) (assoc cfg ::min-age cf/deletion-delay))
(defmethod ig/init-key ::handler (defmethod ig/init-key ::handler
[_ {:keys [::db/pool ::sto/storage] :as cfg}] [_ cfg]
(fn [params] (fn [params]
(db/with-atomic [conn pool] (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(let [min-age (or (:min-age params) (::min-age cfg)) ;; Disable deletion protection for the current transaction
_ (l/info :hint "gc started" (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
:min-age (dt/format-duration min-age) (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
:rollback? (boolean (:rollback? params)))
storage (media/configure-assets-storage storage conn) (let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
cfg (-> cfg cfg (-> cfg
(assoc ::min-age (db/interval min-age)) (assoc ::min-age (db/interval min-age))
(assoc ::conn conn) (update ::sto/storage media/configure-assets-storage conn))
(assoc ::storage storage))
htotal (+ (delete-profiles! cfg) total (reduce + 0
(delete-teams! cfg) [(delete-profiles! cfg)
(delete-projects! cfg) (delete-teams! cfg)
(delete-files! cfg) (delete-fonts! cfg)
(delete-fonts! cfg)) (delete-projects! cfg)
stotal (delete-orphan-teams! cfg)] (delete-files! cfg)
(delete-file-thumbnails! cfg)
(delete-file-object-thumbnails! cfg)
(delete-file-data-fragments! cfg)
(delete-file-media-objects! cfg)])]
(l/info :hint "gc finished" (l/info :hint "task finished"
:deleted htotal :deleted total
:orphans stotal :rollback? (boolean (:rollback? params)))
:rollback? (boolean (:rollback? params)))
(when (:rollback? params) (when (:rollback? params)
(db/rollback! conn)) (db/rollback! conn))
{:processed (+ stotal htotal) {:processed total})))))
:orphans stotal}))))
(def ^:private sql:get-profiles-chunk (def ^:private sql:get-profiles
"select id, photo_id, created_at from profile "SELECT id, photo_id FROM profile
where deleted_at is not null WHERE deleted_at IS NOT NULL
and deleted_at < now() - ?::interval AND deleted_at < now() - ?::interval
and created_at < ? ORDER BY deleted_at ASC
order by created_at desc FOR UPDATE
limit 10 SKIP LOCKED")
for update skip locked")
(defn- delete-profiles! (defn- delete-profiles!
[{:keys [::conn ::min-age ::storage] :as cfg}] [{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
(letfn [(get-chunk [cursor] (->> (db/cursor conn [sql:get-profiles min-age])
(let [rows (db/exec! conn [sql:get-profiles-chunk min-age cursor])] (reduce (fn [total {:keys [id photo-id]}]
[(some->> rows peek :created-at) rows])) (l/trc :hint "permanently delete" :rel "profile" :id (str id))
(process-profile [total {:keys [id photo-id]}] ;; Mark as deleted the storage object
(l/debug :hint "permanently delete profile" :id (str id)) (some->> photo-id (sto/touch-object! storage))
;; Mark as deleted the storage object related with the ;; And finally, permanently delete the profile. The
;; photo-id field. ;; relevant objects will be deleted using DELETE
(some->> photo-id (sto/touch-object! storage)) ;; CASCADE database triggers. This may leave orphan
;; teams, but there is a special task for deleting
;; orphaned teams.
(db/delete! conn :profile
{:id id}
{::db/return-keys? false})
;; And finally, permanently delete the profile. (inc total))
(db/delete! conn :profile {:id id}) 0)))
(inc total))] (def ^:private sql:get-teams
"SELECT deleted_at, id, photo_id FROM team
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now)) WHERE deleted_at IS NOT NULL
(reduce process-profile 0)))) AND deleted_at < now() - ?::interval
ORDER BY deleted_at ASC
(def ^:private sql:get-teams-chunk FOR UPDATE
"select id, photo_id, created_at from team SKIP LOCKED")
where deleted_at is not null
and deleted_at < now() - ?::interval
and created_at < ?
order by created_at desc
limit 10
for update skip locked")
(defn- delete-teams! (defn- delete-teams!
[{:keys [::conn ::min-age ::storage] :as cfg}] [{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
(letfn [(get-chunk [cursor]
(let [rows (db/exec! conn [sql:get-teams-chunk min-age cursor])]
[(some->> rows peek :created-at) rows]))
(process-team [total {:keys [id photo-id]}] (->> (db/cursor conn [sql:get-teams min-age])
(l/debug :hint "permanently delete team" :id (str id)) (reduce (fn [total {:keys [id photo-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "team"
:id (str id)
:deleted-at (dt/format-instant deleted-at))
;; Mark as deleted the storage object related with the ;; Mark as deleted the storage object
;; photo-id field. (some->> photo-id (sto/touch-object! storage))
(some->> photo-id (sto/touch-object! storage))
;; And finally, permanently delete the team. ;; And finally, permanently delete the team.
(db/delete! conn :team {:id id}) (db/delete! conn :team
{:id id}
{::db/return-keys? false})
(inc total))] ;; Mark for deletion in cascade
(db/update! conn :team-font-variant
{:deleted-at deleted-at}
{:team-id id}
{::db/return-keys? false})
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now)) (db/update! conn :project
(reduce process-team 0)))) {:deleted-at deleted-at}
{:team-id id}
{::db/return-keys? false})
(def ^:private sql:get-orphan-teams-chunk (inc total))
"select t.id, t.created_at 0)))
from team as t
left join team_profile_rel as tpr
on (t.id = tpr.team_id)
where tpr.profile_id is null
and t.created_at < ?
order by t.created_at desc
limit 10
for update of t skip locked;")
(defn- delete-orphan-teams! (def ^:private sql:get-fonts
"Find all orphan teams (with no members and mark them for "SELECT id, team_id, deleted_at, woff1_file_id, woff2_file_id, otf_file_id, ttf_file_id
deletion (soft delete)." FROM team_font_variant
[{:keys [::conn] :as cfg}] WHERE deleted_at IS NOT NULL
(letfn [(get-chunk [cursor] AND deleted_at < now() - ?::interval
(let [rows (db/exec! conn [sql:get-orphan-teams-chunk cursor])] ORDER BY deleted_at ASC
[(some->> rows peek :created-at) rows])) FOR UPDATE
SKIP LOCKED")
(process-team [total {:keys [id]}]
(let [result (db/update! conn :team
{:deleted-at (dt/now)}
{:id id :deleted-at nil}
{::db/return-keys? false})
count (db/get-update-count result)]
(when (pos? count)
(l/debug :hint "mark team for deletion" :id (str id)))
(+ total count)))]
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now))
(reduce process-team 0))))
(def ^:private sql:get-fonts-chunk
"select id, created_at, woff1_file_id, woff2_file_id, otf_file_id, ttf_file_id
from team_font_variant
where deleted_at is not null
and deleted_at < now() - ?::interval
and created_at < ?
order by created_at desc
limit 10
for update skip locked")
(defn- delete-fonts! (defn- delete-fonts!
[{:keys [::conn ::min-age ::storage] :as cfg}] [{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
(letfn [(get-chunk [cursor] (->> (db/cursor conn [sql:get-fonts min-age])
(let [rows (db/exec! conn [sql:get-fonts-chunk min-age cursor])] (reduce (fn [total {:keys [id team-id deleted-at] :as font}]
[(some->> rows peek :created-at) rows])) (l/trc :hint "permanently delete"
:rel "team-font-variant"
:id (str id)
:team-id (str team-id)
:deleted-at (dt/format-instant deleted-at))
(process-font [total {:keys [id] :as font}] ;; Mark as deleted the all related storage objects
(l/debug :hint "permanently delete font variant" :id (str id)) (some->> (:woff1-file-id font) (sto/touch-object! storage))
(some->> (:woff2-file-id font) (sto/touch-object! storage))
(some->> (:otf-file-id font) (sto/touch-object! storage))
(some->> (:ttf-file-id font) (sto/touch-object! storage))
;; Mark as deleted the all related storage objects ;; And finally, permanently delete the team font variant
(some->> (:woff1-file-id font) (sto/touch-object! storage)) (db/delete! conn :team-font-variant
(some->> (:woff2-file-id font) (sto/touch-object! storage)) {:id id}
(some->> (:otf-file-id font) (sto/touch-object! storage)) {::db/return-keys? false})
(some->> (:ttf-file-id font) (sto/touch-object! storage))
;; And finally, permanently delete the team font variant (inc total))
(db/delete! conn :team-font-variant {:id id}) 0)))
(inc total))] (def ^:private sql:get-projects
"SELECT id, deleted_at, team_id
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now)) FROM project
(reduce process-font 0)))) WHERE deleted_at IS NOT NULL
AND deleted_at < now() - ?::interval
(def ^:private sql:get-projects-chunk ORDER BY deleted_at ASC
"select id, created_at FOR UPDATE
from project SKIP LOCKED")
where deleted_at is not null
and deleted_at < now() - ?::interval
and created_at < ?
order by created_at desc
limit 10
for update skip locked")
(defn- delete-projects! (defn- delete-projects!
[{:keys [::conn ::min-age] :as cfg}] [{:keys [::db/conn ::min-age] :as cfg}]
(letfn [(get-chunk [cursor] (->> (db/cursor conn [sql:get-projects min-age])
(let [rows (db/exec! conn [sql:get-projects-chunk min-age cursor])] (reduce (fn [total {:keys [id team-id deleted-at]}]
[(some->> rows peek :created-at) rows])) (l/trc :hint "permanently delete"
:rel "project"
:id (str id)
:team-id (str team-id)
:deleted-at (dt/format-instant deleted-at))
;; And finally, permanently delete the project.
(db/delete! conn :project
{:id id}
{::db/return-keys? false})
(process-project [total {:keys [id]}] ;; Mark files to be deleted
(l/debug :hint "permanently delete project" :id (str id)) (db/update! conn :file
;; And finally, permanently delete the project. {:deleted-at deleted-at}
(db/delete! conn :project {:id id}) {:project-id id}
{::db/return-keys? false})
(inc total))] (inc total))
0)))
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now)) (def ^:private sql:get-files
(reduce process-project 0)))) "SELECT id, deleted_at, project_id
FROM file
(def ^:private sql:get-files-chunk WHERE deleted_at IS NOT NULL
"select id, created_at AND deleted_at < now() - ?::interval
from file ORDER BY deleted_at ASC
where deleted_at is not null FOR UPDATE
and deleted_at < now() - ?::interval SKIP LOCKED")
and created_at < ?
order by created_at desc
limit 10
for update skip locked")
(defn- delete-files! (defn- delete-files!
[{:keys [::conn ::min-age] :as cfg}] [{:keys [::db/conn ::min-age] :as cfg}]
(letfn [(get-chunk [cursor] (->> (db/cursor conn [sql:get-files min-age])
(let [rows (db/exec! conn [sql:get-files-chunk min-age cursor])] (reduce (fn [total {:keys [id deleted-at project-id]}]
[(some->> rows peek :created-at) rows])) (l/trc :hint "permanently delete"
:rel "file"
:id (str id)
:project-id (str project-id)
:deleted-at (dt/format-instant deleted-at))
(process-file [total {:keys [id]}] ;; And finally, permanently delete the file.
(l/debug :hint "permanently delete file" :id (str id)) (db/delete! conn :file
;; And finally, permanently delete the file. {:id id}
(db/delete! conn :file {:id id}) {::db/return-keys? false})
(inc total))]
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now)) ;; Mark file media objects to be deleted
(reduce process-file 0)))) (db/update! conn :file-media-object
{:deleted-at deleted-at}
{:file-id id}
{::db/return-keys? false})
;; Mark thumbnails to be deleted
(db/update! conn :file-thumbnail
{:deleted-at deleted-at}
{:file-id id}
{::db/return-keys? false})
(db/update! conn :file-tagged-object-thumbnail
{:deleted-at deleted-at}
{:file-id id}
{::db/return-keys? false})
(inc total))
0)))
(def ^:private sql:get-file-thumbnails
"SELECT file_id, revn, media_id, deleted_at
FROM file_thumbnail
WHERE deleted_at IS NOT NULL
AND deleted_at < now() - ?::interval
ORDER BY deleted_at ASC
FOR UPDATE
SKIP LOCKED")
(defn delete-file-thumbnails!
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-file-thumbnails min-age])
(reduce (fn [total {:keys [file-id revn media-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "file-thumbnail"
:file-id (str file-id)
:revn revn
:deleted-at (dt/format-instant deleted-at))
;; Mark as deleted the storage object
(some->> media-id (sto/touch-object! storage))
;; And finally, permanently delete the object
(db/delete! conn :file-thumbnail {:file-id file-id :revn revn})
(inc total))
0)))
(def ^:private sql:get-file-object-thumbnails
"SELECT file_id, object_id, media_id, deleted_at
FROM file_tagged_object_thumbnail
WHERE deleted_at IS NOT NULL
AND deleted_at < now() - ?::interval
ORDER BY deleted_at ASC
FOR UPDATE
SKIP LOCKED")
(defn delete-file-object-thumbnails!
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-file-object-thumbnails min-age])
(reduce (fn [total {:keys [file-id object-id media-id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "file-tagged-object-thumbnail"
:file-id (str file-id)
:object-id object-id
:deleted-at (dt/format-instant deleted-at))
;; Mark as deleted the storage object
(some->> media-id (sto/touch-object! storage))
;; And finally, permanently delete the object
(db/delete! conn :file-tagged-object-thumbnail {:file-id file-id :object-id object-id})
(inc total))
0)))
(def ^:private sql:get-file-data-fragments
"SELECT file_id, id, deleted_at
FROM file_data_fragment
WHERE deleted_at IS NOT NULL
AND deleted_at < now() - ?::interval
ORDER BY deleted_at ASC
FOR UPDATE
SKIP LOCKED")
(defn- delete-file-data-fragments!
[{:keys [::db/conn ::min-age] :as cfg}]
(->> (db/cursor conn [sql:get-file-data-fragments min-age])
(reduce (fn [total {:keys [file-id id deleted-at]}]
(l/trc :hint "permanently delete"
:rel "file-data-fragment"
:id (str id)
:file-id (str file-id)
:deleted-at (dt/format-instant deleted-at))
(db/delete! conn :file-data-fragment {:file-id file-id :id id})
(inc total))
0)))
(def ^:private sql:get-file-media-objects
"SELECT id, file_id, media_id, thumbnail_id, deleted_at
FROM file_media_object
WHERE deleted_at IS NOT NULL
AND deleted_at < now() - ?::interval
ORDER BY deleted_at ASC
FOR UPDATE
SKIP LOCKED")
(defn- delete-file-media-objects!
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
(->> (db/cursor conn [sql:get-file-media-objects min-age])
(reduce (fn [total {:keys [id file-id deleted-at] :as fmo}]
(l/trc :hint "permanently delete"
:rel "file-media-object"
:id (str id)
:file-id (str file-id)
:deleted-at (dt/format-instant deleted-at))
;; Mark as deleted the all related storage objects
(some->> (:media-id fmo) (sto/touch-object! storage))
(some->> (:thumbnail-id fmo) (sto/touch-object! storage))
(db/delete! conn :file-media-object {:id id})
(inc total))
0)))

60
backend/src/app/tasks/orphan_teams_gc.clj Normal file
View file

@ -0,0 +1,60 @@
;; 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
(ns app.tasks.orphan-teams-gc
"A maintenance task that performs orphan teams GC."
(:require
[app.common.logging :as l]
[app.db :as db]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[integrant.core :as ig]))
(declare ^:private delete-orphan-teams!)
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req [::db/pool]))
(defmethod ig/init-key ::handler
[_ cfg]
(fn [params]
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
(l/inf :hint "gc started" :rollback? (boolean (:rollback? params)))
(let [total (delete-orphan-teams! cfg)]
(l/inf :hint "task finished"
:teams total
:rollback? (boolean (:rollback? params)))
(when (:rollback? params)
(db/rollback! conn))
{:processed total})))))
(def ^:private sql:get-orphan-teams
"SELECT t.id
FROM team AS t
LEFT JOIN team_profile_rel AS tpr
ON (t.id = tpr.team_id)
WHERE tpr.profile_id IS NULL
AND t.deleted_at IS NULL
ORDER BY t.created_at ASC
FOR UPDATE OF t
SKIP LOCKED")
(defn- delete-orphan-teams!
"Find all orphan teams (with no members) and mark them for
deletion (soft delete)."
[{:keys [::db/conn] :as cfg}]
(->> (db/cursor conn sql:get-orphan-teams)
(map :id)
(reduce (fn [total team-id]
(l/trc :hint "mark orphan team for deletion" :id (str team-id))
(db/update! conn :team
{:deleted-at (dt/now)}
{:id team-id}
{::db/return-keys? false})
(inc total))
0)))

15
backend/test/backend_tests/helpers.clj
View file

@ -175,12 +175,11 @@
" WHERE table_schema = 'public' " " WHERE table_schema = 'public' "
" AND table_name != 'migrations';")] " AND table_name != 'migrations';")]
(db/with-atomic [conn *pool*] (db/with-atomic [conn *pool*]
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
(let [result (->> (db/exec! conn [sql]) (let [result (->> (db/exec! conn [sql])
(map :table-name) (map :table-name)
(remove #(= "task" %))) (remove #(= "task" %)))]
sql (str "TRUNCATE "
(apply str (interpose ", " result))
" CASCADE;")]
(doseq [table result] (doseq [table result]
(db/exec! conn [(str "delete from " table ";")])))) (db/exec! conn [(str "delete from " table ";")]))))
@ -433,11 +432,11 @@
(us/pretty-explain data)) (us/pretty-explain data))
(= :params-validation (:code data)) (= :params-validation (:code data))
(app.common.pprint/pprint (println
(sm/humanize-explain (::sm/explain data))) (sm/humanize-explain (::sm/explain data)))
(= :data-validation (:code data)) (= :data-validation (:code data))
(app.common.pprint/pprint (println
(sm/humanize-explain (::sm/explain data))) (sm/humanize-explain (::sm/explain data)))
(= :service-error (:type data)) (= :service-error (:type data))
@ -512,6 +511,10 @@
[sql] [sql]
(db/exec! *pool* sql)) (db/exec! *pool* sql))
(defn db-exec-one!
[sql]
(db/exec-one! *pool* sql))
(defn db-delete! (defn db-delete!
[& params] [& params]
(apply db/delete! *pool* params)) (apply db/delete! *pool* params))

152
backend/test/backend_tests/rpc_file_test.clj
View file

@ -149,7 +149,7 @@
shape-id (uuid/random)] shape-id (uuid/random)]
;; Preventive file-gc ;; Preventive file-gc
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; Check the number of fragments before adding the page ;; Check the number of fragments before adding the page
@ -175,7 +175,7 @@
(t/is (= 2 (count rows)))) (t/is (= 2 (count rows))))
;; The file-gc should remove unused fragments ;; The file-gc should remove unused fragments
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
@ -203,7 +203,7 @@
(t/is (= 3 (count rows)))) (t/is (= 3 (count rows))))
;; The file-gc should remove unused fragments ;; The file-gc should remove unused fragments
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; Check the number of fragments; should be 3 because changes ;; Check the number of fragments; should be 3 because changes
@ -220,12 +220,23 @@
;; The file-gc should remove fragments related to changes ;; The file-gc should remove fragments related to changes
;; snapshots previously deleted. ;; snapshots previously deleted.
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; Check the number of fragments; ;; Check the number of fragments;
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})] (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows))))))) ;; (pp/pprint rows)
(t/is (= 3 (count rows)))
(t/is (= 2 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
(t/is (= 2 (count rows))))
)))
(t/deftest file-gc-task-with-thumbnails (t/deftest file-gc-task-with-thumbnails
(letfn [(add-file-media-object [& {:keys [profile-id file-id]}] (letfn [(add-file-media-object [& {:keys [profile-id file-id]}]
@ -301,17 +312,16 @@
;; freeze because of the deduplication (we have uploaded 2 times ;; freeze because of the deduplication (we have uploaded 2 times
;; the same files). ;; the same files).
(let [task (:app.storage/gc-touched-task th/*system*) (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
res (task {:min-age (dt/duration 0)})]
(t/is (= 2 (:freeze res))) (t/is (= 2 (:freeze res)))
(t/is (= 0 (:delete res)))) (t/is (= 0 (:delete res))))
;; run the file-gc task immediately without forced min-age ;; run the file-gc task immediately without forced min-age
(let [res (th/run-task! "file-gc")] (let [res (th/run-task! :file-gc)]
(t/is (= 0 (:processed res)))) (t/is (= 0 (:processed res))))
;; run the task again ;; run the task again
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; retrieve file and check trimmed attribute ;; retrieve file and check trimmed attribute
@ -319,8 +329,17 @@
(t/is (true? (:has-media-trimmed row)))) (t/is (true? (:has-media-trimmed row))))
;; check file media objects ;; check file media objects
(let [rows (th/db-exec! ["select * from file_media_object where file_id = ?" (:id file)])] (let [rows (th/db-query :file-media-object {:file-id (:id file)})]
(t/is (= 1 (count rows)))) (t/is (= 2 (count rows)))
(t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (: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 (comp some? :deleted-at) rows)))))
;; The underlying storage objects are still available. ;; The underlying storage objects are still available.
(t/is (some? (sto/get-object storage (:media-id fmo2)))) (t/is (some? (sto/get-object storage (:media-id fmo2))))
@ -340,15 +359,16 @@
;; Now, we have deleted the usage of pointers to the ;; Now, we have deleted the usage of pointers to the
;; file-media-objects, if we paste file-gc, they should be marked ;; file-media-objects, if we paste file-gc, they should be marked
;; as deleted. ;; as deleted.
(let [task (:app.tasks.file-gc/handler th/*system*) (let [res (th/run-task! :file-gc {:min-age 0})]
res (task {:min-age (dt/duration 0)})] (t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; Now that file-gc have deleted the file-media-object usage, ;; Now that file-gc have deleted the file-media-object usage,
;; lets execute the touched-gc task, we should see that two of ;; lets execute the touched-gc task, we should see that two of
;; them are marked to be deleted. ;; them are marked to be deleted.
(let [task (:app.storage/gc-touched-task th/*system*) (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
res (task {:min-age (dt/duration 0)})]
(t/is (= 0 (:freeze res))) (t/is (= 0 (:freeze res)))
(t/is (= 2 (:delete res)))) (t/is (= 2 (:delete res))))
@ -457,11 +477,14 @@
:strokes [{:opacity 1 :stroke-image {:id (:id fmo5) :width 100 :height 100 :mtype "image/jpeg"}}]})}]) :strokes [{:opacity 1 :stroke-image {:id (:id fmo5) :width 100 :height 100 :mtype "image/jpeg"}}]})}])
;; run the file-gc task immediately without forced min-age ;; run the file-gc task immediately without forced min-age
(let [res (th/run-task! "file-gc")] (let [res (th/run-task! :file-gc)]
(t/is (= 0 (:processed res)))) (t/is (= 0 (:processed res))))
;; run the task again ;; run the task again
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; retrieve file and check trimmed attribute ;; retrieve file and check trimmed attribute
@ -494,15 +517,16 @@
;; Now, we have deleted the usage of pointers to the ;; Now, we have deleted the usage of pointers to the
;; file-media-objects, if we paste file-gc, they should be marked ;; file-media-objects, if we paste file-gc, they should be marked
;; as deleted. ;; as deleted.
(let [task (:app.tasks.file-gc/handler th/*system*) (let [res (th/run-task! :file-gc {:min-age 0})]
res (task {:min-age (dt/duration 0)})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 5 (:processed res))))
;; Now that file-gc have deleted the file-media-object usage, ;; Now that file-gc have deleted the file-media-object usage,
;; lets execute the touched-gc task, we should see that two of ;; lets execute the touched-gc task, we should see that two of
;; them are marked to be deleted. ;; them are marked to be deleted.
(let [task (:app.storage/gc-touched-task th/*system*) (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
res (task {:min-age (dt/duration 0)})]
(t/is (= 0 (:freeze res))) (t/is (= 0 (:freeze res)))
(t/is (= 2 (:delete res)))) (t/is (= 2 (:delete res))))
@ -515,7 +539,6 @@
(t/is (nil? (sto/get-object storage (:media-id fmo2)))) (t/is (nil? (sto/get-object storage (:media-id fmo2))))
(t/is (nil? (sto/get-object storage (:media-id fmo1))))))) (t/is (nil? (sto/get-object storage (:media-id fmo1)))))))
(t/deftest file-gc-task-with-object-thumbnails (t/deftest file-gc-task-with-object-thumbnails
(letfn [(insert-file-object-thumbnail! [& {:keys [profile-id file-id page-id frame-id]}] (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") (let [object-id (thc/fmt-object-id file-id page-id frame-id "frame")
@ -609,16 +632,16 @@
;; because of the deduplication (we have uploaded 2 times the ;; because of the deduplication (we have uploaded 2 times the
;; same files). ;; same files).
(let [res (th/run-task! "storage-gc-touched" {:min-age (dt/duration 0)})] (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 1 (:freeze res))) (t/is (= 1 (:freeze res)))
(t/is (= 0 (:delete res)))) (t/is (= 0 (:delete res))))
;; run the file-gc task immediately without forced min-age ;; run the file-gc task immediately without forced min-age
(let [res (th/run-task! "file-gc")] (let [res (th/run-task! :file-gc)]
(t/is (= 0 (:processed res)))) (t/is (= 0 (:processed res))))
;; run the task again ;; run the task again
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; retrieve file and check trimmed attribute ;; retrieve file and check trimmed attribute
@ -648,22 +671,29 @@
:page-id page-id :page-id page-id
:id frame-id-2}]) :id frame-id-2}])
(let [res (th/run-task! "file-gc" {:min-age (dt/duration 0)})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
(let [rows (th/db-exec! ["select * from file_tagged_object_thumbnail where file_id = ?" file-id])] (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id file-id})]
;; (pp/pprint rows) (t/is (= 2 (count rows)))
(t/is (= 1 (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") (t/is (= (thc/fmt-object-id file-id page-id frame-id-1 "frame")
(-> rows first :object-id)))) (-> rows first :object-id))))
;; Now that file-gc have deleted the object thumbnail lets ;; 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
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
;; Now that objects-gc have deleted the object thumbnail lets
;; execute the touched-gc task ;; execute the touched-gc task
(let [res (th/run-task! "storage-gc-touched" {:min-age (dt/duration 0)})] (let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
(t/is (= 1 (:freeze res)))) (t/is (= 1 (:freeze res))))
;; check file media objects ;; check file media objects
(let [rows (th/db-exec! ["select * from storage_object where deleted_at is null"])] (let [rows (th/db-query :storage-object {:deleted-at nil})]
;; (pp/pprint rows) ;; (pp/pprint rows)
(t/is (= 1 (count rows)))) (t/is (= 1 (count rows))))
@ -676,31 +706,32 @@
:page-id page-id :page-id page-id
:id frame-id-1}]) :id frame-id-1}])
(let [res (th/run-task! "file-gc" {:min-age (dt/duration 0)})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
(let [rows (th/db-exec! ["select * from file_tagged_object_thumbnail where file_id = ?" file-id])] (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id file-id})]
(t/is (= 0 (count rows)))) (t/is (= 1 (count rows)))
(t/is (= 0 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
;; (pp/pprint res)
(t/is (= 1 (:processed res))))
;; We still have th storage objects in the table ;; We still have th storage objects in the table
(let [rows (th/db-exec! ["select * from storage_object where deleted_at is null"])] (let [rows (th/db-query :storage-object {:deleted-at nil})]
;; (pp/pprint rows) ;; (pp/pprint rows)
(t/is (= 1 (count rows)))) (t/is (= 1 (count rows))))
;; Now that file-gc have deleted the object thumbnail lets ;; Now that file-gc have deleted the object thumbnail lets
;; execute the touched-gc task ;; execute the touched-gc task
(let [res (th/run-task! "storage-gc-touched" {:min-age (dt/duration 0)})] (let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 1 (:delete res)))) (t/is (= 1 (:delete res))))
;; check file media objects ;; check file media objects
(let [rows (th/db-exec! ["select * from storage_object where deleted_at is null"])] (let [rows (th/db-query :storage-object {:deleted-at nil})]
;; (pp/pprint rows) ;; (pp/pprint rows)
(t/is (= 0 (count rows))))))) (t/is (= 0 (count rows)))))))
(t/deftest permissions-checks-creating-file (t/deftest permissions-checks-creating-file
(let [profile1 (th/create-profile* 1) (let [profile1 (th/create-profile* 1)
profile2 (th/create-profile* 2) profile2 (th/create-profile* 2)
@ -811,13 +842,12 @@
(t/is (th/ex-of-type? error :not-found)))) (t/is (th/ex-of-type? error :not-found))))
(t/deftest deletion (t/deftest deletion
(let [task (:app.tasks.objects-gc/handler th/*system*) (let [profile1 (th/create-profile* 1)
profile1 (th/create-profile* 1)
file (th/create-file* 1 {:project-id (:default-project-id profile1) file (th/create-file* 1 {:project-id (:default-project-id profile1)
:profile-id (:id profile1)})] :profile-id (:id profile1)})]
;; file is not deleted because it does not meet all ;; file is not deleted because it does not meet all
;; conditions to be deleted. ;; conditions to be deleted.
(let [result (task {:min-age (dt/duration 0)})] (let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 0 (:processed result)))) (t/is (= 0 (:processed result))))
;; query the list of files ;; query the list of files
@ -848,7 +878,7 @@
(t/is (= 0 (count result))))) (t/is (= 0 (count result)))))
;; run permanent deletion (should be noop) ;; run permanent deletion (should be noop)
(let [result (task {:min-age (dt/duration {:minutes 1})})] (let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
(t/is (= 0 (:processed result)))) (t/is (= 0 (:processed result))))
;; query the list of file libraries of a after hard deletion ;; query the list of file libraries of a after hard deletion
@ -862,7 +892,7 @@
(t/is (= 0 (count result))))) (t/is (= 0 (count result)))))
;; run permanent deletion ;; run permanent deletion
(let [result (task {:min-age (dt/duration 0)})] (let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result)))) (t/is (= 1 (:processed result))))
;; query the list of file libraries of a after hard deletion ;; query the list of file libraries of a after hard deletion
@ -874,7 +904,8 @@
(let [error (:error out) (let [error (:error out)
error-data (ex-data error)] error-data (ex-data error)]
(t/is (th/ex-info? error)) (t/is (th/ex-info? error))
(t/is (= (:type error-data) :not-found)))))) (t/is (= (:type error-data) :not-found))))
))
(t/deftest object-thumbnails-ops (t/deftest object-thumbnails-ops
@ -1075,7 +1106,7 @@
(th/sleep 300) (th/sleep 300)
;; run the task ;; run the task
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; check that object thumbnails are still here ;; check that object thumbnails are still here
@ -1104,13 +1135,19 @@
(t/is (= 2 (count res)))) (t/is (= 2 (count res))))
;; run the task again ;; run the task again
(let [res (th/run-task! "file-gc" {:min-age 0})] (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
;; check that the unknown frame thumbnail is deleted ;; check that the unknown frame thumbnail is deleted
(let [res (th/db-exec! ["select * from file_tagged_object_thumbnail"])] (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
(t/is (= 1 (count res))))))) (t/is (= 2 (count rows)))
(t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
(t/is (= 1 (count rows)))))))
(t/deftest file-thumbnail-ops (t/deftest file-thumbnail-ops
(let [prof (th/create-profile* 1 {:is-active true}) (let [prof (th/create-profile* 1 {:is-active true})
@ -1155,12 +1192,19 @@
(t/testing "gc task" (t/testing "gc task"
;; make the file eligible for GC waiting 300ms (configured ;; make the file eligible for GC waiting 300ms (configured
;; timeout for testing) ;; timeout for testing)
(th/sleep 300) (let [res (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(let [res (th/run-task! "file-gc" {:min-age 0})] (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 {:min-age 0})]
(t/is (= 1 (:processed res)))) (t/is (= 1 (:processed res))))
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})] (let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
(t/is (= 1 (count rows))))))) (t/is (= 1 (count rows)))))))

55
backend/test/backend_tests/rpc_file_thumbnails_test.clj
View file

@ -6,6 +6,7 @@
(ns backend-tests.rpc-file-thumbnails-test (ns backend-tests.rpc-file-thumbnails-test
(:require (:require
[app.common.pprint :as pp]
[app.common.thumbnails :as thc] [app.common.thumbnails :as thc]
[app.common.types.shape :as cts] [app.common.types.shape :as cts]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
@ -114,9 +115,12 @@
;; Run the File GC task that should remove unused file object ;; Run the File GC task that should remove unused file object
;; thumbnails ;; thumbnails
(let [result (th/run-task! :file-gc {:min-age (dt/duration 0)})] (let [result (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed result)))) (t/is (= 1 (:processed result))))
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed result))))
;; check if row2 related thumbnail row still exists ;; check if row2 related thumbnail row still exists
(let [[row :as rows] (th/db-query :file-tagged-object-thumbnail (let [[row :as rows] (th/db-query :file-tagged-object-thumbnail
{:file-id (:id file)} {:file-id (:id file)}
@ -141,7 +145,7 @@
;; Run the storage gc deleted task, it should permanently delete ;; Run the storage gc deleted task, it should permanently delete
;; all storage objects related to the deleted thumbnails ;; all storage objects related to the deleted thumbnails
(let [result (th/run-task! :storage-gc-deleted {:min-age (dt/duration 0)})] (let [result (th/run-task! :storage-gc-deleted {:min-age 0})]
(t/is (= 1 (:deleted result)))) (t/is (= 1 (:deleted result))))
(t/is (nil? (sto/get-object storage (:media-id row1)))) (t/is (nil? (sto/get-object storage (:media-id row1))))
@ -188,13 +192,12 @@
(let [[row1 row2 :as rows] (th/db-query :file-thumbnail (let [[row1 row2 :as rows] (th/db-query :file-thumbnail
{:file-id (:id file)} {:file-id (:id file)}
{:order-by [[:created-at :asc]]})] {:order-by [[:revn :asc]]})]
(t/is (= 2 (count rows))) (t/is (= 2 (count rows)))
(t/is (= (:file-id data1) (:file-id row1))) (t/is (= (:file-id data1) (:file-id row1)))
(t/is (= (:revn data1) (:revn row1))) (t/is (= (:revn data1) (:revn row1)))
(t/is (uuid? (:media-id row1))) (t/is (uuid? (:media-id row1)))
(t/is (= (:file-id data2) (:file-id row2))) (t/is (= (:file-id data2) (:file-id row2)))
(t/is (= (:revn data2) (:revn row2))) (t/is (= (:revn data2) (:revn row2)))
(t/is (uuid? (:media-id row2))) (t/is (uuid? (:media-id row2)))
@ -215,7 +218,10 @@
;; Run the File GC task that should remove unused file object ;; Run the File GC task that should remove unused file object
;; thumbnails ;; thumbnails
(let [result (th/run-task! :file-gc {:min-age (dt/duration 0)})] (let [result (th/run-task! :file-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result)))) (t/is (= 1 (:processed result))))
;; check if row1 related thumbnail row still exists ;; check if row1 related thumbnail row still exists
@ -227,6 +233,9 @@
(t/is (= (:object-id data1) (:object-id row))) (t/is (= (:object-id data1) (:object-id row)))
(t/is (uuid? (:media-id row1)))) (t/is (uuid? (:media-id row1))))
(let [result (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 1 (:delete result))))
;; Check if storage objects still exists after file-gc ;; Check if storage objects still exists after file-gc
(t/is (nil? (sto/get-object storage (:media-id row1)))) (t/is (nil? (sto/get-object storage (:media-id row1))))
(t/is (some? (sto/get-object storage (:media-id row2)))) (t/is (some? (sto/get-object storage (:media-id row2))))
@ -236,10 +245,42 @@
;; Run the storage gc deleted task, it should permanently delete ;; Run the storage gc deleted task, it should permanently delete
;; all storage objects related to the deleted thumbnails ;; all storage objects related to the deleted thumbnails
(let [result (th/run-task! :storage-gc-deleted {:min-age (dt/duration 0)})] (let [result (th/run-task! :storage-gc-deleted {:min-age 0})]
(t/is (= 1 (:deleted result)))) (t/is (= 1 (:deleted result))))
(t/is (some? (sto/get-object storage (:media-id row2))))))) (t/is (some? (sto/get-object storage (:media-id row2))))
)))
(t/deftest error-on-direct-storage-obj-deletion
(let [storage (::sto/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
:revn 3})
data1 {::th/type :create-file-thumbnail
::rpc/profile-id (:id profile)
:file-id (:id file)
:revn 2
:media {:filename "sample.jpg"
:size 7923
:path (th/tempfile "backend_tests/test_files/sample2.jpg")
:mtype "image/jpeg"}}]
(let [out (th/command! data1)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (contains? (:result out) :uri)))
(let [[row1 :as rows] (th/db-query :file-thumbnail {:file-id (:id file)})]
(t/is (= 1 (count rows)))
(t/is (thrown? org.postgresql.util.PSQLException
(th/db-delete! :storage-object {:id (:media-id row1)}))))))
(t/deftest get-file-object-thumbnail (t/deftest get-file-object-thumbnail
(let [storage (::sto/storage th/*system*) (let [storage (::sto/storage th/*system*)

189
backend/test/backend_tests/rpc_font_test.clj
View file

@ -92,3 +92,192 @@
:font-family :font-family
:font-weight :font-weight
:font-style)))) :font-style))))
(t/deftest font-deletion-1
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
font-id (uuid/custom 10 1)
data1 (-> (io/resource "backend_tests/test_files/font-1.woff")
io/input-stream
io/read-as-bytes)
data2 (-> (io/resource "backend_tests/test_files/font-2.woff")
io/input-stream
io/read-as-bytes)]
;; Create front variant
(let [params {::th/type :create-font-variant
::rpc/profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 400
:font-style "normal"
:data {"font/woff" data1}}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out))))
(let [params {::th/type :create-font-variant
::rpc/profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 500
:font-style "normal"
:data {"font/woff" data2}}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 6 (:freeze res))))
(let [params {::th/type :delete-font
::rpc/profile-id (:id prof)
:team-id team-id
:id font-id}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 6 (:freeze res)))
(t/is (= 0 (:delete res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed res))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 0 (:freeze res)))
(t/is (= 6 (:delete res))))
))
(t/deftest font-deletion-2
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
font-id (uuid/custom 10 1)
data1 (-> (io/resource "backend_tests/test_files/font-1.woff")
io/input-stream
io/read-as-bytes)
data2 (-> (io/resource "backend_tests/test_files/font-2.woff")
io/input-stream
io/read-as-bytes)]
;; Create front variant
(let [params {::th/type :create-font-variant
::rpc/profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 400
:font-style "normal"
:data {"font/woff" data1}}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out))))
(let [params {::th/type :create-font-variant
::rpc/profile-id (:id prof)
:team-id team-id
:font-id (uuid/custom 10 2)
:font-family "somefont"
:font-weight 400
:font-style "normal"
:data {"font/woff" data2}}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 6 (:freeze res))))
(let [params {::th/type :delete-font
::rpc/profile-id (:id prof)
:team-id team-id
:id font-id}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 3 (:freeze res)))
(t/is (= 0 (:delete res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 0 (:freeze res)))
(t/is (= 3 (:delete res))))
))
(t/deftest font-deletion-3
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
font-id (uuid/custom 10 1)
data1 (-> (io/resource "backend_tests/test_files/font-1.woff")
io/input-stream
io/read-as-bytes)
data2 (-> (io/resource "backend_tests/test_files/font-2.woff")
io/input-stream
io/read-as-bytes)
params1 {::th/type :create-font-variant
::rpc/profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 400
:font-style "normal"
:data {"font/woff" data1}}
params2 {::th/type :create-font-variant
::rpc/profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 500
:font-style "normal"
:data {"font/woff" data2}}
out1 (th/command! params1)
out2 (th/command! params2)]
;; (th/print-result! out1)
(t/is (nil? (:error out1)))
(t/is (nil? (:error out2)))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 6 (:freeze res))))
(let [params {::th/type :delete-font-variant
::rpc/profile-id (:id prof)
:team-id team-id
:id (-> out1 :result :id)}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (nil? (:result out))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 3 (:freeze res)))
(t/is (= 0 (:delete res))))
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
(t/is (= 0 (:freeze res)))
(t/is (= 3 (:delete res))))
))

76
backend/test/backend_tests/rpc_profile_test.clj
View file

@ -125,7 +125,7 @@
;; profile is not deleted because it does not meet all ;; profile is not deleted because it does not meet all
;; conditions to be deleted. ;; conditions to be deleted.
(let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})] (let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 0 (:processed result)))) (t/is (= 0 (:processed result))))
;; Request profile to be deleted ;; Request profile to be deleted
@ -144,8 +144,16 @@
(t/is (= 1 (count (:result out))))) (t/is (= 1 (count (:result out)))))
;; execute permanent deletion task ;; execute permanent deletion task
(let [result (th/run-task! :objects-gc {:min-age (dt/duration "-1m")})] (let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 2 (:processed result)))) (t/is (= 1 (:processed result))))
(let [row (th/db-get :team
{:id (:default-team-id prof)}
{::db/remove-deleted? false})]
(t/is (nil? (:deleted-at row))))
(let [result (th/run-task! :orphan-teams-gc {:min-age 0})]
(t/is (= 1 (:processed result))))
(let [row (th/db-get :team (let [row (th/db-get :team
{:id (:default-team-id prof)} {:id (:default-team-id prof)}
@ -158,67 +166,9 @@
out (th/command! params)] out (th/command! params)]
;; (th/print-result! out) ;; (th/print-result! out)
(let [result (:result out)] (let [result (:result out)]
(t/is (= uuid/zero (:id result))))))) (t/is (= uuid/zero (:id result)))))
(t/deftest profile-immediate-deletion ))
(let [prof1 (th/create-profile* 1)
prof2 (th/create-profile* 2)
file (th/create-file* 1 {:profile-id (:id prof1)
:project-id (:default-project-id prof1)
:is-shared false})
team (th/create-team* 1 {:profile-id (:id prof1)})
_ (th/create-team-role* {:team-id (:id team)
:profile-id (:id prof2)
:role :admin})]
;; profile is not deleted because it does not meet all
;; conditions to be deleted.
(let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
(t/is (= 0 (:orphans result)))
(t/is (= 0 (:processed result))))
;; just delete the profile
(th/db-delete! :profile {:id (:id prof1)})
;; query files after profile deletion, expecting not found
(let [params {::th/type :get-project-files
::rpc/profile-id (:id prof1)
:project-id (:default-project-id prof1)}
out (th/command! params)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :not-found (:type edata)))))
;; the files and projects still exists on the database
(let [files (th/db-query :file {:project-id (:default-project-id prof1)})
projects (th/db-query :project {:team-id (:default-team-id prof1)})]
(t/is (= 1 (count files)))
(t/is (= 1 (count projects))))
;; execute the gc task
(let [result (th/run-task! :objects-gc {:min-age (dt/duration "-1m")})]
(t/is (= 1 (:processed result)))
(t/is (= 1 (:orphans result))))
;; Check the deletion flag on the default profile team
(let [row (th/db-get :team
{:id (:default-team-id prof1)}
{::db/remove-deleted? false})]
(t/is (dt/instant? (:deleted-at row))))
;; Check the deletion flag on the shared team
(let [row (th/db-get :team
{:id (:id team)}
{::db/remove-deleted? false})]
(t/is (nil? (:deleted-at row))))
;; Check the roles on the shared team
(let [rows (th/db-query :team-profile-rel {:team-id (:id team)})]
(t/is (= 1 (count rows)))
(t/is (= (:id prof2) (get-in rows [0 :profile-id])))
(t/is (= false (get-in rows [0 :is-owner]))))))
(t/deftest registration-domain-whitelist (t/deftest registration-domain-whitelist
(let [whitelist #{"gmail.com" "hey.com" "ya.ru"}] (let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]

10
backend/test/backend_tests/rpc_project_test.clj
View file

@ -172,14 +172,13 @@
(t/deftest test-deletion (t/deftest test-deletion
(let [task (:app.tasks.objects-gc/handler th/*system*) (let [profile1 (th/create-profile* 1)
profile1 (th/create-profile* 1)
project (th/create-project* 1 {:team-id (:default-team-id profile1) project (th/create-project* 1 {:team-id (:default-team-id profile1)
:profile-id (:id profile1)})] :profile-id (:id profile1)})]
;; project is not deleted because it does not meet all ;; project is not deleted because it does not meet all
;; conditions to be deleted. ;; conditions to be deleted.
(let [result (task {:min-age (dt/duration 0)})] (let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 0 (:processed result)))) (t/is (= 0 (:processed result))))
;; query the list of projects ;; query the list of projects
@ -187,6 +186,7 @@
::rpc/profile-id (:id profile1) ::rpc/profile-id (:id profile1)
:team-id (:default-team-id profile1)} :team-id (:default-team-id profile1)}
out (th/command! data)] out (th/command! data)]
;; (th/print-result! out) ;; (th/print-result! out)
(t/is (nil? (:error out))) (t/is (nil? (:error out)))
(let [result (:result out)] (let [result (:result out)]
@ -210,7 +210,7 @@
(t/is (= 1 (count result))))) (t/is (= 1 (count result)))))
;; run permanent deletion (should be noop) ;; run permanent deletion (should be noop)
(let [result (task {:min-age (dt/duration {:minutes 1})})] (let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
(t/is (= 0 (:processed result)))) (t/is (= 0 (:processed result))))
;; query the list of files of a after soft deletion ;; query the list of files of a after soft deletion
@ -224,7 +224,7 @@
(t/is (= 0 (count result))))) (t/is (= 0 (count result)))))
;; run permanent deletion ;; run permanent deletion
(let [result (task {:min-age (dt/duration 0)})] (let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed result)))) (t/is (= 1 (:processed result))))
;; query the list of files of a after hard deletion ;; query the list of files of a after hard deletion

186
backend/test/backend_tests/rpc_team_test.clj
View file

@ -269,76 +269,6 @@
(t/is (= 1 (count members))) (t/is (= 1 (count members)))
(t/is (true? (-> members first :can-edit)))))))) (t/is (true? (-> members first :can-edit))))))))
(t/deftest team-deletion
(let [profile1 (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile1)})
pool (:app.db/pool th/*system*)
data {::th/type :delete-team
::rpc/profile-id (:id profile1)
:team-id (:id team)}]
;; team is not deleted because it does not meet all
;; conditions to be deleted.
(let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
(t/is (= 0 (:processed result))))
;; query the list of teams
(let [data {::th/type :get-teams
::rpc/profile-id (:id profile1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
(t/is (= 2 (count result)))
(t/is (= (:id team) (get-in result [1 :id])))
(t/is (= (:default-team-id profile1) (get-in result [0 :id])))))
;; Request team to be deleted
(let [params {::th/type :delete-team
::rpc/profile-id (:id profile1)
:id (:id team)}
out (th/command! params)]
(t/is (th/success? out)))
;; query the list of teams after soft deletion
(let [data {::th/type :get-teams
::rpc/profile-id (:id profile1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
(t/is (= 1 (count result)))
(t/is (= (:default-team-id profile1) (get-in result [0 :id])))))
;; run permanent deletion (should be noop)
(let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
(t/is (= 0 (:processed result))))
;; query the list of projects after hard deletion
(let [data {::th/type :get-projects
::rpc/profile-id (:id profile1)
:team-id (:id team)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :not-found (:type edata)))))
;; run permanent deletion
(let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
(t/is (= 1 (:processed result))))
;; query the list of projects of a after hard deletion
(let [data {::th/type :get-projects
::rpc/profile-id (:id profile1)
:team-id (:id team)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :not-found (:type edata)))))))
(t/deftest query-team-invitations (t/deftest query-team-invitations
(let [prof (th/create-profile* 1 {:is-active true}) (let [prof (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id prof)}) team (th/create-team* 1 {:profile-id (:id prof)})
@ -418,3 +348,119 @@
(t/is (th/success? out)) (t/is (th/success? out))
(t/is (nil? (:result out))) (t/is (nil? (:result out)))
(t/is (nil? res))))) (t/is (nil? res)))))
(t/deftest team-deletion-1
(let [profile1 (th/create-profile* 1 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile1)})
pool (:app.db/pool th/*system*)
data {::th/type :delete-team
::rpc/profile-id (:id profile1)
:team-id (:id team)}]
;; team is not deleted because it does not meet all
;; conditions to be deleted.
(let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
(t/is (= 0 (:processed result))))
;; query the list of teams
(let [data {::th/type :get-teams
::rpc/profile-id (:id profile1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
(t/is (= 2 (count result)))
(t/is (= (:id team) (get-in result [1 :id])))
(t/is (= (:default-team-id profile1) (get-in result [0 :id])))))
;; Request team to be deleted
(let [params {::th/type :delete-team
::rpc/profile-id (:id profile1)
:id (:id team)}
out (th/command! params)]
(t/is (th/success? out)))
;; query the list of teams after soft deletion
(let [data {::th/type :get-teams
::rpc/profile-id (:id profile1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
(t/is (= 1 (count result)))
(t/is (= (:default-team-id profile1) (get-in result [0 :id])))))
;; run permanent deletion (should be noop)
(let [result (th/run-task! :objects-gc {:min-age (dt/duration {:minutes 1})})]
(t/is (= 0 (:processed result))))
;; query the list of projects after hard deletion
(let [data {::th/type :get-projects
::rpc/profile-id (:id profile1)
:team-id (:id team)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :not-found (:type edata)))))
;; run permanent deletion
(let [result (th/run-task! :objects-gc {:min-age (dt/duration 0)})]
(t/is (= 2 (:processed result))))
;; query the list of projects of a after hard deletion
(let [data {::th/type :get-projects
::rpc/profile-id (:id profile1)
:team-id (:id team)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :not-found (:type edata)))))))
(t/deftest team-deletion-2
(let [storage (-> (:app.storage/storage th/*system*)
(assoc ::sto/backend :assets-fs))
prof (th/create-profile* 1)
team (th/create-team* 1 {:profile-id (:id prof)})
proj (th/create-project* 1 {:profile-id (:id prof)
:team-id (:id team)})
file (th/create-file* 1 {:profile-id (:id prof)
:project-id (:default-project-id team)
:is-shared false})
mfile {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}]
(let [params {::th/type :upload-file-media-object
::rpc/profile-id (:id prof)
:file-id (:id file)
:is-local true
:name "testfile"
:content mfile}
out (th/command! params)]
(t/is (nil? (:error out))))
(let [params {::th/type :delete-team
::rpc/profile-id (:id prof)
:id (:id team)}
out (th/command! params)]
#_(th/print-result! out)
(t/is (nil? (:error out))))
(let [rows (th/db-exec! ["select * from team where id = ?" (:id team)])]
(t/is (= 1 (count rows)))
(t/is (dt/instant? (:deleted-at (first rows)))))
(let [result (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 5 (:processed result))))
))

64
backend/test/backend_tests/storage_test.clj
View file

@ -113,7 +113,7 @@
(let [res (th/run-task! :storage-gc-deleted {})] (let [res (th/run-task! :storage-gc-deleted {})]
(t/is (= 1 (:deleted res)))) (t/is (= 1 (:deleted res))))
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object;"])] (let [res (th/db-exec-one! ["select count(*) from storage_object;"])]
(t/is (= 2 (:count res)))))) (t/is (= 2 (:count res))))))
(t/deftest test-touched-gc-task-1 (t/deftest test-touched-gc-task-1
@ -156,29 +156,33 @@
(t/is (= (:media-id result-1) (:media-id result-2))) (t/is (= (:media-id result-1) (:media-id result-2)))
;; now we proceed to manually delete one file-media-object (th/db-update! :file-media-object
(db/exec-one! th/*pool* ["delete from file_media_object where id = ?" (:id result-1)]) {:deleted-at (dt/now)}
{:id (:id result-1)})
;; run the objects gc task for permanent deletion
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
;; check that we still have all the storage objects ;; check that we still have all the storage objects
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object"])] (let [res (th/db-exec-one! ["select count(*) from storage_object"])]
(t/is (= 2 (:count res)))) (t/is (= 2 (:count res))))
;; now check if the storage objects are touched ;; now check if the storage objects are touched
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object where touched_at is not null"])] (let [res (th/db-exec-one! ["select count(*) from storage_object where touched_at is not null"])]
(t/is (= 2 (:count res)))) (t/is (= 2 (:count res))))
;; run the touched gc task ;; run the touched gc task
(let [task (:app.storage/gc-touched-task th/*system*) (let [res (th/run-task! :storage-gc-touched {})]
res (task {})]
(t/is (= 2 (:freeze res))) (t/is (= 2 (:freeze res)))
(t/is (= 0 (:delete res)))) (t/is (= 0 (:delete res))))
;; now check that there are no touched objects ;; now check that there are no touched objects
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object where touched_at is not null"])] (let [res (th/db-exec-one! ["select count(*) from storage_object where touched_at is not null"])]
(t/is (= 0 (:count res)))) (t/is (= 0 (:count res))))
;; now check that all objects are marked to be deleted ;; now check that all objects are marked to be deleted
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object where deleted_at is not null"])] (let [res (th/db-exec-one! ["select count(*) from storage_object where deleted_at is not null"])]
(t/is (= 0 (:count res))))))) (t/is (= 0 (:count res)))))))
@ -231,31 +235,35 @@
(t/is (nil? (:error out2))) (t/is (nil? (:error out2)))
;; run the touched gc task ;; run the touched gc task
(let [task (:app.storage/gc-touched-task th/*system*) (let [res (th/run-task! :storage-gc-touched {})]
res (task {})]
(t/is (= 5 (:freeze res))) (t/is (= 5 (:freeze res)))
(t/is (= 0 (:delete res))) (t/is (= 0 (:delete res)))
(let [result-1 (:result out1) (let [result-1 (:result out1)
result-2 (:result out2)] result-2 (:result out2)]
;; now we proceed to manually delete one team-font-variant (th/db-update! :team-font-variant
(db/exec-one! th/*pool* ["delete from team_font_variant where id = ?" (:id result-2)]) {:deleted-at (dt/now)}
{:id (:id result-2)})
;; run the objects gc task for permanent deletion
(let [res (th/run-task! :objects-gc {:min-age 0})]
(t/is (= 1 (:processed res))))
;; revert touched state to all storage objects ;; revert touched state to all storage objects
(db/exec-one! th/*pool* ["update storage_object set touched_at=now()"]) (th/db-exec-one! ["update storage_object set touched_at=now()"])
;; Run the task again ;; Run the task again
(let [res (task {})] (let [res (th/run-task! :storage-gc-touched {})]
(t/is (= 2 (:freeze res))) (t/is (= 2 (:freeze res)))
(t/is (= 3 (:delete res)))) (t/is (= 3 (:delete res))))
;; now check that there are no touched objects ;; now check that there are no touched objects
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object where touched_at is not null"])] (let [res (th/db-exec-one! ["select count(*) from storage_object where touched_at is not null"])]
(t/is (= 0 (:count res)))) (t/is (= 0 (:count res))))
;; now check that all objects are marked to be deleted ;; now check that all objects are marked to be deleted
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object where deleted_at is not null"])] (let [res (th/db-exec-one! ["select count(*) from storage_object where deleted_at is not null"])]
(t/is (= 3 (:count res)))))))) (t/is (= 3 (:count res))))))))
(t/deftest test-touched-gc-task-3 (t/deftest test-touched-gc-task-3
@ -289,28 +297,28 @@
result-2 (:result out2)] result-2 (:result out2)]
;; now we proceed to manually mark all storage objects touched ;; now we proceed to manually mark all storage objects touched
(db/exec-one! th/*pool* ["update storage_object set touched_at=now()"]) (th/db-exec! ["update storage_object set touched_at=now()"])
;; run the touched gc task ;; run the touched gc task
(let [task (:app.storage/gc-touched-task th/*system*) (let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
res (task {})]
(t/is (= 2 (:freeze res))) (t/is (= 2 (:freeze res)))
(t/is (= 0 (:delete res)))) (t/is (= 0 (:delete res))))
;; check that we have all object in the db ;; check that we have all object in the db
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object where deleted_at is null"])] (let [rows (th/db-exec! ["select * from storage_object"])]
(t/is (= 2 (:count res))))) (t/is (= 2 (count rows)))))
;; now we proceed to manually delete all file_media_object ;; now we proceed to manually delete all file_media_object
(db/exec-one! th/*pool* ["delete from file_media_object"]) (th/db-exec! ["update file_media_object set deleted_at = now()"])
(let [res (th/run-task! "objects-gc" {:min-age 0})]
(t/is (= 2 (:processed res))))
;; run the touched gc task ;; run the touched gc task
(let [task (:app.storage/gc-touched-task th/*system*) (let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
res (task {})]
(t/is (= 0 (:freeze res))) (t/is (= 0 (:freeze res)))
(t/is (= 2 (:delete res)))) (t/is (= 2 (:delete res))))
;; check that we have all no objects ;; check that we have all no objects
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object where deleted_at is null"])] (let [rows (th/db-exec! ["select * from storage_object where deleted_at is null"])]
(t/is (= 0 (:count res)))))) (t/is (= 0 (count rows))))))