diff options
author | Christopher Baines <mail@cbaines.net> | 2023-07-09 16:52:35 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2023-07-10 18:56:31 +0100 |
commit | 7251c7d653de29f36d50b33badf05a5db983b8e7 (patch) | |
tree | 3f74252cf1f0d13d35dc1253406d9a3b92b67f7e /guix-data-service/data-deletion.scm | |
parent | 672ee6216e1d15f7f550f53017323b59f05303cb (diff) | |
download | data-service-7251c7d653de29f36d50b33badf05a5db983b8e7.tar data-service-7251c7d653de29f36d50b33badf05a5db983b8e7.tar.gz |
Stop using a pool of threads for database operations
Now that squee cooperates with suspendable ports, this is unnecessary. Use a
connection pool to still support running queries in parallel using multiple
connections.
Diffstat (limited to 'guix-data-service/data-deletion.scm')
-rw-r--r-- | guix-data-service/data-deletion.scm | 88 |
1 files changed, 46 insertions, 42 deletions
diff --git a/guix-data-service/data-deletion.scm b/guix-data-service/data-deletion.scm index 35ce39f..241b899 100644 --- a/guix-data-service/data-deletion.scm +++ b/guix-data-service/data-deletion.scm @@ -538,7 +538,7 @@ DELETE FROM derivations WHERE id = $1" 1))) - (define (delete-batch conn) + (define (delete-batch conn connection-pool) (let* ((derivations (with-time-logging "fetching batch of derivations" (map car @@ -580,29 +580,29 @@ WHERE NOT EXISTS ( derivation-id))) (let ((val - (with-thread-postgresql-connection - (lambda (conn) - (catch 'psql-query-error - (lambda () - (with-postgresql-transaction - conn - (lambda (conn) - (exec-query - conn - " + (call-with-resource-from-pool connection-pool + (lambda (conn) + (catch 'psql-query-error + (lambda () + (with-postgresql-transaction + conn + (lambda (conn) + (exec-query + conn + " SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") - (exec-query conn "SET LOCAL lock_timeout = '5s';") + (exec-query conn "SET LOCAL lock_timeout = '5s';") - (maybe-delete-derivation conn - derivation-id)))) - (lambda (key . args) - (simple-format - (current-error-port) - "error when attempting to delete derivation: ~A ~A\n" - key args) + (maybe-delete-derivation conn + derivation-id)))) + (lambda (key . args) + (simple-format + (current-error-port) + "error when attempting to delete derivation: ~A ~A\n" + key args) - 0)))))) + 0)))))) (monitor (set! deleted-count (+ val deleted-count))))) @@ -613,26 +613,30 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") deleted-count) deleted-count))) - (with-postgresql-connection-per-thread - "data-deletion-thread" + (run-fibers (lambda () - (run-fibers - (lambda () - (with-thread-postgresql-connection - (lambda (conn) - (obtain-advisory-transaction-lock - conn - 'delete-unreferenced-derivations) - - (let loop ((total-deleted 0)) - (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)) - (loop (+ total-deleted batch-deleted-count)))))))))))) + (let* ((connection-pool + (make-resource-pool + (lambda () + (open-postgresql-connection "data-deletion" #f)) + 8))) + + (with-postgresql-connection + "data-deletion" + (lambda (conn) + (obtain-advisory-transaction-lock + conn + 'delete-unreferenced-derivations) + + (let loop ((total-deleted 0)) + (let ((batch-deleted-count (delete-batch conn connection-pool))) + (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)) + (loop (+ total-deleted batch-deleted-count))))))))))) |