05/05: Delete builds for unreferenced derivations

[Christopher Baines]

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

commit 5b13ee22518df33c42ed04ee299a7c94b78fbb81
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sun Sep 27 11:11:02 2020 +0100

    Delete builds for unreferenced derivations
---
 guix-data-service/data-deletion.scm | 34 ++++++++++++++++++++++++++++++++++
 1 file changed, 34 insertions(+)

diff --git a/guix-data-service/data-deletion.scm 
b/guix-data-service/data-deletion.scm
index dbb94e5..4bca68d 100644
--- a/guix-data-service/data-deletion.scm
+++ b/guix-data-service/data-deletion.scm
@@ -268,6 +268,36 @@ FROM (
 WHERE commit = ''")))))
 
 (define (delete-unreferenced-derivations)
+  (define (delete-builds-for-derivation-output-details-set
+           conn
+           derivation-output-details-set-id)
+    (let ((build-ids
+           (map car
+                (exec-query
+                 conn
+                 "
+SELECT id
+FROM builds
+WHERE derivation_output_details_set_id = $1"
+                 derivation-output-details-set-id))))
+
+      (unless (null? build-ids)
+        (exec-query
+         conn
+         (string-append
+          "
+DELETE FROM build_status WHERE build_id IN ("
+          (string-join build-ids ",")
+          ")"))
+
+        (exec-query
+         conn
+         (string-append
+          "
+DELETE FROM builds WHERE id IN ("
+          (string-join build-ids ",")
+          ")")))))
+
   (define (maybe-delete-derivation conn id file-name)
     (match (map
             car
@@ -348,6 +378,10 @@ WHERE derivation_id = $1"
 
              (when (<= (string->number count)
                        1)
+               (delete-builds-for-derivation-output-details-set
+                conn
+                derivation-output-details-set-id)
+
                (exec-query
                 conn
                 "