guix
/
data-service
mirror of git://git.savannah.gnu.org/guix/data-service.git
2
0
Fork 0
Code Issues Releases Wiki Activity

Remove redundant postgresql connection when deleting derivations

This commit is contained in:
Christopher Baines 2023-02-14 20:59:21 +00:00
parent ebbcf36dc4
commit 1266d3d336
1 changed files with 46 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
guix-data-service/data-deletion.scm
View File

@ -512,16 +512,13 @@ DELETE FROM derivations WHERE id = $1"
1)))
(with-postgresql-connection
"data-deletion"
(lambda (conn)
(define (delete-batch conn)
(let* ((derivations
(with-time-logging "fetching batch of derivations"
(map car
(exec-query
conn
"
(define (delete-batch conn)
(let* ((derivations
(with-time-logging "fetching batch of derivations"
(map car
(exec-query
conn
"
SELECT DISTINCT derivation_id
FROM derivation_outputs
WHERE NOT EXISTS (
@ -541,51 +538,53 @@ 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))))))
(derivations-count (length derivations)))
(let ((deleted-count
(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)))
(list (number->string batch-size))))))
(derivations-count (length derivations)))
(let ((deleted-count
(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
(with-thread-postgresql-connection
(lambda (conn)
(with-postgresql-transaction
conn
(lambda (conn)
(with-postgresql-transaction
(obtain-advisory-transaction-lock
conn
(lambda (conn)
(obtain-advisory-transaction-lock
conn
'delete-unreferenced-derivations)
'delete-unreferenced-derivations)
(exec-query
conn
"
(exec-query
conn
"
SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
(maybe-delete-derivation conn
derivation-id))))))
derivations)))))
(simple-format (current-error-port)
"Deleted ~A derivations\n"
deleted-count)
deleted-count)))
(maybe-delete-derivation conn
derivation-id))))))
derivations)))))
(simple-format (current-error-port)
"Deleted ~A derivations\n"
deleted-count)
deleted-count)))
(with-postgresql-connection-per-thread
"data-deletion-thread"
(with-postgresql-connection-per-thread
"data-deletion-thread"
(lambda ()
(run-fibers
(lambda ()
(run-fibers
(lambda ()
(with-thread-postgresql-connection
(lambda (conn)
(let loop ((total-deleted 0))
(let ((batch-deleted-count (delete-batch conn)))
(if (eq? 0 batch-deleted-count)