mirror of
https://github.com/penpot/penpot.git
synced 2025-04-01 17:41:50 -05:00
✨ Add safety mechanism for direct object deletion
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:
parent
e6fb96c4c2
commit
addb392ecc
37 changed files with 1918 additions and 1026 deletions
|
@ -341,6 +341,25 @@
|
|||
(-> (get-connectable ds)
|
||||
(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
|
||||
[ds table id & {:as opts}]
|
||||
(get ds table {:id id} opts))
|
||||
|
|
|
@ -133,7 +133,7 @@
|
|||
[_ {:keys [::db/pool] :as cfg}]
|
||||
(cond
|
||||
(db/read-only? pool)
|
||||
(l/warn :hint "audit: disabled (db is read-only)")
|
||||
(l/warn :hint "audit disabled (db is read-only)")
|
||||
|
||||
:else
|
||||
cfg))
|
||||
|
@ -187,8 +187,7 @@
|
|||
false)}))
|
||||
|
||||
(defn- handle-event!
|
||||
[conn-or-pool event]
|
||||
(us/verify! ::event event)
|
||||
[cfg event]
|
||||
(let [params {:id (uuid/next)
|
||||
:name (::name event)
|
||||
:type (::type event)
|
||||
|
@ -201,19 +200,22 @@
|
|||
;; NOTE: this operation may cause primary key conflicts on inserts
|
||||
;; because of the timestamp precission (two concurrent requests), in
|
||||
;; this case we just retry the operation.
|
||||
(rtry/with-retry {::rtry/when rtry/conflict-exception?
|
||||
::rtry/max-retries 6
|
||||
::rtry/label "persist-audit-log"
|
||||
::db/conn (dm/check db/connection? conn-or-pool)}
|
||||
(let [now (dt/now)]
|
||||
(db/insert! conn-or-pool :audit-log
|
||||
(-> params
|
||||
(update :props db/tjson)
|
||||
(update :context db/tjson)
|
||||
(update :ip-addr db/inet)
|
||||
(assoc :created-at now)
|
||||
(assoc :tracked-at now)
|
||||
(assoc :source "backend"))))))
|
||||
(let [cfg (-> cfg
|
||||
(assoc ::rtry/when rtry/conflict-exception?)
|
||||
(assoc ::rtry/max-retries 6)
|
||||
(assoc ::rtry/label "persist-audit-log"))
|
||||
params (-> params
|
||||
(update :props db/tjson)
|
||||
(update :context db/tjson)
|
||||
(update :ip-addr db/inet)
|
||||
(assoc :source "backend"))]
|
||||
|
||||
(rtry/invoke cfg (fn [cfg]
|
||||
(let [tnow (dt/now)
|
||||
params (-> params
|
||||
(assoc :created-at tnow)
|
||||
(assoc :tracked-at tnow))]
|
||||
(db/insert! cfg :audit-log params))))))
|
||||
|
||||
(when (and (contains? cf/flags :webhooks)
|
||||
(::webhooks/event? event))
|
||||
|
@ -226,7 +228,7 @@
|
|||
:else label)
|
||||
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/queue :webhooks
|
||||
::wrk/max-retries 0
|
||||
|
@ -243,12 +245,12 @@
|
|||
(defn submit!
|
||||
"Submit audit event to the collector."
|
||||
[cfg params]
|
||||
(let [conn (or (::db/conn cfg) (::db/pool cfg))]
|
||||
(us/assert! ::db/pool-or-conn conn)
|
||||
(try
|
||||
(handle-event! conn (d/without-nils params))
|
||||
(catch Throwable cause
|
||||
(l/error :hint "audit: unexpected error processing event" :cause cause)))))
|
||||
(try
|
||||
(let [event (d/without-nils params)]
|
||||
(us/verify! ::event event)
|
||||
(db/tx-run! cfg handle-event! event))
|
||||
(catch Throwable cause
|
||||
(l/error :hint "unexpected error processing event" :cause cause))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TASK: ARCHIVE
|
||||
|
|
|
@ -34,6 +34,8 @@
|
|||
[app.srepl :as-alias srepl]
|
||||
[app.storage :as-alias sto]
|
||||
[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.util.time :as dt]
|
||||
[app.worker :as-alias wrk]
|
||||
|
@ -202,11 +204,11 @@
|
|||
:app.storage.tmp/cleaner
|
||||
{::wrk/executor (ig/ref ::wrk/executor)}
|
||||
|
||||
::sto/gc-deleted-task
|
||||
::sto.gc-deleted/handler
|
||||
{::db/pool (ig/ref ::db/pool)
|
||||
::sto/storage (ig/ref ::sto/storage)}
|
||||
|
||||
::sto/gc-touched-task
|
||||
::sto.gc-touched/handler
|
||||
{::db/pool (ig/ref ::db/pool)}
|
||||
|
||||
::http.client/client
|
||||
|
@ -337,12 +339,13 @@
|
|||
::wrk/tasks
|
||||
{:sendmail (ig/ref ::email/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-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)
|
||||
: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)
|
||||
:audit-log-archive (ig/ref ::audit.tasks/archive)
|
||||
:audit-log-gc (ig/ref ::audit.tasks/gc)
|
||||
|
@ -373,6 +376,9 @@
|
|||
{::db/pool (ig/ref ::db/pool)
|
||||
::sto/storage (ig/ref ::sto/storage)}
|
||||
|
||||
:app.tasks.orphan-teams-gc/handler
|
||||
{::db/pool (ig/ref ::db/pool)}
|
||||
|
||||
:app.tasks.file-gc/handler
|
||||
{::db/pool (ig/ref ::db/pool)
|
||||
::sto/storage (ig/ref ::sto/storage)}
|
||||
|
@ -458,6 +464,9 @@
|
|||
{:cron #app/cron "0 0 0 * * ?" ;; daily
|
||||
:task :objects-gc}
|
||||
|
||||
{:cron #app/cron "0 0 0 * * ?" ;; daily
|
||||
:task :orphan-teams-gc}
|
||||
|
||||
{:cron #app/cron "0 0 0 * * ?" ;; daily
|
||||
:task :storage-gc-deleted}
|
||||
|
||||
|
|
|
@ -337,7 +337,40 @@
|
|||
:fn (mg/resource "app/migrations/sql/0106-mod-team-table.sql")}
|
||||
|
||||
{: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!
|
||||
[pool name migrations]
|
||||
|
|
|
@ -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;
|
|
@ -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();
|
|
@ -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();
|
|
@ -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();
|
|
@ -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
15
backend/src/app/migrations/sql/0112-mod-profile-table.sql
Normal 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();
|
||||
|
|
@ -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
10
backend/src/app/migrations/sql/0114-mod-team-table.sql
Normal 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;
|
|
@ -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
3
backend/src/app/migrations/sql/0116-mod-file-table.sql
Normal file
|
@ -0,0 +1,3 @@
|
|||
ALTER TABLE file
|
||||
DROP CONSTRAINT file_project_id_fkey,
|
||||
ADD FOREIGN KEY (project_id) REFERENCES project(id) DEFERRABLE;
|
|
@ -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;
|
|
@ -54,7 +54,9 @@
|
|||
:hint "the current account does not have password")
|
||||
(let [result (profile/verify-password cfg password (:password profile))]
|
||||
(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)))
|
||||
(:valid result))))
|
||||
|
||||
|
|
|
@ -309,23 +309,21 @@
|
|||
::quotes/project-id project-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
|
||||
[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
|
||||
;; operation can be retried on conflict, and in this case the new seq shold be
|
||||
;; retrieved from the database.
|
||||
|
|
|
@ -516,7 +516,7 @@
|
|||
ft.media_id
|
||||
from file as f
|
||||
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
|
||||
and f.deleted_at is null
|
||||
and p.deleted_at is null
|
||||
|
|
|
@ -27,6 +27,7 @@
|
|||
[app.rpc.commands.teams :as teams]
|
||||
[app.rpc.cond :as-alias cond]
|
||||
[app.rpc.doc :as-alias doc]
|
||||
[app.rpc.retry :as rtry]
|
||||
[app.storage :as sto]
|
||||
[app.util.pointer-map :as pmap]
|
||||
[app.util.services :as sv]
|
||||
|
@ -46,7 +47,7 @@
|
|||
(let [sql (str/concat
|
||||
"select object_id, media_id, tag "
|
||||
" 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
|
||||
(d/index-by :object-id (fn [row]
|
||||
|
@ -58,7 +59,7 @@
|
|||
(let [sql (str/concat
|
||||
"select object_id, media_id, tag "
|
||||
" from file_tagged_object_thumbnail"
|
||||
" where file_id=?")
|
||||
" where file_id=? and deleted_at is null")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
(->> res
|
||||
(d/index-by :object-id (fn [row]
|
||||
|
@ -69,7 +70,7 @@
|
|||
(let [sql (str/concat
|
||||
"select object_id, media_id, tag "
|
||||
" 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))
|
||||
res (db/exec! conn [sql file-id ids])]
|
||||
|
||||
|
@ -226,34 +227,54 @@
|
|||
;; MUTATION COMMANDS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; --- 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 *;")
|
||||
;; MUTATION COMMAND: create-file-object-thumbnail
|
||||
|
||||
(defn- create-file-object-thumbnail!
|
||||
[{: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)
|
||||
hash (sto/calculate-hash path)
|
||||
data (-> (sto/content path)
|
||||
(sto/wrap-with-hash hash))
|
||||
tnow (dt/now)
|
||||
|
||||
media (sto/put-object! storage
|
||||
{::sto/content data
|
||||
::sto/deduplicate? true
|
||||
::sto/touched-at (dt/now)
|
||||
::sto/touched-at tnow
|
||||
:content-type mtype
|
||||
:bucket "file-object-thumbnail"})]
|
||||
|
||||
(db/exec-one! conn [sql:create-object-thumbnail file-id object-id
|
||||
(:id media) tag (:id media)])))
|
||||
(if (some? thumb)
|
||||
(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"}
|
||||
[:file-id ::sm/uuid]
|
||||
[:object-id :string]
|
||||
|
@ -268,32 +289,37 @@
|
|||
::audit/skip true
|
||||
::sm/params schema:create-file-object-thumbnail}
|
||||
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id object-id media tag]}]
|
||||
(db/with-atomic [conn pool]
|
||||
(files/check-edition-permissions! conn profile-id file-id)
|
||||
(media/validate-media-type! media)
|
||||
(media/validate-media-size! media)
|
||||
[cfg {:keys [::rpc/profile-id file-id object-id media tag]}]
|
||||
(db/tx-run! cfg
|
||||
(fn [{:keys [::db/conn] :as cfg}]
|
||||
(files/check-edition-permissions! conn profile-id file-id)
|
||||
(media/validate-media-type! media)
|
||||
(media/validate-media-size! media)
|
||||
|
||||
(when-not (db/read-only? conn)
|
||||
(-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage)
|
||||
(assoc ::db/conn conn)
|
||||
(create-file-object-thumbnail! file-id object-id media (or tag "frame"))))))
|
||||
(when-not (db/read-only? conn)
|
||||
(let [cfg (-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage)
|
||||
(assoc ::rtry/when rtry/conflict-exception?)
|
||||
(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
|
||||
|
||||
(defn- delete-file-object-thumbnail!
|
||||
[{:keys [::db/conn ::sto/storage]} file-id object-id]
|
||||
(when-let [{:keys [media-id]} (db/get* conn :file-tagged-object-thumbnail
|
||||
{:file-id file-id
|
||||
:object-id object-id}
|
||||
{::db/for-update? true})]
|
||||
|
||||
(when-let [{:keys [media-id tag]} (db/get* conn :file-tagged-object-thumbnail
|
||||
{:file-id file-id
|
||||
:object-id object-id}
|
||||
{::db/for-update? true})]
|
||||
(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
|
||||
:object-id object-id})
|
||||
nil))
|
||||
:object-id object-id
|
||||
:tag tag}
|
||||
{::db/return-keys? false})))
|
||||
|
||||
(s/def ::delete-file-object-thumbnail
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
|
@ -302,29 +328,21 @@
|
|||
(sv/defmethod ::delete-file-object-thumbnail
|
||||
{::doc/added "1.19"
|
||||
::doc/module :files
|
||||
::doc/deprecated "1.20"
|
||||
::climit/id :file-thumbnail-ops
|
||||
::climit/key-fn ::rpc/profile-id
|
||||
::audit/skip true}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id object-id]}]
|
||||
|
||||
(db/with-atomic [conn pool]
|
||||
(files/check-edition-permissions! conn profile-id file-id)
|
||||
|
||||
(when-not (db/read-only? conn)
|
||||
(-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage)
|
||||
(assoc ::db/conn conn)
|
||||
(delete-file-object-thumbnail! file-id object-id))
|
||||
nil)))
|
||||
[cfg {:keys [::rpc/profile-id file-id object-id]}]
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
(files/check-edition-permissions! conn profile-id file-id)
|
||||
(when-not (db/read-only? conn)
|
||||
(-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage conn)
|
||||
(delete-file-object-thumbnail! file-id object-id))
|
||||
nil))))
|
||||
|
||||
;; --- 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!
|
||||
[{:keys [::db/conn ::sto/storage]} {:keys [file-id revn props media] :as params}]
|
||||
(media/validate-media-type! media)
|
||||
|
@ -336,14 +354,42 @@
|
|||
hash (sto/calculate-hash path)
|
||||
data (-> (sto/content path)
|
||||
(sto/wrap-with-hash hash))
|
||||
tnow (dt/now)
|
||||
media (sto/put-object! storage
|
||||
{::sto/content data
|
||||
::sto/deduplicate? false
|
||||
::sto/deduplicate? true
|
||||
::sto/touched-at tnow
|
||||
:content-type mtype
|
||||
:bucket "file-thumbnail"})]
|
||||
(db/exec-one! conn [sql:create-file-thumbnail file-id revn
|
||||
(:id media) props
|
||||
(:id media) props])
|
||||
:bucket "file-thumbnail"})
|
||||
|
||||
thumb (db/get* conn :file-thumbnail
|
||||
{: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))
|
||||
|
||||
(sv/defmethod ::create-file-thumbnail
|
||||
|
@ -359,13 +405,14 @@
|
|||
[:revn :int]
|
||||
[:media ::media/upload]]}
|
||||
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
|
||||
(db/with-atomic [conn pool]
|
||||
(files/check-edition-permissions! conn profile-id file-id)
|
||||
(when-not (db/read-only? conn)
|
||||
(let [media (-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage)
|
||||
(assoc ::db/conn conn)
|
||||
(create-file-thumbnail! params))]
|
||||
|
||||
{:uri (files/resolve-public-uri (:id media))}))))
|
||||
[cfg {:keys [::rpc/profile-id file-id] :as params}]
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
(files/check-edition-permissions! conn profile-id file-id)
|
||||
(when-not (db/read-only? conn)
|
||||
(let [cfg (-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage)
|
||||
(assoc ::rtry/when rtry/conflict-exception?)
|
||||
(assoc ::rtry/max-retries 5)
|
||||
(assoc ::rtry/label "create-thumbnail"))
|
||||
media (rtry/invoke cfg create-file-thumbnail! params)]
|
||||
{:uri (files/resolve-public-uri (:id media))})))))
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.spec :as us]
|
||||
[app.common.schema :as sm]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.db :as db]
|
||||
[app.loggers.audit :as-alias audit]
|
||||
|
@ -25,39 +25,27 @@
|
|||
[app.storage :as sto]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as-alias wrk]
|
||||
[clojure.spec.alpha :as s]))
|
||||
[app.worker :as-alias wrk]))
|
||||
|
||||
(def valid-weight #{100 200 300 400 500 600 700 800 900 950})
|
||||
(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
|
||||
|
||||
(s/def ::get-font-variants
|
||||
(s/and
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:opt-un [::team-id
|
||||
::file-id
|
||||
::project-id
|
||||
::share-id])
|
||||
(fn [o]
|
||||
(or (contains? o :team-id)
|
||||
(contains? o :file-id)
|
||||
(contains? o :project-id)))))
|
||||
(def ^:private
|
||||
schema:get-font-variants
|
||||
[:schema {:title "get-font-variants"}
|
||||
[:and
|
||||
[:map
|
||||
[:team-id {:optional true} ::sm/uuid]
|
||||
[:file-id {:optional true} ::sm/uuid]
|
||||
[:project-id {:optional true} ::sm/uuid]
|
||||
[:share-id {:optional true} ::sm/uuid]]
|
||||
[::sm/contains-any #{:team-id :file-id :project-id}]]])
|
||||
|
||||
(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}]
|
||||
(dm/with-open [conn (db/open pool)]
|
||||
(cond
|
||||
|
@ -87,28 +75,31 @@
|
|||
|
||||
(declare create-font-variant)
|
||||
|
||||
(s/def ::create-font-variant
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id
|
||||
::data
|
||||
::font-id
|
||||
::font-family
|
||||
::font-weight
|
||||
::font-style]))
|
||||
(def ^:private schema:create-font-variant
|
||||
[:map {:title "create-font-variant"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:data [:map-of :string :any]]
|
||||
[:font-id ::sm/uuid]
|
||||
[:font-family :string]
|
||||
[:font-weight [::sm/one-of {:format "number"} valid-weight]]
|
||||
[:font-style [::sm/one-of {:format "string"} valid-style]]])
|
||||
|
||||
(sv/defmethod ::create-font-variant
|
||||
{::doc/added "1.18"
|
||||
::webhooks/event? true}
|
||||
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
|
||||
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
|
||||
(teams/check-edition-permissions! pool profile-id team-id)
|
||||
(quotes/check-quote! pool {::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))))
|
||||
::webhooks/event? true
|
||||
::sm/params schema:create-font-variant}
|
||||
[cfg {:keys [::rpc/profile-id team-id] :as params}]
|
||||
(db/tx-run! cfg
|
||||
(fn [{:keys [::db/conn] :as cfg}]
|
||||
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
|
||||
(teams/check-edition-permissions! conn profile-id team-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
|
||||
[{: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]
|
||||
(let [data (media/run {:cmd :generate-fonts :input data})]
|
||||
(when (and (not (contains? data "font/otf"))
|
||||
|
@ -136,6 +127,7 @@
|
|||
ttf-params (prepare-font data "font/ttf")
|
||||
wf1-params (prepare-font data "font/woff")
|
||||
wf2-params (prepare-font data "font/woff2")]
|
||||
|
||||
(cond-> {}
|
||||
(some? otf-params)
|
||||
(assoc :otf (sto/put-object! storage otf-params))
|
||||
|
@ -147,7 +139,7 @@
|
|||
(assoc :woff2 (sto/put-object! storage wf2-params)))))
|
||||
|
||||
(insert-font-variant! [{:keys [woff1 woff2 otf ttf]}]
|
||||
(db/insert! pool :team-font-variant
|
||||
(db/insert! conn :team-font-variant
|
||||
{:id (uuid/next)
|
||||
:team-id (:team-id params)
|
||||
:font-id (:font-id params)
|
||||
|
@ -168,63 +160,109 @@
|
|||
|
||||
;; --- UPDATE FONT FAMILY
|
||||
|
||||
(s/def ::update-font
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::id ::name]))
|
||||
(def ^:private
|
||||
schema:update-font
|
||||
[:map {:title "update-font"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:id ::sm/uuid]
|
||||
[:name :string]])
|
||||
|
||||
(sv/defmethod ::update-font
|
||||
{::doc/added "1.18"
|
||||
::webhooks/event? true}
|
||||
[{:keys [::db/pool]} {:keys [::rpc/profile-id team-id id name]}]
|
||||
(db/with-atomic [conn pool]
|
||||
(teams/check-edition-permissions! conn profile-id team-id)
|
||||
(rph/with-meta
|
||||
(db/update! conn :team-font-variant
|
||||
{:font-family name}
|
||||
{:font-id id
|
||||
:team-id team-id})
|
||||
{::audit/replace-props {:id id
|
||||
:name name
|
||||
:team-id team-id
|
||||
:profile-id profile-id}})))
|
||||
::webhooks/event? true
|
||||
::sm/params schema:update-font}
|
||||
[cfg {:keys [::rpc/profile-id team-id id name]}]
|
||||
(db/tx-run! cfg
|
||||
(fn [{:keys [::db/conn]}]
|
||||
(teams/check-edition-permissions! conn profile-id team-id)
|
||||
|
||||
(db/update! conn :team-font-variant
|
||||
{:font-family name}
|
||||
{:font-id id
|
||||
:team-id team-id}
|
||||
{::db/return-keys? false})
|
||||
|
||||
(rph/with-meta (rph/wrap nil)
|
||||
{::audit/replace-props {:id id
|
||||
:name name
|
||||
:team-id team-id
|
||||
:profile-id profile-id}}))))
|
||||
|
||||
;; --- DELETE FONT
|
||||
|
||||
(s/def ::delete-font
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::id]))
|
||||
(def ^:private
|
||||
schema:delete-font
|
||||
[:map {:title "delete-font"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:id ::sm/uuid]])
|
||||
|
||||
(sv/defmethod ::delete-font
|
||||
{::doc/added "1.18"
|
||||
::webhooks/event? true}
|
||||
[{:keys [::db/pool]} {:keys [::rpc/profile-id id team-id]}]
|
||||
(db/with-atomic [conn pool]
|
||||
(teams/check-edition-permissions! conn profile-id team-id)
|
||||
(let [font (db/update! conn :team-font-variant
|
||||
{:deleted-at (dt/now)}
|
||||
{:font-id id :team-id team-id})]
|
||||
(rph/with-meta (rph/wrap)
|
||||
{::audit/props {:id id
|
||||
:team-id team-id
|
||||
:name (:font-family font)
|
||||
:profile-id profile-id}}))))
|
||||
::webhooks/event? true
|
||||
::sm/params schema:delete-font}
|
||||
[cfg {:keys [::rpc/profile-id id team-id]}]
|
||||
|
||||
(db/tx-run! cfg
|
||||
(fn [{:keys [::db/conn ::sto/storage] :as cfg}]
|
||||
(teams/check-edition-permissions! conn profile-id team-id)
|
||||
(let [fonts (db/query conn :team-font-variant
|
||||
{:team-id team-id
|
||||
:font-id id
|
||||
:deleted-at nil}
|
||||
{::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
|
||||
|
||||
(s/def ::delete-font-variant
|
||||
(s/keys :req [::rpc/profile-id]
|
||||
:req-un [::team-id ::id]))
|
||||
(def ^:private schema:delete-font-variant
|
||||
[:map {:title "delete-font-variant"}
|
||||
[:team-id ::sm/uuid]
|
||||
[:id ::sm/uuid]])
|
||||
|
||||
(sv/defmethod ::delete-font-variant
|
||||
{::doc/added "1.18"
|
||||
::webhooks/event? true}
|
||||
[{:keys [::db/pool]} {:keys [::rpc/profile-id id team-id]}]
|
||||
(db/with-atomic [conn pool]
|
||||
(teams/check-edition-permissions! conn profile-id team-id)
|
||||
(let [variant (db/update! conn :team-font-variant
|
||||
{:deleted-at (dt/now)}
|
||||
{:id id :team-id team-id})]
|
||||
(rph/with-meta (rph/wrap)
|
||||
{::audit/props {:font-family (:font-family variant)
|
||||
:font-id (:font-id variant)}}))))
|
||||
::webhooks/event? true
|
||||
::sm/params schema:delete-font-variant}
|
||||
[cfg {:keys [::rpc/profile-id id team-id]}]
|
||||
(db/tx-run! cfg
|
||||
(fn [{:keys [::db/conn ::sto/storage] :as cfg}]
|
||||
(teams/check-edition-permissions! conn profile-id team-id)
|
||||
(let [variant (db/get conn :team-font-variant
|
||||
{:id id :team-id team-id}
|
||||
{::db/for-update? true})
|
||||
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)}})))))
|
||||
|
|
|
@ -23,6 +23,7 @@
|
|||
[app.storage :as sto]
|
||||
[app.storage.tmp :as tmp]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as-alias wrk]
|
||||
[clojure.spec.alpha :as s]
|
||||
[cuerdas.core :as str]
|
||||
|
@ -153,6 +154,12 @@
|
|||
thumb (when-let [params (::thumb result)]
|
||||
(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
|
||||
(or id (uuid/next))
|
||||
file-id is-local name
|
||||
|
|
|
@ -18,46 +18,47 @@
|
|||
(and (instance? PSQLException e)
|
||||
(= "23505" (.getSQLState ^PSQLException e))))
|
||||
|
||||
(def ^:private always-false (constantly false))
|
||||
(def ^:private always-false
|
||||
(constantly false))
|
||||
|
||||
(defn wrap-retry
|
||||
[_ f {:keys [::matches ::sv/name] :or {matches always-false} :as mdata}]
|
||||
[_ f {:keys [::sv/name] :as mdata}]
|
||||
|
||||
(when (::enabled mdata)
|
||||
(l/debug :hint "wrapping retry" :name name))
|
||||
|
||||
(if-let [max-retries (::max-retries mdata)]
|
||||
(fn [cfg params]
|
||||
((fn run [retry]
|
||||
(try
|
||||
(f cfg params)
|
||||
(catch Throwable cause
|
||||
(if (matches cause)
|
||||
(let [current-retry (inc retry)]
|
||||
(l/trace :hint "running retry algorithm" :retry current-retry)
|
||||
(if (<= current-retry max-retries)
|
||||
(run current-retry)
|
||||
(throw cause)))
|
||||
(throw cause))))) 1))
|
||||
(if (::enabled mdata)
|
||||
(let [max-retries (get mdata ::max-retries 3)
|
||||
matches? (get mdata ::when always-false)]
|
||||
(l/dbg :hint "wrapping retry" :name name :max-retries max-retries)
|
||||
(fn [cfg params]
|
||||
((fn recursive-invoke [retry]
|
||||
(try
|
||||
(f cfg params)
|
||||
(catch Throwable cause
|
||||
(if (matches? cause)
|
||||
(let [current-retry (inc retry)]
|
||||
(l/wrn :hint "retrying operation" :retry current-retry :service name)
|
||||
(if (<= current-retry max-retries)
|
||||
(recursive-invoke current-retry)
|
||||
(throw cause)))
|
||||
(throw cause))))) 1)))
|
||||
f))
|
||||
|
||||
(defmacro with-retry
|
||||
[{:keys [::when ::max-retries ::label ::db/conn] :or {max-retries 3}} & body]
|
||||
`(let [conn# ~conn]
|
||||
(assert (or (nil? conn#) (db/connection? conn#)) "invalid database connection")
|
||||
(loop [tnum# 1]
|
||||
(let [result# (let [sp# (some-> conn# db/savepoint)]
|
||||
(try
|
||||
(let [result# (do ~@body)]
|
||||
(some->> sp# (db/release! conn#))
|
||||
result#)
|
||||
(catch Throwable cause#
|
||||
(some->> sp# (db/rollback! conn#))
|
||||
(if (and (~when cause#) (<= tnum# ~max-retries))
|
||||
::retry
|
||||
(throw cause#)))))]
|
||||
(if (= ::retry result#)
|
||||
(do
|
||||
(l/warn :hint "retrying operation" :label ~label :retry tnum#)
|
||||
(recur (inc tnum#)))
|
||||
result#)))))
|
||||
(defn invoke
|
||||
[{:keys [::db/conn ::max-retries] :or {max-retries 3} :as cfg} f & args]
|
||||
(assert (db/connection? conn) "invalid database connection")
|
||||
(loop [rnum 1]
|
||||
(let [match? (get cfg ::when always-false)
|
||||
result (let [spoint (db/savepoint conn)]
|
||||
(try
|
||||
(let [result (apply f cfg args)]
|
||||
(db/release! conn spoint)
|
||||
result)
|
||||
(catch Throwable cause
|
||||
(db/rollback! conn spoint)
|
||||
(if (and (match? cause) (<= rnum max-retries))
|
||||
::retry
|
||||
(throw cause)))))]
|
||||
(if (= ::retry result)
|
||||
(let [label (get cfg ::label "anonymous")]
|
||||
(l/warn :hint "retrying operation" :label label :retry rnum)
|
||||
(recur (inc rnum)))
|
||||
result))))
|
||||
|
|
|
@ -9,8 +9,6 @@
|
|||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.logging :as l]
|
||||
[app.common.spec :as us]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.db :as db]
|
||||
|
@ -228,225 +226,3 @@
|
|||
|
||||
(dm/export impl/resolve-backend)
|
||||
(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
128
backend/src/app/storage/gc_deleted.clj
Normal 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
208
backend/src/app/storage/gc_touched.clj
Normal 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,7 +9,7 @@
|
|||
(:require
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.db :as-alias db]
|
||||
[app.db :as db]
|
||||
[app.storage :as-alias sto]
|
||||
[buddy.core.codecs :as bc]
|
||||
[buddy.core.hash :as bh]
|
||||
|
@ -22,6 +22,13 @@
|
|||
java.nio.file.Path
|
||||
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
|
||||
|
||||
(defmulti put-object (fn [cfg _ _] (::sto/type cfg)))
|
||||
|
|
|
@ -10,7 +10,6 @@
|
|||
file is eligible to be garbage collected after some period of
|
||||
inactivity (the default threshold is 72h)."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.files.migrations :as pmg]
|
||||
[app.common.logging :as l]
|
||||
[app.common.thumbnails :as thc]
|
||||
|
@ -30,7 +29,7 @@
|
|||
[integrant.core :as ig]))
|
||||
|
||||
(declare ^:private get-candidates)
|
||||
(declare ^:private process-file)
|
||||
(declare ^:private clean-file!)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; HANDLER
|
||||
|
@ -44,67 +43,61 @@
|
|||
(assoc cfg ::min-age cf/deletion-delay))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [::db/pool] :as cfg}]
|
||||
[_ cfg]
|
||||
(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]
|
||||
(let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
|
||||
cfg (-> cfg
|
||||
(update ::sto/storage media/configure-assets-storage conn)
|
||||
(assoc ::db/conn conn)
|
||||
(assoc ::file-id file-id)
|
||||
(assoc ::min-age min-age))
|
||||
total (reduce (fn [total file]
|
||||
(clean-file! cfg file)
|
||||
(inc total))
|
||||
0
|
||||
(get-candidates cfg))]
|
||||
|
||||
total (reduce (fn [total file]
|
||||
(process-file cfg file)
|
||||
(inc total))
|
||||
0
|
||||
(get-candidates cfg))]
|
||||
(l/inf :hint "task finished"
|
||||
:min-age (dt/format-duration min-age)
|
||||
:processed total)
|
||||
|
||||
(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
|
||||
(when (:rollback? params)
|
||||
(db/rollback! conn))
|
||||
|
||||
{:processed total}))))
|
||||
{:processed total})))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; IMPL
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def ^:private
|
||||
sql:get-candidates-chunk
|
||||
"select f.id,
|
||||
sql:get-candidates
|
||||
"SELECT f.id,
|
||||
f.data,
|
||||
f.revn,
|
||||
f.features,
|
||||
f.modified_at
|
||||
from file as f
|
||||
where f.has_media_trimmed is false
|
||||
and f.modified_at < now() - ?::interval
|
||||
and f.modified_at < ?
|
||||
order by f.modified_at desc
|
||||
limit 1
|
||||
for update skip locked")
|
||||
FROM file AS f
|
||||
WHERE f.has_media_trimmed IS false
|
||||
AND f.modified_at < now() - ?::interval
|
||||
ORDER BY f.modified_at DESC
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- get-candidates
|
||||
[{:keys [::db/conn ::min-age ::file-id]}]
|
||||
(if (uuid? file-id)
|
||||
(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})
|
||||
(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
|
||||
:vf second
|
||||
:kf first
|
||||
:initk (dt/now)))))
|
||||
(let [min-age (db/interval min-age)]
|
||||
(->> (db/cursor conn [sql:get-candidates min-age] {:chunk-size 1})
|
||||
(map #(update % :features db/decode-pgarray #{}))))))
|
||||
|
||||
(defn collect-used-media
|
||||
"Given a fdata (file data), returns all media references."
|
||||
|
@ -134,101 +127,93 @@
|
|||
(into xform pages)
|
||||
(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!
|
||||
"Performs the garbage collection of file media objects."
|
||||
[conn file-id data]
|
||||
(let [used (collect-used-media data)
|
||||
unused (->> (db/query conn :file-media-object {:file-id file-id})
|
||||
(remove #(contains? used (:id %))))]
|
||||
ids (db/create-array conn "uuid" used)
|
||||
unused (->> (db/exec! conn [sql:mark-file-media-object-deleted file-id ids])
|
||||
(into #{} (map :id)))]
|
||||
|
||||
(doseq [mobj unused]
|
||||
(l/dbg :hint "delete file media object"
|
||||
:id (:id mobj)
|
||||
:media-id (:media-id mobj)
|
||||
:thumbnail-id (:thumbnail-id mobj))
|
||||
(doseq [id unused]
|
||||
(l/trc :hint "mark deleted"
|
||||
:rel "file-media-object"
|
||||
:id (str id)
|
||||
:file-id (str file-id)))
|
||||
|
||||
;; NOTE: deleting the file-media-object in the database
|
||||
;; 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
|
||||
;; them.
|
||||
(db/delete! conn :file-media-object {:id (:id mobj)}))))
|
||||
(count unused)))
|
||||
|
||||
|
||||
(def ^:private sql:mark-file-object-thumbnails-deleted
|
||||
"UPDATE file_tagged_object_thumbnail
|
||||
SET deleted_at = now()
|
||||
WHERE file_id = ? AND object_id != ALL(?::text[])
|
||||
RETURNING object_id")
|
||||
|
||||
(defn- clean-file-object-thumbnails!
|
||||
[{:keys [::db/conn ::sto/storage]} file-id data]
|
||||
(let [stored (->> (db/query conn :file-tagged-object-thumbnail
|
||||
{:file-id file-id}
|
||||
{:columns [:object-id]})
|
||||
(into #{} (map :object-id)))
|
||||
[{:keys [::db/conn]} file-id data]
|
||||
(let [using (->> (vals (:pages-index data))
|
||||
(into #{} (comp
|
||||
(mapcat (fn [{:keys [id objects]}]
|
||||
(->> (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 #{}
|
||||
(comp
|
||||
(mapcat (fn [{:keys [id objects]}]
|
||||
(->> (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")))))
|
||||
ids (db/create-array conn "text" using)
|
||||
unused (->> (db/exec! conn [sql:mark-file-object-thumbnails-deleted file-id ids])
|
||||
(into #{} (map :object-id)))]
|
||||
|
||||
(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"
|
||||
:file-id (str file-id)
|
||||
:total (count res))
|
||||
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
;; 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))))))
|
||||
(def ^:private sql:mark-file-thumbnails-deleted
|
||||
"UPDATE file_thumbnail
|
||||
SET deleted_at = now()
|
||||
WHERE file_id = ? AND revn < ?
|
||||
RETURNING revn")
|
||||
|
||||
(defn- clean-file-thumbnails!
|
||||
[{:keys [::db/conn ::sto/storage]} file-id revn]
|
||||
(let [sql (str "delete from file_thumbnail "
|
||||
" where file_id=? and revn < ? "
|
||||
" returning media_id")
|
||||
res (db/exec! conn [sql file-id revn])]
|
||||
[{:keys [::db/conn]} file-id revn]
|
||||
(let [unused (->> (db/exec! conn [sql:mark-file-thumbnails-deleted file-id revn])
|
||||
(into #{} (map :revn)))]
|
||||
|
||||
(when (seq res)
|
||||
(l/dbg :hint "delete file thumbnails"
|
||||
:file-id (str file-id)
|
||||
:total (count res))
|
||||
(doseq [revn unused]
|
||||
(l/trc :hint "mark deleted"
|
||||
:rel "file-thumbnail"
|
||||
:revn revn
|
||||
:file-id (str file-id)))
|
||||
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
;; 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)))))
|
||||
(count unused)))
|
||||
|
||||
(def ^:private
|
||||
sql:get-files-for-library
|
||||
"select f.data, f.modified_at
|
||||
from file as f
|
||||
left join file_library_rel as fl on (fl.file_id = f.id)
|
||||
where fl.library_file_id = ?
|
||||
and f.modified_at < ?
|
||||
and f.deleted_at is null
|
||||
order by f.modified_at desc
|
||||
limit 1")
|
||||
|
||||
(def ^:private sql:get-files-for-library
|
||||
"SELECT f.id, f.data, f.modified_at
|
||||
FROM file AS f
|
||||
LEFT JOIN file_library_rel AS fl ON (fl.file_id = f.id)
|
||||
WHERE fl.library_file_id = ?
|
||||
AND f.deleted_at IS null
|
||||
ORDER BY f.modified_at ASC")
|
||||
|
||||
(defn- clean-deleted-components!
|
||||
"Performs the garbage collection of unreferenced deleted components."
|
||||
[conn file-id data]
|
||||
(letfn [(get-files-chunk [cursor]
|
||||
(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]
|
||||
[{:keys [::db/conn] :as cfg} file-id data]
|
||||
(letfn [(get-used-components [fdata components]
|
||||
;; Find which of the components are used in the file.
|
||||
(into #{}
|
||||
(filter #(ctf/used-in? fdata file-id % :component))
|
||||
|
@ -246,69 +231,91 @@
|
|||
files-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)
|
||||
(get-unused-components deleted)
|
||||
(mapv :id))]
|
||||
|
||||
(when (seq unused)
|
||||
(l/dbg :hint "clean deleted components" :total (count unused))
|
||||
(doseq [id 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
|
||||
{:data (blob/encode data)}
|
||||
{:id file-id}))))))
|
||||
|
||||
(when-let [data (some->> (seq unused)
|
||||
(reduce ctkl/delete-component data)
|
||||
(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!
|
||||
[conn file-id data]
|
||||
(letfn [(get-pointers-chunk [cursor]
|
||||
(let [sql (str "select id, data, created_at "
|
||||
" from file_change "
|
||||
" where file_id = ? "
|
||||
" and data is not null "
|
||||
" 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 (->> (db/cursor conn [sql:get-changes file-id])
|
||||
(into (feat.fdata/get-used-pointer-ids data)
|
||||
(comp (map :data)
|
||||
(map blob/decode)
|
||||
(mapcat feat.fdata/get-used-pointer-ids))))
|
||||
|
||||
(let [used (into (feat.fdata/get-used-pointer-ids data)
|
||||
(d/iteration get-pointers-chunk
|
||||
:vf second
|
||||
:kf first
|
||||
:initk (dt/now)))
|
||||
unused (let [ids (db/create-array conn "uuid" used)]
|
||||
(->> (db/exec! conn [sql:mark-deleted-data-fragments file-id ids])
|
||||
(into #{} (map :id))))]
|
||||
|
||||
sql (str "select id from file_data_fragment "
|
||||
" where file_id = ? AND id != ALL(?::uuid[])")
|
||||
used (db/create-array conn "uuid" used)
|
||||
rows (db/exec! conn [sql file-id used])]
|
||||
(doseq [id unused]
|
||||
(l/trc :hint "mark deleted"
|
||||
:rel "file-data-fragment"
|
||||
:id (str id)
|
||||
:file-id (str file-id)))
|
||||
|
||||
(doseq [fragment-id (map :id rows)]
|
||||
(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})))))
|
||||
(count unused)))
|
||||
|
||||
(defn- process-file
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id data revn modified-at features] :as file}]
|
||||
(l/dbg :hint "processing file" :file-id (str id) :modified-at modified-at)
|
||||
|
||||
(defn- clean-file!
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id data revn modified-at] :as file}]
|
||||
|
||||
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
|
||||
pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [data (-> (blob/decode data)
|
||||
(assoc :id id)
|
||||
(pmg/migrate-data))]
|
||||
(pmg/migrate-data))
|
||||
|
||||
(clean-file-media! conn id data)
|
||||
(clean-file-object-thumbnails! cfg id data)
|
||||
(clean-file-thumbnails! cfg id revn)
|
||||
(clean-deleted-components! conn id data)
|
||||
nfm (clean-file-media! conn id data)
|
||||
nfot (clean-file-object-thumbnails! cfg id data)
|
||||
nft (clean-file-thumbnails! cfg id revn)
|
||||
nc (clean-deleted-components! cfg id data)
|
||||
ndf (clean-data-fragments! conn id data)]
|
||||
|
||||
(when (contains? features "fdata/pointer-map")
|
||||
(clean-data-fragments! conn id data))
|
||||
(l/dbg :hint "file clened"
|
||||
: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
|
||||
(db/update! conn :file
|
||||
{:has-media-trimmed true}
|
||||
{:id id})
|
||||
{:id id}
|
||||
{::db/return-keys? false})
|
||||
|
||||
(feat.fdata/persist-pointers! cfg id))))
|
||||
|
|
|
@ -8,7 +8,6 @@
|
|||
"A maintenance task that performs a general purpose garbage collection
|
||||
of deleted or unreachable objects."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.logging :as l]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
|
@ -18,12 +17,15 @@
|
|||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]))
|
||||
|
||||
(declare ^:private delete-profiles!)
|
||||
(declare ^:private delete-teams!)
|
||||
(declare ^:private delete-fonts!)
|
||||
(declare ^:private delete-projects!)
|
||||
(declare ^:private delete-file-data-fragments!)
|
||||
(declare ^:private delete-file-media-objects!)
|
||||
(declare ^:private delete-file-object-thumbnails!)
|
||||
(declare ^:private delete-file-thumbnails!)
|
||||
(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 [_]
|
||||
(s/keys :req [::db/pool ::sto/storage]))
|
||||
|
@ -33,211 +35,320 @@
|
|||
(assoc cfg ::min-age cf/deletion-delay))
|
||||
|
||||
(defmethod ig/init-key ::handler
|
||||
[_ {:keys [::db/pool ::sto/storage] :as cfg}]
|
||||
[_ cfg]
|
||||
(fn [params]
|
||||
(db/with-atomic [conn pool]
|
||||
(let [min-age (or (:min-age params) (::min-age cfg))
|
||||
_ (l/info :hint "gc started"
|
||||
:min-age (dt/format-duration min-age)
|
||||
:rollback? (boolean (:rollback? params)))
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
;; Disable deletion protection for the current transaction
|
||||
(db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"])
|
||||
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
|
||||
|
||||
storage (media/configure-assets-storage storage conn)
|
||||
cfg (-> cfg
|
||||
(assoc ::min-age (db/interval min-age))
|
||||
(assoc ::conn conn)
|
||||
(assoc ::storage storage))
|
||||
(let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
|
||||
cfg (-> cfg
|
||||
(assoc ::min-age (db/interval min-age))
|
||||
(update ::sto/storage media/configure-assets-storage conn))
|
||||
|
||||
htotal (+ (delete-profiles! cfg)
|
||||
(delete-teams! cfg)
|
||||
(delete-projects! cfg)
|
||||
(delete-files! cfg)
|
||||
(delete-fonts! cfg))
|
||||
stotal (delete-orphan-teams! cfg)]
|
||||
total (reduce + 0
|
||||
[(delete-profiles! cfg)
|
||||
(delete-teams! cfg)
|
||||
(delete-fonts! cfg)
|
||||
(delete-projects! 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"
|
||||
:deleted htotal
|
||||
:orphans stotal
|
||||
:rollback? (boolean (:rollback? params)))
|
||||
(l/info :hint "task finished"
|
||||
:deleted total
|
||||
:rollback? (boolean (:rollback? params)))
|
||||
|
||||
(when (:rollback? params)
|
||||
(db/rollback! conn))
|
||||
(when (:rollback? params)
|
||||
(db/rollback! conn))
|
||||
|
||||
{:processed (+ stotal htotal)
|
||||
:orphans stotal}))))
|
||||
{:processed total})))))
|
||||
|
||||
(def ^:private sql:get-profiles-chunk
|
||||
"select id, photo_id, created_at from profile
|
||||
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")
|
||||
(def ^:private sql:get-profiles
|
||||
"SELECT id, photo_id FROM profile
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-profiles!
|
||||
[{:keys [::conn ::min-age ::storage] :as cfg}]
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [rows (db/exec! conn [sql:get-profiles-chunk min-age cursor])]
|
||||
[(some->> rows peek :created-at) rows]))
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-profiles min-age])
|
||||
(reduce (fn [total {:keys [id photo-id]}]
|
||||
(l/trc :hint "permanently delete" :rel "profile" :id (str id))
|
||||
|
||||
(process-profile [total {:keys [id photo-id]}]
|
||||
(l/debug :hint "permanently delete profile" :id (str id))
|
||||
;; Mark as deleted the storage object
|
||||
(some->> photo-id (sto/touch-object! storage))
|
||||
|
||||
;; Mark as deleted the storage object related with the
|
||||
;; photo-id field.
|
||||
(some->> photo-id (sto/touch-object! storage))
|
||||
;; And finally, permanently delete the profile. The
|
||||
;; relevant objects will be deleted using DELETE
|
||||
;; 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.
|
||||
(db/delete! conn :profile {:id id})
|
||||
(inc total))
|
||||
0)))
|
||||
|
||||
(inc total))]
|
||||
|
||||
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now))
|
||||
(reduce process-profile 0))))
|
||||
|
||||
(def ^:private sql:get-teams-chunk
|
||||
"select id, photo_id, created_at from team
|
||||
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")
|
||||
(def ^:private sql:get-teams
|
||||
"SELECT deleted_at, id, photo_id FROM team
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-teams!
|
||||
[{:keys [::conn ::min-age ::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]))
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
|
||||
(process-team [total {:keys [id photo-id]}]
|
||||
(l/debug :hint "permanently delete team" :id (str id))
|
||||
(->> (db/cursor conn [sql:get-teams min-age])
|
||||
(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
|
||||
;; photo-id field.
|
||||
(some->> photo-id (sto/touch-object! storage))
|
||||
;; Mark as deleted the storage object
|
||||
(some->> photo-id (sto/touch-object! storage))
|
||||
|
||||
;; And finally, permanently delete the team.
|
||||
(db/delete! conn :team {:id id})
|
||||
;; And finally, permanently delete the team.
|
||||
(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))
|
||||
(reduce process-team 0))))
|
||||
(db/update! conn :project
|
||||
{:deleted-at deleted-at}
|
||||
{:team-id id}
|
||||
{::db/return-keys? false})
|
||||
|
||||
(def ^:private sql:get-orphan-teams-chunk
|
||||
"select t.id, t.created_at
|
||||
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;")
|
||||
(inc total))
|
||||
0)))
|
||||
|
||||
(defn- delete-orphan-teams!
|
||||
"Find all orphan teams (with no members and mark them for
|
||||
deletion (soft delete)."
|
||||
[{:keys [::conn] :as cfg}]
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [rows (db/exec! conn [sql:get-orphan-teams-chunk cursor])]
|
||||
[(some->> rows peek :created-at) rows]))
|
||||
|
||||
(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")
|
||||
(def ^:private sql:get-fonts
|
||||
"SELECT id, team_id, deleted_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
|
||||
ORDER BY deleted_at ASC
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-fonts!
|
||||
[{:keys [::conn ::min-age ::storage] :as cfg}]
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [rows (db/exec! conn [sql:get-fonts-chunk min-age cursor])]
|
||||
[(some->> rows peek :created-at) rows]))
|
||||
[{:keys [::db/conn ::min-age ::sto/storage] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-fonts min-age])
|
||||
(reduce (fn [total {:keys [id team-id deleted-at] :as font}]
|
||||
(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}]
|
||||
(l/debug :hint "permanently delete font variant" :id (str id))
|
||||
;; Mark as deleted the all related storage objects
|
||||
(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
|
||||
(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))
|
||||
;; And finally, permanently delete the team font variant
|
||||
(db/delete! conn :team-font-variant
|
||||
{:id id}
|
||||
{::db/return-keys? false})
|
||||
|
||||
;; And finally, permanently delete the team font variant
|
||||
(db/delete! conn :team-font-variant {:id id})
|
||||
(inc total))
|
||||
0)))
|
||||
|
||||
(inc total))]
|
||||
|
||||
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now))
|
||||
(reduce process-font 0))))
|
||||
|
||||
(def ^:private sql:get-projects-chunk
|
||||
"select id, created_at
|
||||
from project
|
||||
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")
|
||||
(def ^:private sql:get-projects
|
||||
"SELECT id, deleted_at, team_id
|
||||
FROM project
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-projects!
|
||||
[{:keys [::conn ::min-age] :as cfg}]
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [rows (db/exec! conn [sql:get-projects-chunk min-age cursor])]
|
||||
[(some->> rows peek :created-at) rows]))
|
||||
[{:keys [::db/conn ::min-age] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-projects min-age])
|
||||
(reduce (fn [total {:keys [id team-id deleted-at]}]
|
||||
(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]}]
|
||||
(l/debug :hint "permanently delete project" :id (str id))
|
||||
;; And finally, permanently delete the project.
|
||||
(db/delete! conn :project {:id id})
|
||||
;; Mark files to be deleted
|
||||
(db/update! conn :file
|
||||
{:deleted-at deleted-at}
|
||||
{:project-id id}
|
||||
{::db/return-keys? false})
|
||||
|
||||
(inc total))]
|
||||
(inc total))
|
||||
0)))
|
||||
|
||||
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now))
|
||||
(reduce process-project 0))))
|
||||
|
||||
(def ^:private sql:get-files-chunk
|
||||
"select id, created_at
|
||||
from file
|
||||
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")
|
||||
(def ^:private sql:get-files
|
||||
"SELECT id, deleted_at, project_id
|
||||
FROM file
|
||||
WHERE deleted_at IS NOT NULL
|
||||
AND deleted_at < now() - ?::interval
|
||||
ORDER BY deleted_at ASC
|
||||
FOR UPDATE
|
||||
SKIP LOCKED")
|
||||
|
||||
(defn- delete-files!
|
||||
[{:keys [::conn ::min-age] :as cfg}]
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [rows (db/exec! conn [sql:get-files-chunk min-age cursor])]
|
||||
[(some->> rows peek :created-at) rows]))
|
||||
[{:keys [::db/conn ::min-age] :as cfg}]
|
||||
(->> (db/cursor conn [sql:get-files min-age])
|
||||
(reduce (fn [total {:keys [id deleted-at project-id]}]
|
||||
(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]}]
|
||||
(l/debug :hint "permanently delete file" :id (str id))
|
||||
;; And finally, permanently delete the file.
|
||||
(db/delete! conn :file {:id id})
|
||||
(inc total))]
|
||||
;; And finally, permanently delete the file.
|
||||
(db/delete! conn :file
|
||||
{:id id}
|
||||
{::db/return-keys? false})
|
||||
|
||||
(->> (d/iteration get-chunk :vf second :kf first :initk (dt/now))
|
||||
(reduce process-file 0))))
|
||||
;; Mark file media objects to be deleted
|
||||
(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
60
backend/src/app/tasks/orphan_teams_gc.clj
Normal 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)))
|
|
@ -175,12 +175,11 @@
|
|||
" WHERE table_schema = 'public' "
|
||||
" AND table_name != 'migrations';")]
|
||||
(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])
|
||||
(map :table-name)
|
||||
(remove #(= "task" %)))
|
||||
sql (str "TRUNCATE "
|
||||
(apply str (interpose ", " result))
|
||||
" CASCADE;")]
|
||||
(remove #(= "task" %)))]
|
||||
(doseq [table result]
|
||||
(db/exec! conn [(str "delete from " table ";")]))))
|
||||
|
||||
|
@ -433,11 +432,11 @@
|
|||
(us/pretty-explain data))
|
||||
|
||||
(= :params-validation (:code data))
|
||||
(app.common.pprint/pprint
|
||||
(println
|
||||
(sm/humanize-explain (::sm/explain data)))
|
||||
|
||||
(= :data-validation (:code data))
|
||||
(app.common.pprint/pprint
|
||||
(println
|
||||
(sm/humanize-explain (::sm/explain data)))
|
||||
|
||||
(= :service-error (:type data))
|
||||
|
@ -512,6 +511,10 @@
|
|||
[sql]
|
||||
(db/exec! *pool* sql))
|
||||
|
||||
(defn db-exec-one!
|
||||
[sql]
|
||||
(db/exec-one! *pool* sql))
|
||||
|
||||
(defn db-delete!
|
||||
[& params]
|
||||
(apply db/delete! *pool* params))
|
||||
|
|
|
@ -149,7 +149,7 @@
|
|||
shape-id (uuid/random)]
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; Check the number of fragments before adding the page
|
||||
|
@ -175,7 +175,7 @@
|
|||
(t/is (= 2 (count rows))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
|
||||
|
@ -203,7 +203,7 @@
|
|||
(t/is (= 3 (count rows))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; Check the number of fragments; should be 3 because changes
|
||||
|
@ -220,12 +220,23 @@
|
|||
|
||||
;; The file-gc should remove fragments related to changes
|
||||
;; 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))))
|
||||
|
||||
;; Check the number of fragments;
|
||||
(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
|
||||
(letfn [(add-file-media-object [& {:keys [profile-id file-id]}]
|
||||
|
@ -301,17 +312,16 @@
|
|||
;; freeze because of the deduplication (we have uploaded 2 times
|
||||
;; the same files).
|
||||
|
||||
(let [task (:app.storage/gc-touched-task th/*system*)
|
||||
res (task {:min-age (dt/duration 0)})]
|
||||
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
|
||||
(t/is (= 2 (:freeze res)))
|
||||
(t/is (= 0 (:delete res))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; retrieve file and check trimmed attribute
|
||||
|
@ -319,8 +329,17 @@
|
|||
(t/is (true? (:has-media-trimmed row))))
|
||||
|
||||
;; check file media objects
|
||||
(let [rows (th/db-exec! ["select * from file_media_object where file_id = ?" (:id file)])]
|
||||
(t/is (= 1 (count rows))))
|
||||
(let [rows (th/db-query :file-media-object {: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 (= 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.
|
||||
(t/is (some? (sto/get-object storage (:media-id fmo2))))
|
||||
|
@ -340,15 +359,16 @@
|
|||
;; Now, we have deleted the usage of pointers to the
|
||||
;; file-media-objects, if we paste file-gc, they should be marked
|
||||
;; as deleted.
|
||||
(let [task (:app.tasks.file-gc/handler th/*system*)
|
||||
res (task {:min-age (dt/duration 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))))
|
||||
|
||||
;; Now that file-gc have deleted the file-media-object usage,
|
||||
;; lets execute the touched-gc task, we should see that two of
|
||||
;; them are marked to be deleted.
|
||||
(let [task (:app.storage/gc-touched-task th/*system*)
|
||||
res (task {:min-age (dt/duration 0)})]
|
||||
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
|
||||
(t/is (= 0 (:freeze 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"}}]})}])
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; retrieve file and check trimmed attribute
|
||||
|
@ -494,15 +517,16 @@
|
|||
;; Now, we have deleted the usage of pointers to the
|
||||
;; file-media-objects, if we paste file-gc, they should be marked
|
||||
;; as deleted.
|
||||
(let [task (:app.tasks.file-gc/handler th/*system*)
|
||||
res (task {:min-age (dt/duration 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 (= 5 (:processed res))))
|
||||
|
||||
;; Now that file-gc have deleted the file-media-object usage,
|
||||
;; lets execute the touched-gc task, we should see that two of
|
||||
;; them are marked to be deleted.
|
||||
(let [task (:app.storage/gc-touched-task th/*system*)
|
||||
res (task {:min-age (dt/duration 0)})]
|
||||
(let [res (th/run-task! :storage-gc-touched {:min-age 0})]
|
||||
(t/is (= 0 (:freeze 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 fmo1)))))))
|
||||
|
||||
|
||||
(t/deftest file-gc-task-with-object-thumbnails
|
||||
(letfn [(insert-file-object-thumbnail! [& {:keys [profile-id file-id page-id frame-id]}]
|
||||
(let [object-id (thc/fmt-object-id file-id page-id frame-id "frame")
|
||||
|
@ -609,16 +632,16 @@
|
|||
;; because of the deduplication (we have uploaded 2 times the
|
||||
;; 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 (= 0 (:delete res))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; retrieve file and check trimmed attribute
|
||||
|
@ -648,22 +671,29 @@
|
|||
:page-id page-id
|
||||
: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))))
|
||||
|
||||
(let [rows (th/db-exec! ["select * from file_tagged_object_thumbnail where file_id = ?" file-id])]
|
||||
;; (pp/pprint rows)
|
||||
(t/is (= 1 (count rows)))
|
||||
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id file-id})]
|
||||
(t/is (= 2 (count rows)))
|
||||
(t/is (= 1 (count (remove (comp some? :deleted-at) rows))))
|
||||
|
||||
(t/is (= (thc/fmt-object-id file-id page-id frame-id-1 "frame")
|
||||
(-> rows 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
|
||||
(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))))
|
||||
|
||||
;; 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)
|
||||
(t/is (= 1 (count rows))))
|
||||
|
||||
|
@ -676,31 +706,32 @@
|
|||
:page-id page-id
|
||||
: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))))
|
||||
|
||||
(let [rows (th/db-exec! ["select * from file_tagged_object_thumbnail where file_id = ?" file-id])]
|
||||
(t/is (= 0 (count rows))))
|
||||
(let [rows (th/db-query :file-tagged-object-thumbnail {:file-id file-id})]
|
||||
(t/is (= 1 (count rows)))
|
||||
(t/is (= 0 (count (remove (comp some? :deleted-at) rows)))))
|
||||
|
||||
(let [res (th/run-task! :objects-gc {:min-age 0})]
|
||||
;; (pp/pprint res)
|
||||
(t/is (= 1 (:processed res))))
|
||||
|
||||
;; 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)
|
||||
(t/is (= 1 (count rows))))
|
||||
|
||||
;; Now that file-gc have deleted the object thumbnail lets
|
||||
;; 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))))
|
||||
|
||||
;; 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)
|
||||
(t/is (= 0 (count rows)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
(t/deftest permissions-checks-creating-file
|
||||
(let [profile1 (th/create-profile* 1)
|
||||
profile2 (th/create-profile* 2)
|
||||
|
@ -811,13 +842,12 @@
|
|||
(t/is (th/ex-of-type? error :not-found))))
|
||||
|
||||
(t/deftest deletion
|
||||
(let [task (:app.tasks.objects-gc/handler th/*system*)
|
||||
profile1 (th/create-profile* 1)
|
||||
(let [profile1 (th/create-profile* 1)
|
||||
file (th/create-file* 1 {:project-id (:default-project-id profile1)
|
||||
:profile-id (:id profile1)})]
|
||||
;; file is not deleted because it does not meet all
|
||||
;; conditions to be deleted.
|
||||
(let [result (task {:min-age (dt/duration 0)})]
|
||||
(let [result (th/run-task! :objects-gc {:min-age 0})]
|
||||
(t/is (= 0 (:processed result))))
|
||||
|
||||
;; query the list of files
|
||||
|
@ -848,7 +878,7 @@
|
|||
(t/is (= 0 (count result)))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; query the list of file libraries of a after hard deletion
|
||||
|
@ -862,7 +892,7 @@
|
|||
(t/is (= 0 (count result)))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; query the list of file libraries of a after hard deletion
|
||||
|
@ -874,7 +904,8 @@
|
|||
(let [error (:error out)
|
||||
error-data (ex-data 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
|
||||
|
@ -1075,7 +1106,7 @@
|
|||
(th/sleep 300)
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; check that object thumbnails are still here
|
||||
|
@ -1104,13 +1135,19 @@
|
|||
(t/is (= 2 (count res))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; check that the unknown frame thumbnail is deleted
|
||||
(let [res (th/db-exec! ["select * from file_tagged_object_thumbnail"])]
|
||||
(t/is (= 1 (count res)))))))
|
||||
(let [rows (th/db-query :file-tagged-object-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 (= 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
|
||||
(let [prof (th/create-profile* 1 {:is-active true})
|
||||
|
@ -1155,12 +1192,19 @@
|
|||
(t/testing "gc task"
|
||||
;; make the file eligible for GC waiting 300ms (configured
|
||||
;; 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))))
|
||||
|
||||
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
|
||||
(t/is (= 1 (count rows)))))))
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
|
@ -6,6 +6,7 @@
|
|||
|
||||
(ns backend-tests.rpc-file-thumbnails-test
|
||||
(:require
|
||||
[app.common.pprint :as pp]
|
||||
[app.common.thumbnails :as thc]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]
|
||||
|
@ -114,9 +115,12 @@
|
|||
|
||||
;; Run the File GC task that should remove unused file object
|
||||
;; 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 (= 2 (:processed result))))
|
||||
|
||||
;; check if row2 related thumbnail row still exists
|
||||
(let [[row :as rows] (th/db-query :file-tagged-object-thumbnail
|
||||
{:file-id (:id file)}
|
||||
|
@ -141,7 +145,7 @@
|
|||
|
||||
;; Run the storage gc deleted task, it should permanently delete
|
||||
;; 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 (nil? (sto/get-object storage (:media-id row1))))
|
||||
|
@ -188,13 +192,12 @@
|
|||
|
||||
(let [[row1 row2 :as rows] (th/db-query :file-thumbnail
|
||||
{:file-id (:id file)}
|
||||
{:order-by [[:created-at :asc]]})]
|
||||
{:order-by [[:revn :asc]]})]
|
||||
(t/is (= 2 (count rows)))
|
||||
|
||||
(t/is (= (:file-id data1) (:file-id row1)))
|
||||
(t/is (= (:revn data1) (:revn row1)))
|
||||
(t/is (uuid? (:media-id row1)))
|
||||
|
||||
(t/is (= (:file-id data2) (:file-id row2)))
|
||||
(t/is (= (:revn data2) (:revn row2)))
|
||||
(t/is (uuid? (:media-id row2)))
|
||||
|
@ -215,7 +218,10 @@
|
|||
|
||||
;; Run the File GC task that should remove unused file object
|
||||
;; 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))))
|
||||
|
||||
;; check if row1 related thumbnail row still exists
|
||||
|
@ -227,6 +233,9 @@
|
|||
(t/is (= (:object-id data1) (:object-id row)))
|
||||
(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
|
||||
(t/is (nil? (sto/get-object storage (:media-id row1))))
|
||||
(t/is (some? (sto/get-object storage (:media-id row2))))
|
||||
|
@ -236,10 +245,42 @@
|
|||
|
||||
;; Run the storage gc deleted task, it should permanently delete
|
||||
;; 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 (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
|
||||
(let [storage (::sto/storage th/*system*)
|
||||
|
|
|
@ -92,3 +92,192 @@
|
|||
:font-family
|
||||
:font-weight
|
||||
: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))))
|
||||
|
||||
))
|
||||
|
|
|
@ -125,7 +125,7 @@
|
|||
|
||||
;; 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)})]
|
||||
(let [result (th/run-task! :objects-gc {:min-age 0})]
|
||||
(t/is (= 0 (:processed result))))
|
||||
|
||||
;; Request profile to be deleted
|
||||
|
@ -144,8 +144,16 @@
|
|||
(t/is (= 1 (count (:result out)))))
|
||||
|
||||
;; execute permanent deletion task
|
||||
(let [result (th/run-task! :objects-gc {:min-age (dt/duration "-1m")})]
|
||||
(t/is (= 2 (:processed result))))
|
||||
(let [result (th/run-task! :objects-gc {:min-age 0})]
|
||||
(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
|
||||
{:id (:default-team-id prof)}
|
||||
|
@ -158,67 +166,9 @@
|
|||
out (th/command! params)]
|
||||
;; (th/print-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
|
||||
(let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]
|
||||
|
|
|
@ -172,14 +172,13 @@
|
|||
|
||||
|
||||
(t/deftest test-deletion
|
||||
(let [task (:app.tasks.objects-gc/handler th/*system*)
|
||||
profile1 (th/create-profile* 1)
|
||||
(let [profile1 (th/create-profile* 1)
|
||||
project (th/create-project* 1 {:team-id (:default-team-id profile1)
|
||||
:profile-id (:id profile1)})]
|
||||
|
||||
;; project is not deleted because it does not meet all
|
||||
;; 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))))
|
||||
|
||||
;; query the list of projects
|
||||
|
@ -187,6 +186,7 @@
|
|||
::rpc/profile-id (:id profile1)
|
||||
:team-id (:default-team-id profile1)}
|
||||
out (th/command! data)]
|
||||
|
||||
;; (th/print-result! out)
|
||||
(t/is (nil? (:error out)))
|
||||
(let [result (:result out)]
|
||||
|
@ -210,7 +210,7 @@
|
|||
(t/is (= 1 (count result)))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; query the list of files of a after soft deletion
|
||||
|
@ -224,7 +224,7 @@
|
|||
(t/is (= 0 (count result)))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; query the list of files of a after hard deletion
|
||||
|
|
|
@ -269,76 +269,6 @@
|
|||
(t/is (= 1 (count members)))
|
||||
(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
|
||||
(let [prof (th/create-profile* 1 {:is-active true})
|
||||
team (th/create-team* 1 {:profile-id (:id prof)})
|
||||
|
@ -418,3 +348,119 @@
|
|||
(t/is (th/success? out))
|
||||
(t/is (nil? (:result out)))
|
||||
(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))))
|
||||
))
|
||||
|
|
|
@ -113,7 +113,7 @@
|
|||
(let [res (th/run-task! :storage-gc-deleted {})]
|
||||
(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/deftest test-touched-gc-task-1
|
||||
|
@ -156,29 +156,33 @@
|
|||
|
||||
(t/is (= (:media-id result-1) (:media-id result-2)))
|
||||
|
||||
;; now we proceed to manually delete one file-media-object
|
||||
(db/exec-one! th/*pool* ["delete from file_media_object where id = ?" (:id result-1)])
|
||||
(th/db-update! :file-media-object
|
||||
{: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
|
||||
(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))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; run the touched gc task
|
||||
(let [task (:app.storage/gc-touched-task th/*system*)
|
||||
res (task {})]
|
||||
(let [res (th/run-task! :storage-gc-touched {})]
|
||||
(t/is (= 2 (:freeze res)))
|
||||
(t/is (= 0 (:delete res))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; 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)))))))
|
||||
|
||||
|
||||
|
@ -231,31 +235,35 @@
|
|||
(t/is (nil? (:error out2)))
|
||||
|
||||
;; run the touched gc task
|
||||
(let [task (:app.storage/gc-touched-task th/*system*)
|
||||
res (task {})]
|
||||
(let [res (th/run-task! :storage-gc-touched {})]
|
||||
(t/is (= 5 (:freeze res)))
|
||||
(t/is (= 0 (:delete res)))
|
||||
|
||||
(let [result-1 (:result out1)
|
||||
result-2 (:result out2)]
|
||||
|
||||
;; now we proceed to manually delete one team-font-variant
|
||||
(db/exec-one! th/*pool* ["delete from team_font_variant where id = ?" (:id result-2)])
|
||||
(th/db-update! :team-font-variant
|
||||
{: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
|
||||
(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
|
||||
(let [res (task {})]
|
||||
(let [res (th/run-task! :storage-gc-touched {})]
|
||||
(t/is (= 2 (:freeze res)))
|
||||
(t/is (= 3 (:delete res))))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; 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/deftest test-touched-gc-task-3
|
||||
|
@ -289,28 +297,28 @@
|
|||
result-2 (:result out2)]
|
||||
|
||||
;; 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
|
||||
(let [task (:app.storage/gc-touched-task th/*system*)
|
||||
res (task {})]
|
||||
(let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
|
||||
(t/is (= 2 (:freeze res)))
|
||||
(t/is (= 0 (:delete res))))
|
||||
|
||||
;; 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"])]
|
||||
(t/is (= 2 (:count res)))))
|
||||
(let [rows (th/db-exec! ["select * from storage_object"])]
|
||||
(t/is (= 2 (count rows)))))
|
||||
|
||||
;; 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
|
||||
(let [task (:app.storage/gc-touched-task th/*system*)
|
||||
res (task {})]
|
||||
(let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
|
||||
(t/is (= 0 (:freeze res)))
|
||||
(t/is (= 2 (:delete res))))
|
||||
|
||||
;; check that we have all no objects
|
||||
(let [res (db/exec-one! th/*pool* ["select count(*) from storage_object where deleted_at is null"])]
|
||||
(t/is (= 0 (:count res))))))
|
||||
|
||||
(let [rows (th/db-exec! ["select * from storage_object where deleted_at is null"])]
|
||||
(t/is (= 0 (count rows))))))
|
||||
|
|
Loading…
Add table
Reference in a new issue