diff --git a/backend/src/app/db.clj b/backend/src/app/db.clj index 8d7fbef4c..357737022 100644 --- a/backend/src/app/db.clj +++ b/backend/src/app/db.clj @@ -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)) diff --git a/backend/src/app/loggers/audit.clj b/backend/src/app/loggers/audit.clj index 4171f52ab..3fbd09bdd 100644 --- a/backend/src/app/loggers/audit.clj +++ b/backend/src/app/loggers/audit.clj @@ -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 diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj index 953f51d8b..dde88473b 100644 --- a/backend/src/app/main.clj +++ b/backend/src/app/main.clj @@ -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} diff --git a/backend/src/app/migrations.clj b/backend/src/app/migrations.clj index d37c7fc32..900ef75f5 100644 --- a/backend/src/app/migrations.clj +++ b/backend/src/app/migrations.clj @@ -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] diff --git a/backend/src/app/migrations/sql/0107-add-deletion-protection-trigger-function.sql b/backend/src/app/migrations/sql/0107-add-deletion-protection-trigger-function.sql new file mode 100644 index 000000000..1ccf9b8b7 --- /dev/null +++ b/backend/src/app/migrations/sql/0107-add-deletion-protection-trigger-function.sql @@ -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; diff --git a/backend/src/app/migrations/sql/0108-mod-file-thumbnail-table.sql b/backend/src/app/migrations/sql/0108-mod-file-thumbnail-table.sql new file mode 100644 index 000000000..b7d05bdc7 --- /dev/null +++ b/backend/src/app/migrations/sql/0108-mod-file-thumbnail-table.sql @@ -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(); diff --git a/backend/src/app/migrations/sql/0109-mod-file-tagged-object-thumbnail-table.sql b/backend/src/app/migrations/sql/0109-mod-file-tagged-object-thumbnail-table.sql new file mode 100644 index 000000000..3184a6576 --- /dev/null +++ b/backend/src/app/migrations/sql/0109-mod-file-tagged-object-thumbnail-table.sql @@ -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(); diff --git a/backend/src/app/migrations/sql/0110-mod-file-media-object-table.sql b/backend/src/app/migrations/sql/0110-mod-file-media-object-table.sql new file mode 100644 index 000000000..49cbebc96 --- /dev/null +++ b/backend/src/app/migrations/sql/0110-mod-file-media-object-table.sql @@ -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(); diff --git a/backend/src/app/migrations/sql/0111-mod-file-data-fragment-table.sql b/backend/src/app/migrations/sql/0111-mod-file-data-fragment-table.sql new file mode 100644 index 000000000..8397124c3 --- /dev/null +++ b/backend/src/app/migrations/sql/0111-mod-file-data-fragment-table.sql @@ -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; diff --git a/backend/src/app/migrations/sql/0112-mod-profile-table.sql b/backend/src/app/migrations/sql/0112-mod-profile-table.sql new file mode 100644 index 000000000..2db8d75b0 --- /dev/null +++ b/backend/src/app/migrations/sql/0112-mod-profile-table.sql @@ -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(); + diff --git a/backend/src/app/migrations/sql/0113-mod-team-font-variant-table.sql b/backend/src/app/migrations/sql/0113-mod-team-font-variant-table.sql new file mode 100644 index 000000000..b9caa08f6 --- /dev/null +++ b/backend/src/app/migrations/sql/0113-mod-team-font-variant-table.sql @@ -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(); diff --git a/backend/src/app/migrations/sql/0114-mod-team-table.sql b/backend/src/app/migrations/sql/0114-mod-team-table.sql new file mode 100644 index 000000000..8c7675643 --- /dev/null +++ b/backend/src/app/migrations/sql/0114-mod-team-table.sql @@ -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; diff --git a/backend/src/app/migrations/sql/0115-mod-project-table.sql b/backend/src/app/migrations/sql/0115-mod-project-table.sql new file mode 100644 index 000000000..f37470dce --- /dev/null +++ b/backend/src/app/migrations/sql/0115-mod-project-table.sql @@ -0,0 +1,3 @@ +ALTER TABLE project + DROP CONSTRAINT project_team_id_fkey, + ADD FOREIGN KEY (team_id) REFERENCES team(id) DEFERRABLE; diff --git a/backend/src/app/migrations/sql/0116-mod-file-table.sql b/backend/src/app/migrations/sql/0116-mod-file-table.sql new file mode 100644 index 000000000..1d3bce11a --- /dev/null +++ b/backend/src/app/migrations/sql/0116-mod-file-table.sql @@ -0,0 +1,3 @@ +ALTER TABLE file + DROP CONSTRAINT file_project_id_fkey, + ADD FOREIGN KEY (project_id) REFERENCES project(id) DEFERRABLE; diff --git a/backend/src/app/migrations/sql/0117-mod-file-object-thumbnail-table.sql b/backend/src/app/migrations/sql/0117-mod-file-object-thumbnail-table.sql new file mode 100644 index 000000000..e3f6cb6d4 --- /dev/null +++ b/backend/src/app/migrations/sql/0117-mod-file-object-thumbnail-table.sql @@ -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; diff --git a/backend/src/app/rpc/commands/auth.clj b/backend/src/app/rpc/commands/auth.clj index 13d05bf0f..d3be9ac1b 100644 --- a/backend/src/app/rpc/commands/auth.clj +++ b/backend/src/app/rpc/commands/auth.clj @@ -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)))) diff --git a/backend/src/app/rpc/commands/comments.clj b/backend/src/app/rpc/commands/comments.clj index 5e87884f6..99f6094b4 100644 --- a/backend/src/app/rpc/commands/comments.clj +++ b/backend/src/app/rpc/commands/comments.clj @@ -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. diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj index 096e96195..2bb6cd9b6 100644 --- a/backend/src/app/rpc/commands/files.clj +++ b/backend/src/app/rpc/commands/files.clj @@ -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 diff --git a/backend/src/app/rpc/commands/files_thumbnails.clj b/backend/src/app/rpc/commands/files_thumbnails.clj index 19f36072f..c34fedaff 100644 --- a/backend/src/app/rpc/commands/files_thumbnails.clj +++ b/backend/src/app/rpc/commands/files_thumbnails.clj @@ -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))}))))) diff --git a/backend/src/app/rpc/commands/fonts.clj b/backend/src/app/rpc/commands/fonts.clj index 4fc55a77f..830efe3e5 100644 --- a/backend/src/app/rpc/commands/fonts.clj +++ b/backend/src/app/rpc/commands/fonts.clj @@ -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)}}))))) diff --git a/backend/src/app/rpc/commands/media.clj b/backend/src/app/rpc/commands/media.clj index 04ad8bc9b..a357c109c 100644 --- a/backend/src/app/rpc/commands/media.clj +++ b/backend/src/app/rpc/commands/media.clj @@ -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 diff --git a/backend/src/app/rpc/retry.clj b/backend/src/app/rpc/retry.clj index 9cb048ea9..bd9c3ea07 100644 --- a/backend/src/app/rpc/retry.clj +++ b/backend/src/app/rpc/retry.clj @@ -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)))) diff --git a/backend/src/app/storage.clj b/backend/src/app/storage.clj index 299fefcbb..5d24f8e68 100644 --- a/backend/src/app/storage.clj +++ b/backend/src/app/storage.clj @@ -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") diff --git a/backend/src/app/storage/gc_deleted.clj b/backend/src/app/storage/gc_deleted.clj new file mode 100644 index 000000000..ec90d483f --- /dev/null +++ b/backend/src/app/storage/gc_deleted.clj @@ -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})))))) + + diff --git a/backend/src/app/storage/gc_touched.clj b/backend/src/app/storage/gc_touched.clj new file mode 100644 index 000000000..bd499bb65 --- /dev/null +++ b/backend/src/app/storage/gc_touched.clj @@ -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!))) + diff --git a/backend/src/app/storage/impl.clj b/backend/src/app/storage/impl.clj index 9dc7facc1..156d86b87 100644 --- a/backend/src/app/storage/impl.clj +++ b/backend/src/app/storage/impl.clj @@ -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))) diff --git a/backend/src/app/tasks/file_gc.clj b/backend/src/app/tasks/file_gc.clj index 5e97bdabc..3e75cb728 100644 --- a/backend/src/app/tasks/file_gc.clj +++ b/backend/src/app/tasks/file_gc.clj @@ -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)))) diff --git a/backend/src/app/tasks/objects_gc.clj b/backend/src/app/tasks/objects_gc.clj index 83b86dcde..4dec5fa0d 100644 --- a/backend/src/app/tasks/objects_gc.clj +++ b/backend/src/app/tasks/objects_gc.clj @@ -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))) diff --git a/backend/src/app/tasks/orphan_teams_gc.clj b/backend/src/app/tasks/orphan_teams_gc.clj new file mode 100644 index 000000000..f7f1daedf --- /dev/null +++ b/backend/src/app/tasks/orphan_teams_gc.clj @@ -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))) diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj index 3fad16114..646905c51 100644 --- a/backend/test/backend_tests/helpers.clj +++ b/backend/test/backend_tests/helpers.clj @@ -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)) diff --git a/backend/test/backend_tests/rpc_file_test.clj b/backend/test/backend_tests/rpc_file_test.clj index cbf96c216..cbce720c5 100644 --- a/backend/test/backend_tests/rpc_file_test.clj +++ b/backend/test/backend_tests/rpc_file_test.clj @@ -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))))))) + + diff --git a/backend/test/backend_tests/rpc_file_thumbnails_test.clj b/backend/test/backend_tests/rpc_file_thumbnails_test.clj index b31e95556..d88b5ed9f 100644 --- a/backend/test/backend_tests/rpc_file_thumbnails_test.clj +++ b/backend/test/backend_tests/rpc_file_thumbnails_test.clj @@ -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*) diff --git a/backend/test/backend_tests/rpc_font_test.clj b/backend/test/backend_tests/rpc_font_test.clj index d1c3bdd60..5d31f14b1 100644 --- a/backend/test/backend_tests/rpc_font_test.clj +++ b/backend/test/backend_tests/rpc_font_test.clj @@ -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)))) + + )) diff --git a/backend/test/backend_tests/rpc_profile_test.clj b/backend/test/backend_tests/rpc_profile_test.clj index 64ccde95a..0bfc01fc7 100644 --- a/backend/test/backend_tests/rpc_profile_test.clj +++ b/backend/test/backend_tests/rpc_profile_test.clj @@ -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"}] diff --git a/backend/test/backend_tests/rpc_project_test.clj b/backend/test/backend_tests/rpc_project_test.clj index acfb6fdf2..f35105a97 100644 --- a/backend/test/backend_tests/rpc_project_test.clj +++ b/backend/test/backend_tests/rpc_project_test.clj @@ -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 diff --git a/backend/test/backend_tests/rpc_team_test.clj b/backend/test/backend_tests/rpc_team_test.clj index 45e4c4807..8252e9aa3 100644 --- a/backend/test/backend_tests/rpc_team_test.clj +++ b/backend/test/backend_tests/rpc_team_test.clj @@ -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)))) + )) diff --git a/backend/test/backend_tests/storage_test.clj b/backend/test/backend_tests/storage_test.clj index 527754420..ccc0d0863 100644 --- a/backend/test/backend_tests/storage_test.clj +++ b/backend/test/backend_tests/storage_test.clj @@ -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))))))