♻️ Reimplement GC mechanism for penpot database objects.

backend/src/app/tasks/delete_object.clj

@@ -4,6 +4,9 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
+;; TODO: DEPRECATED
+;; Should be removed in the 1.8.x
+
 (ns app.tasks.delete-object
   "Generic task for permanent deletion of objects."
   (:require

backend/src/app/tasks/delete_profile.clj

@@ -14,6 +14,9 @@
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
+;; TODO: DEPRECATED
+;; Should be removed in the 1.8.x
+
 (declare delete-profile-data)
 
 ;; --- INIT

backend/src/app/tasks/file_media_gc.clj

@@ -100,6 +100,7 @@
                :id (:id mobj)
                :media-id (:media-id mobj)
                :thumbnail-id (:thumbnail-id mobj))
+
       ;; NOTE: deleting the file-media-object in the database
       ;; automatically marks as toched the referenced storage
       ;; objects. The touch mechanism is needed because many files can

backend/src/app/tasks/objects_gc.clj

@@ -0,0 +1,152 @@
+;; 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) UXBOX Labs SL
+
+(ns app.tasks.objects-gc
+  "A maintenance task that performs a general purpose garbage collection
+  of deleted objects."
+  (:require
+   [app.db :as db]
+   [app.storage :as sto]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(def target-tables
+  ["profile"
+   "team"
+   "file"
+   "project"
+   "team_font_variant"])
+
+(defmulti delete-objects :table)
+
+(def sql:delete-objects
+  "with deleted as (
+    select id from %(table)s
+     where deleted_at is not null
+       and deleted_at < now() - ?::interval
+     order by deleted_at
+     limit %(limit)s
+   )
+   delete from %(table)s
+    where id in (select id from deleted)
+   returning *")
+
+;; --- IMPL: generic object deletion
+
+(defmethod delete-objects :default
+  [{:keys [conn max-age table] :as cfg}]
+  (let [sql     (str/fmt sql:delete-objects
+                         {:table table :limit 50})
+        result  (db/exec! conn [sql max-age])]
+
+    (doseq [{:keys [id] :as item} result]
+      (l/trace :action "delete object" :table table :id id))
+
+    (count result)))
+
+;; --- IMPL: team-font-variant deletion
+
+(defmethod delete-objects "team_font_variant"
+  [{:keys [conn max-age storage table] :as cfg}]
+  (let [sql     (str/fmt sql:delete-objects
+                         {:table table :limit 50})
+        fonts   (db/exec! conn [sql max-age])
+        storage (assoc storage :conn conn)]
+    (doseq [{:keys [id] :as font} fonts]
+      (l/trace :action "delete object" :table table :id id)
+      (some->> (:woff1-file-id font) (sto/del-object storage))
+      (some->> (:woff2-file-id font) (sto/del-object storage))
+      (some->> (:otf-file-id font)   (sto/del-object storage))
+      (some->> (:ttf-file-id font)   (sto/del-object storage)))
+    (count fonts)))
+
+;; --- IMPL: team deletion
+
+(defmethod delete-objects "team"
+  [{:keys [conn max-age storage table] :as cfg}]
+  (let [sql     (str/fmt sql:delete-objects
+                         {:table table :limit 50})
+        teams   (db/exec! conn [sql max-age])
+        storage (assoc storage :conn conn)]
+
+    (doseq [{:keys [id] :as team} teams]
+      (l/trace :action "delete object" :table table :id id)
+      (some->> (:photo-id team) (sto/del-object storage)))
+
+    (count teams)))
+
+;; --- IMPL: profile deletion
+
+(def sql:retrieve-deleted-profiles
+  "select id, photo_id from profile
+    where deleted_at is not null
+      and deleted_at < now() - ?::interval
+    order by deleted_at
+    limit %(limit)s
+    for update")
+
+(def sql:mark-owned-teams-deleted
+  "with owned as (
+    select tpr.team_id as id
+      from team_profile_rel as tpr
+     where tpr.is_owner is true
+       and tpr.profile_id = ?
+   )
+   update team set deleted_at = now() - ?::interval
+    where id in (select id from owned)")
+
+(defmethod delete-objects "profile"
+  [{:keys [conn max-age storage table] :as cfg}]
+  (let [sql      (str/fmt sql:retrieve-deleted-profiles {:limit 50})
+        profiles (db/exec! conn [sql max-age])
+        storage  (assoc storage :conn conn)]
+
+    (doseq [{:keys [id] :as profile} profiles]
+      (l/trace :action "delete object" :table table :id id)
+
+      ;; Mark the owned teams as deleted; this enables them to be procesed
+      ;; in the same transaction in the "team" table step.
+      (db/exec-one! conn [sql:mark-owned-teams-deleted id max-age])
+
+      ;; Mark as deleted the storage object related with the photo-id
+      ;; field.
+      (some->> (:photo-id profile) (sto/del-object storage))
+
+      ;; And finally, permanently delete the profile.
+      (db/delete! conn :profile {:id id}))
+
+    (count profiles)))
+
+;; --- INIT
+
+(defn- process-table
+  [{:keys [table] :as cfg}]
+  (loop [n 0]
+    (let [res (delete-objects cfg)]
+      (if (pos? res)
+        (recur (+ n res))
+        (l/debug :hint "table gc summary" :table table :deleted n)))))
+
+(s/def ::max-age ::dt/duration)
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::db/pool ::sto/storage ::max-age]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [pool max-age] :as cfg}]
+  (fn [task]
+    ;; Checking first on task argument allows properly testing it.
+    (let [max-age (get task :max-age max-age)]
+      (db/with-atomic [conn pool]
+        (let [max-age (db/interval max-age)
+              cfg     (-> cfg
+                          (assoc :max-age max-age)
+                          (assoc :conn conn))]
+          (doseq [table target-tables]
+            (process-table (assoc cfg :table table))))))))