2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00

Delete builds for unreferenced derivations

This commit is contained in:
Christopher Baines 2020-09-27 11:11:02 +01:00
parent 52a23a5333
commit 5b13ee2251

View file

@ -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
"