Improve data deletion

guix-data-service/data-deletion.scm

@@ -205,6 +205,8 @@ WHERE id IN (
             commits)
        ", "))))
 
+  (catch 'psql-query-error
+    (lambda ()
       (with-postgresql-transaction
        conn
        (lambda (conn)
@@ -229,6 +231,13 @@ DROP TABLE IF EXISTS package_derivations_by_guix_revision_range_git_branch_"
              (number->string git-branch-id) ";")))
 
          (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,24 +566,24 @@ WHERE NOT EXISTS (
 ) LIMIT $1"
                     (list (number->string batch-size))))))
            (derivations-count (length derivations)))
-      (let ((deleted-count
+      (let ((deleted-count 0))
         (with-time-logging
             (simple-format #f
                            "Looking at ~A derivations"
                            derivations-count)
-               (fold
-                (lambda (count result)
-                  (+ result count))
-                0
-                (map
+          (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)
@@ -586,8 +595,19 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
                               (exec-query conn "SET LOCAL lock_timeout = '5s';")
 
                               (maybe-delete-derivation conn
-                                                  derivation-id))))))
-                 derivations)))))
+                                                       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))
+
         (simple-format (current-error-port)
                        "Deleted ~A derivations\n"
                        deleted-count)