diff options
author | Christopher Baines <mail@cbaines.net> | 2024-11-05 09:36:31 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-11-05 09:41:30 +0000 |
commit | 6bf1747f5580eb582789eb7b77f17c82c6489059 (patch) | |
tree | 3d62b29be5cdbdddd88651760f901846de6e36f2 | |
parent | d310632f26bfbb9272a5f4019f66045256327702 (diff) | |
download | data-service-6bf1747f5580eb582789eb7b77f17c82c6489059.tar data-service-6bf1747f5580eb582789eb7b77f17c82c6489059.tar.gz |
Always assume that resource pool waiters will stick around
As I think this is a more efficient design.
-rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 1 | ||||
-rw-r--r-- | guix-data-service/utils.scm | 45 |
2 files changed, 14 insertions, 32 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 0d09b54..1fd88b3 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -1839,7 +1839,6 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1" db-conn) 1 #:name "postgres" - #:assume-reliable-waiters? #t #:min-size 0)) (define package-ids-promise diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm index 5436eb8..b53f33f 100644 --- a/guix-data-service/utils.scm +++ b/guix-data-service/utils.scm @@ -121,8 +121,7 @@ destructor lifetime scheduler - (name "unnamed") - assume-reliable-waiters?) + (name "unnamed")) (define (initializer/safe) (with-exception-handler (lambda (exn) @@ -246,8 +245,18 @@ waiters resources-last-used))))) (('return resource) - (if (and assume-reliable-waiters? - (not (null? waiters))) + (if (null? waiters) + (loop resources + (cons resource available) + waiters + (begin + (list-set! + resources-last-used + (list-index (lambda (x) + (eq? x resource)) + resources) + (get-internal-real-time)) + resources-last-used)) (let ((checkout-success? (perform-operation (choice-operation @@ -294,33 +303,7 @@ (eq? x resource)) resources) (get-internal-real-time)) - resources-last-used))))) - (begin - ;; When a resource is returned, prompt all the waiters - ;; to request again. This is to avoid the pool waiting - ;; on channels that may be dead. - (for-each - (lambda (waiter) - (spawn-fiber - (lambda () - (perform-operation - (choice-operation - (put-operation waiter 'resource-pool-retry-checkout) - (sleep-operation 10)))))) - waiters) - - (loop resources - (cons resource available) - ;; clear waiters, as they've been notified - '() - (begin - (list-set! - resources-last-used - (list-index (lambda (x) - (eq? x resource)) - resources) - (get-internal-real-time)) - resources-last-used))))) + resources-last-used))))))) (('stats reply) (let ((stats `((resources . ,(length resources)) |