diff --git a/guix-data-service/data-deletion.scm b/guix-data-service/data-deletion.scm index a1fd5f2..35ea4dc 100644 --- a/guix-data-service/data-deletion.scm +++ b/guix-data-service/data-deletion.scm @@ -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)