branch master updated: Improve deleting derivations

[Christopher Baines]

This is an automated email from the git hooks/post-receive script.

cbaines pushed a commit to branch master
in repository data-service.

The following commit(s) were added to refs/heads/master by this push:
     new 39487cd  Improve deleting derivations
39487cd is described below

commit 39487cd7e6df7f50f21af15b26f9ec616709f21d
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Jul 8 20:54:12 2022 +0100

    Improve deleting derivations
    
    Drop the batch size to get rid of warnings about memory usage and improve 
the
    logging by adding duration information.
---
 guix-data-service/data-deletion.scm | 71 +++++++++++++++++++------------------
 1 file changed, 36 insertions(+), 35 deletions(-)

diff --git a/guix-data-service/data-deletion.scm 
b/guix-data-service/data-deletion.scm
index 3dd1dee..e4762c9 100644
--- a/guix-data-service/data-deletion.scm
+++ b/guix-data-service/data-deletion.scm
@@ -336,7 +336,7 @@ FROM (
 WHERE commit = ''")))))
 
 (define* (delete-unreferenced-derivations #:key
-                                          (batch-size 1000000))
+                                          (batch-size 100000))
   (define (delete-builds-for-derivation-output-details-set
            conn
            derivation-output-details-set-id)
@@ -491,10 +491,11 @@ DELETE FROM derivations WHERE id = $1"
    (lambda (conn)
      (define (delete-batch conn)
        (let* ((derivations
-               (map car
-                    (exec-query
-                     conn
-                     "
+               (with-time-logging "fetching batch of derivations"
+                 (map car
+                      (exec-query
+                       conn
+                       "
 SELECT DISTINCT derivation_id
 FROM derivation_outputs
 WHERE NOT EXISTS (
@@ -514,36 +515,37 @@ WHERE NOT EXISTS (
   SELECT 1 FROM guix_revision_system_test_derivations
   WHERE derivation_id = derivation_outputs.derivation_id
 ) LIMIT $1"
-                     (list (number->string batch-size)))))
+                       (list (number->string batch-size))))))
               (derivations-count (length derivations)))
-         (simple-format (current-error-port)
-                        "Looking at ~A derivations\n"
-                        derivations-count)
          (let ((deleted-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
-                           "
+                (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
+                             "
 SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
 
-                          (maybe-delete-derivation conn
-                                                   derivation-id))))))
-                  derivations))))
+                            (maybe-delete-derivation conn
+                                                     derivation-id))))))
+                    derivations)))))
            (simple-format (current-error-port)
                           "Deleted ~A derivations\n"
                           deleted-count)
@@ -558,10 +560,9 @@ SET CONSTRAINTS 
derivations_by_output_details_set_derivation_id_fkey DEFERRED")
              (let ((batch-deleted-count (delete-batch conn)))
                (if (eq? 0 batch-deleted-count)
                    (begin
-                     (simple-format
-                      (current-output-port)
-                      "Deleting unused derivation_source_files entries")
-                     (delete-unreferenced-derivations-source-files conn)
+                     (with-time-logging
+                         "Deleting unused derivation_source_files entries"
+                       (delete-unreferenced-derivations-source-files conn))
                      (simple-format
                       (current-output-port)
                       "Finished deleting derivations, deleted ~A in total\n"