✨ Improve object deletion process on profile deletion

backend/src/app/rpc/mutations/profile.clj

@@ -252,6 +252,7 @@
 
 ;; --- MUTATION: Delete Profile
 
+(declare get-owned-teams-with-participants)
 (declare check-can-delete-profile!)
 (declare mark-profile-as-deleted!)
 
@@ -261,14 +262,29 @@
 (sv/defmethod ::delete-profile
   [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (check-can-delete-profile! conn profile-id)
+    (let [teams      (get-owned-teams-with-participants conn profile-id)
+          deleted-at (dt/now)]
 
-    (db/update! conn :profile
+      ;; If we found owned teams with participants, we don't allow
-                {:deleted-at (dt/now)}
+      ;; delete profile until the user properly transfer ownership or
-                {:id profile-id})
+      ;; explicitly removes all participants from the team
+      (when (some pos? (map :participants teams))
+        (ex/raise :type :validation
+                  :code :owner-teams-with-people
+                  :hint "The user need to transfer ownership of owned teams."
+                  :context {:teams (mapv :id teams)}))
 
-    (with-meta {}
+      (doseq [{:keys [id]} teams]
-      {:transform-response (:delete session)})))
+        (db/update! conn :team
+                    {:deleted-at deleted-at}
+                    {:id id}))
+
+      (db/update! conn :profile
+                  {:deleted-at deleted-at}
+                  {:id profile-id})
+
+      (with-meta {}
+        {:transform-response (:delete session)}))))
 
 (def sql:owned-teams
   "with owner_teams as (
@@ -277,23 +293,16 @@
        where tpr.is_owner is true
          and tpr.profile_id = ?
    )
-   select tpr.team_id,
+   select tpr.team_id as id,
-          count(tpr.profile_id) as num_profiles
+          count(tpr.profile_id) - 1 as participants
      from team_profile_rel as tpr
     where tpr.team_id in (select id from owner_teams)
+      and tpr.profile_id != ?
     group by 1")
 
-(defn- check-can-delete-profile!
+(defn- get-owned-teams-with-participants
   [conn profile-id]
-  (let [rows (db/exec! conn [sql:owned-teams profile-id])]
+  (db/exec! conn [sql:owned-teams profile-id profile-id]))
-    ;; If we found owned teams with more than one profile we don't
-    ;; allow delete profile until the user properly transfer ownership
-    ;; or explicitly removes all participants from the team.
-    (when (some #(> (:num-profiles %) 1) rows)
-      (ex/raise :type :validation
-                :code :owner-teams-with-people
-                :hint "The user need to transfer ownership of owned teams."
-                :context {:teams (mapv :team-id rows)}))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; DEPRECATED METHODS (TO BE REMOVED ON 1.16.x)

backend/src/app/srepl/main.clj

@@ -62,7 +62,7 @@
     (cmd.auth/send-email-verification! pool sprops profile)
     :email-sent))
 
-(defn update-profile
+(defn update-profile!
   "Update a limited set of profile attrs."
   [system & {:keys [email id active? deleted? blocked?]}]
 

backend/src/app/tasks/objects_gc.clj

@@ -69,8 +69,7 @@
 
 (defmethod delete-objects "team_font_variant"
   [{:keys [conn min-age storage table] :as cfg}]
-  (let [sql     (str/fmt sql:delete-objects
+  (let [sql     (str/fmt sql:delete-objects {:table table :limit 50})
-                         {:table table :limit 50})
         fonts   (db/exec! conn [sql min-age])
         storage (media/configure-assets-storage storage conn)]
     (doseq [{:keys [id] :as font} fonts]
@@ -85,10 +84,9 @@
 
 (defmethod delete-objects "team"
   [{:keys [conn min-age storage table] :as cfg}]
-  (let [sql     (str/fmt sql:delete-objects
+  (let [sql     (str/fmt sql:delete-objects {:table table :limit 50})
-                         {:table table :limit 50})
         teams   (db/exec! conn [sql min-age])
-        storage (assoc storage :conn conn)]
+        storage (media/configure-assets-storage storage conn)]
 
     (doseq [{:keys [id] :as team} teams]
       (l/debug :hint "permanently delete object" :table table :id id)
@@ -103,32 +101,17 @@
     where deleted_at is not null
       and deleted_at < now() - ?::interval
     order by deleted_at
-    limit %(limit)s
+    limit ?
     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 min-age storage table] :as cfg}]
-  (let [sql      (str/fmt sql:retrieve-deleted-profiles {:limit 50})
+  (let [profiles (db/exec! conn [sql:retrieve-deleted-profiles min-age 50])
-        profiles (db/exec! conn [sql min-age])
+        storage  (media/configure-assets-storage storage conn)]
-        storage  (assoc storage :conn conn)]
 
     (doseq [{:keys [id] :as profile} profiles]
       (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 min-age])
-
       ;; Mark as deleted the storage object related with the photo-id
       ;; field.
       (some->> (:photo-id profile) (sto/touch-object! storage) deref)
@@ -164,22 +147,23 @@
 (defmethod ig/init-key ::handler
   [_ {:keys [pool] :as cfg}]
   (fn [params]
-    ;; Checking first on task argument allows properly testing it.
+    (db/with-atomic [conn pool]
-    (let [min-age (or (:min-age params) (:min-age cfg))]
+      (let [min-age (or (:min-age params) (:min-age cfg))
-      (db/with-atomic [conn pool]
+            cfg     (-> cfg
-        (let [cfg (-> cfg
+                        (assoc :min-age (db/interval min-age))
-                      (assoc :min-age (db/interval min-age))
+                        (assoc :conn conn))]
-                      (assoc :conn conn))]
+        (loop [tables (seq target-tables)
-          (loop [tables (seq target-tables)
+               total  0]
-                 total  0]
+          (if-let [table (first tables)]
-            (if-let [table (first tables)]
+            (recur (rest tables)
-              (recur (rest tables)
+                   (+ total (process-table (assoc cfg :table table))))
-                     (+ total (process-table (assoc cfg :table table))))
+            (do
-              (do
+              (l/info :hint "objects gc finished succesfully"
-                (l/info :hint "task finished" :min-age (dt/format-duration min-age) :total total)
+                      :min-age (dt/format-duration min-age)
+                      :total total)
 
-                (when (:rollback? params)
+              (when (:rollback? params)
-                  (db/rollback! conn))
+                (db/rollback! conn))
 
-                {:processed total}))))))))
+              {:processed total})))))))
 

backend/test/app/services_files_test.clj

@@ -537,10 +537,12 @@
                   :file-id (:id file)
                   :object-id frame1-id
                   :components-v2 true}
-            {:keys [error result] :as out} (th/query! data)]
+            out  (th/query! data)]
-        ;; (th/print-result! out)
+
-        (t/is (th/ex-of-type? error :validation))
+        (t/is (not (th/success? out)))
-        (t/is (th/ex-of-code? error :spec-validation (th/ex-code error)))))
+        (let [{:keys [type code]} (-> out :error ex-data)]
+          (t/is (= :validation type))
+          (t/is (= :spec-validation code)))))
 
     (t/testing "RPC :file-data-for-thumbnail"
       ;; Insert a thumbnail data for the frame-id