✨ Improve objects-gc task

backend/src/app/main.clj

@@ -310,8 +310,7 @@
 
    :app.tasks.objects-gc/handler
    {:pool    (ig/ref :app.db/pool)
-    :storage (ig/ref :app.storage/storage)
-    :max-age cf/deletion-delay}
+    :storage (ig/ref :app.storage/storage)}
 
    :app.tasks.file-gc/handler
    {:pool (ig/ref :app.db/pool)}

backend/src/app/tasks/objects_gc.clj

@@ -8,7 +8,9 @@
   "A maintenance task that performs a general purpose garbage collection
   of deleted objects."
   (:require
+   [app.common.data :as d]
    [app.common.logging :as l]
+   [app.config :as cf]
    [app.db :as db]
    [app.media :as media]
    [app.storage :as sto]
@@ -41,38 +43,38 @@
 ;; --- IMPL: generic object deletion
 
 (defmethod delete-objects :default
-  [{:keys [conn max-age table] :as cfg}]
+  [{:keys [conn min-age table] :as cfg}]
   (let [sql     (str/fmt sql:delete-objects
                          {:table table :limit 50})
-        result  (db/exec! conn [sql max-age])]
+        result  (db/exec! conn [sql min-age])]
 
     (doseq [{:keys [id] :as item} result]
-      (l/trace :hint "delete object" :table table :id id))
+      (l/debug :hint "permanently delete object" :table table :id id))
 
     (count result)))
 
 ;; --- IMPL: file deletion
 
 (defmethod delete-objects "file"
-  [{:keys [conn max-age table] :as cfg}]
+  [{:keys [conn min-age table] :as cfg}]
   (let [sql    (str/fmt sql:delete-objects {:table table :limit 50})
-        result (db/exec! conn [sql max-age])]
+        result (db/exec! conn [sql min-age])]
 
     (doseq [{:keys [id] :as item} result]
-      (l/trace :hint "delete object" :table table :id id))
+      (l/debug :hint "permanently 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}]
+  [{:keys [conn min-age storage table] :as cfg}]
   (let [sql     (str/fmt sql:delete-objects
                          {:table table :limit 50})
-        fonts   (db/exec! conn [sql max-age])
+        fonts   (db/exec! conn [sql min-age])
         storage (media/configure-assets-storage storage conn)]
     (doseq [{:keys [id] :as font} fonts]
-      (l/trace :hint "delete object" :table table :id id)
+      (l/debug :hint "permanently delete object" :table table :id id)
       (some->> (:woff1-file-id font) (sto/touch-object! storage) deref)
       (some->> (:woff2-file-id font) (sto/touch-object! storage) deref)
       (some->> (:otf-file-id font)   (sto/touch-object! storage) deref)
@@ -82,14 +84,14 @@
 ;; --- IMPL: team deletion
 
 (defmethod delete-objects "team"
-  [{:keys [conn max-age storage table] :as cfg}]
+  [{:keys [conn min-age storage table] :as cfg}]
   (let [sql     (str/fmt sql:delete-objects
                          {:table table :limit 50})
-        teams   (db/exec! conn [sql max-age])
+        teams   (db/exec! conn [sql min-age])
         storage (assoc storage :conn conn)]
 
     (doseq [{:keys [id] :as team} teams]
-      (l/trace :hint "delete object" :table table :id id)
+      (l/debug :hint "permanently delete object" :table table :id id)
       (some->> (:photo-id team) (sto/touch-object! storage) deref))
 
     (count teams)))
@@ -115,17 +117,17 @@
     where id in (select id from owned)")
 
 (defmethod delete-objects "profile"
-  [{:keys [conn max-age storage table] :as cfg}]
+  [{:keys [conn min-age storage table] :as cfg}]
   (let [sql      (str/fmt sql:retrieve-deleted-profiles {:limit 50})
-        profiles (db/exec! conn [sql max-age])
+        profiles (db/exec! conn [sql min-age])
         storage  (assoc storage :conn conn)]
 
     (doseq [{:keys [id] :as profile} profiles]
-      (l/trace :hint "delete object" :table table :id id)
+      (l/debug :hint "permanently delete object" :table table :id id)
 
       ;; Mark the owned teams as deleted; this enables them to be processed
       ;; in the same transaction in the "team" table step.
-      (db/exec-one! conn [sql:mark-owned-teams-deleted id max-age])
+      (db/exec-one! conn [sql:mark-owned-teams-deleted id min-age])
 
       ;; Mark as deleted the storage object related with the photo-id
       ;; field.
@@ -144,22 +146,40 @@
     (let [res (delete-objects cfg)]
       (if (pos? res)
         (recur (+ n res))
-        (l/debug :hint "table gc summary" :table table :deleted n)))))
+        (do
+          (l/debug :hint "delete summary" :table table :total n)
+          n)))))
 
-(s/def ::max-age ::dt/duration)
+(s/def ::min-age ::dt/duration)
 
 (defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool ::sto/storage ::max-age]))
+  (s/keys :req-un [::db/pool ::sto/storage]
+          :opt-un [::min-age]))
+
+(defmethod ig/prep-key ::handler
+  [_ cfg]
+  (merge {:min-age cf/deletion-delay}
+         (d/without-nils cfg)))
 
 (defmethod ig/init-key ::handler
-  [_ {:keys [pool max-age] :as cfg}]
-  (fn [task]
+  [_ {:keys [pool] :as cfg}]
+  (fn [params]
     ;; Checking first on task argument allows properly testing it.
-    (let [max-age (get task :max-age max-age)]
+    (let [min-age (or (:min-age params) (:min-age cfg))]
       (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))))))))
+        (let [cfg (-> cfg
+                      (assoc :min-age (db/interval min-age))
+                      (assoc :conn conn))]
+          (loop [tables (seq target-tables)
+                 total  0]
+            (if-let [table (first tables)]
+              (recur (rest tables)
+                     (+ total (process-table (assoc cfg :table table))))
+              (do
+                (l/info :hint "task finished" :min-age (dt/format-duration min-age) :total total)
+
+                (when (:rollback? params)
+                  (db/rollback! conn))
+
+                {:processed total}))))))))
+