Improve data deletion

1 files changed, 67 insertions, 47 deletions

diff --git a/guix-data-service/data-deletion.scm b/guix-data-service/data-deletion.scm
index 918656e..35ce39f 100644
--- a/guix-data-service/data-deletion.scm
+++ b/guix-data-service/data-deletion.scm
@@ -205,30 +205,39 @@ WHERE id IN (
             commits)
        ", "))))
 
-  (with-postgresql-transaction
-   conn
-   (lambda (conn)
-     (obtain-advisory-transaction-lock
-      conn
-      'delete-revisions-from-branch)
+  (catch 'psql-query-error
+    (lambda ()
+      (with-postgresql-transaction
+       conn
+       (lambda (conn)
+         (obtain-advisory-transaction-lock
+          conn
+          'delete-revisions-from-branch)
 
-     (exec-query conn "SET LOCAL lock_timeout = '5s';")
+         (exec-query conn "SET LOCAL lock_timeout = '5s';")
 
-     (delete-from-git-commits conn)
-     (delete-jobs conn)
+         (delete-from-git-commits conn)
+         (delete-jobs conn)
 
-     (let ((git-branch-id
-            (git-branch-for-repository-and-name conn
-                                                git-repository-id
-                                                branch-name)))
-       (exec-query
-        conn
-        (string-append
-         "
+         (let ((git-branch-id
+                (git-branch-for-repository-and-name conn
+                                                    git-repository-id
+                                                    branch-name)))
+           (exec-query
+            conn
+            (string-append
+             "
 DROP TABLE IF EXISTS package_derivations_by_guix_revision_range_git_branch_"
-         (number->string git-branch-id) ";")))
+             (number->string git-branch-id) ";")))
 
-     (delete-guix-revisions conn git-repository-id commits))))
+         (delete-guix-revisions conn git-repository-id commits))))
+    (lambda (key . args)
+      (simple-format
+       (current-error-port)
+       "error when attempting to delete revisions from branch: ~A ~A\n"
+       key args)
+
+      (apply throw key args))))
 
 (define (delete-data-for-branch conn git-repository-id branch-name)
   (define commits
@@ -557,37 +566,48 @@ WHERE NOT EXISTS (
 ) LIMIT $1"
                     (list (number->string batch-size))))))
            (derivations-count (length derivations)))
-      (let ((deleted-count
-             (with-time-logging
-                 (simple-format #f
-                                "Looking at ~A derivations"
-                                derivations-count)
-               (fold
-                (lambda (count result)
-                  (+ result count))
-                0
-                (map
-                 (lambda (derivation-id)
-                   (unless (string->number derivation-id)
-                     (error
-                      (simple-format #f "derivation-id: ~A is not a number"
-                                     derivation-id)))
-
-                   (with-thread-postgresql-connection
-                    (lambda (conn)
-                      (with-postgresql-transaction
-                       conn
-                       (lambda (conn)
-                         (exec-query
-                          conn
-                          "
+      (let ((deleted-count 0))
+        (with-time-logging
+            (simple-format #f
+                           "Looking at ~A derivations"
+                           derivations-count)
+          (n-par-for-each
+           8
+           (lambda (derivation-id)
+             (unless (string->number derivation-id)
+               (error
+                (simple-format #f "derivation-id: ~A is not a number"
+                               derivation-id)))
+
+             (let ((val
+                    (with-thread-postgresql-connection
+                     (lambda (conn)
+                       (catch 'psql-query-error
+                         (lambda ()
+                           (with-postgresql-transaction
+                            conn
+                            (lambda (conn)
+                              (exec-query
+                               conn
+                               "
 SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
 
-                         (exec-query conn "SET LOCAL lock_timeout = '5s';")
+                              (exec-query conn "SET LOCAL lock_timeout = '5s';")
+
+                              (maybe-delete-derivation conn
+                                                       derivation-id))))
+                         (lambda (key . args)
+                           (simple-format
+                            (current-error-port)
+                            "error when attempting to delete derivation: ~A ~A\n"
+                            key args)
+
+                           0))))))
+               (monitor
+                (set! deleted-count
+                      (+ val deleted-count)))))
+           derivations))
 
-                         (maybe-delete-derivation conn
-                                                  derivation-id))))))
-                 derivations)))))
         (simple-format (current-error-port)
                        "Deleted ~A derivations\n"
                        deleted-count)