cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add support for tracking resource pool checkout timeouts

Browse source
This commit is contained in:
Christopher Baines 2024-04-15 13:53:35 +01:00
parent 88b9d34fb1
commit f1add88867
1 changed files with 9 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

10
guix-data-service/utils.scm
View file

@ -39,6 +39,7 @@
prevent-inlining-for-tests
resource-pool-default-timeout
%resource-pool-timeout-handler
make-resource-pool
destroy-resource-pool
call-with-resource-from-pool
@ -341,7 +342,11 @@
(define resource-pool-timeout-error?
(record-predicate &resource-pool-timeout))
(define* (call-with-resource-from-pool pool proc #:key (timeout 'default))
(define %resource-pool-timeout-handler
(make-parameter #f))
(define* (call-with-resource-from-pool pool proc #:key (timeout 'default)
(timeout-handler (%resource-pool-timeout-handler)))
"Call PROC with a resource from POOL, blocking until a resource becomes
available. Return the resource once PROC has returned."
@ -394,6 +399,9 @@ available. Return the resource once PROC has returned."
(when (or (not resource)
(eq? resource 'resource-pool-retry-checkout))
(when timeout-handler
(timeout-handler pool proc timeout))
(raise-exception
(make-resource-pool-timeout-error)))