;; 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.config :as cf] [app.db :as db] [app.storage :as sto] [app.storage.impl :as simpl] [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: file deletion (defmethod delete-objects "file" [{:keys [conn max-age table storage] :as cfg}] (let [sql (str/fmt sql:delete-objects {:table table :limit 50}) result (db/exec! conn [sql max-age]) backend (simpl/resolve-backend storage (cf/get :fdata-storage-backend))] (doseq [{:keys [id] :as item} result] (l/trace :action "delete object" :table table :id id) (when backend (simpl/del-object backend item))) (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))))))))