03/06: Cache the derivations that weren't deleted

[Christopher Baines]

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

commit 530f58b59c9caf4f02178f4ef4928cc20cbd3a1a
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Jun 20 15:47:21 2024 +0100

    Cache the derivations that weren't deleted
    
    When deleting derivations, as I think this might reduce the number of 
queries.
---
 guix-data-service/data-deletion.scm | 28 ++++++++++++++++++++--------
 1 file changed, 20 insertions(+), 8 deletions(-)

diff --git a/guix-data-service/data-deletion.scm 
b/guix-data-service/data-deletion.scm
index e75fe42..0f64da7 100644
--- a/guix-data-service/data-deletion.scm
+++ b/guix-data-service/data-deletion.scm
@@ -552,6 +552,7 @@ DELETE FROM derivations WHERE id = $1"
        1)))
 
   (define deleted-count 0)
+  (define ignored-derivation-ids (make-hash-table))
   (define channel (make-channel))
 
   (define (delete-batch conn)
@@ -589,7 +590,8 @@ WHERE NOT EXISTS (
         (set! deleted-count 0)
         (for-each
          (lambda (derivation-id)
-           (put-message channel derivation-id))
+           (unless (hash-ref ignored-derivation-ids derivation-id)
+             (put-message channel derivation-id)))
          derivations))
 
       (simple-format (current-error-port)
@@ -636,6 +638,11 @@ SET CONSTRAINTS 
derivations_by_output_details_set_derivation_id_fkey DEFERRED")
 
                            0))))
 
+                  (when (= 0 val)
+                    (hash-set! ignored-derivation-ids
+                               derivation-id
+                               #t))
+
                   ;; This is safe as all fibers are in the same
                   ;; thread and cooperative.
                   (set! deleted-count
@@ -654,13 +661,18 @@ 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
-                  (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"
-                   total-deleted))
+                  (hash-clear! ignored-derivation-ids)
+                  (let ((batch-deleted-count (delete-batch conn)))
+                    (if (= 0 batch-deleted-count)
+                        (begin
+                          (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"
+                           total-deleted))
+                        (loop (+ total-deleted batch-deleted-count)))))
                 (loop (+ total-deleted batch-deleted-count))))))))
    #:hz 0
    #:parallelism 1))