Have the background resource pool users be very patient

1 files changed, 19 insertions, 17 deletions

diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm
index 308ef99..22088b1 100644
--- a/guix-data-service/web/build-server/controller.scm
+++ b/guix-data-service/web/build-server/controller.scm
@@ -124,23 +124,25 @@
   (define (spawn-fiber-for-handler handler)
     (spawn-fiber
      (lambda ()
-       (call-with-resource-from-pool (background-connection-pool)
-         (lambda (conn)
-           (with-exception-handler
-               (lambda (exn)
-                 (simple-format
-                  (current-error-port)
-                  "exception in build event handler: ~A\n"
-                  exn))
-             (lambda ()
-               (with-throw-handler #t
-                 (lambda ()
-                   (handler conn))
-                 (lambda _
-                   (display (backtrace) (current-error-port))
-                   (display "\n" (current-error-port)))))
-             #:unwind? #t))
-         #:timeout #f))))
+       (parameterize
+           ((resource-pool-retry-checkout-timeout (* 60 60 6)))
+         (call-with-resource-from-pool (background-connection-pool)
+           (lambda (conn)
+             (with-exception-handler
+                 (lambda (exn)
+                   (simple-format
+                    (current-error-port)
+                    "exception in build event handler: ~A\n"
+                    exn))
+               (lambda ()
+                 (with-throw-handler #t
+                   (lambda ()
+                     (handler conn))
+                   (lambda _
+                     (display (backtrace) (current-error-port))
+                     (display "\n" (current-error-port)))))
+               #:unwind? #t))
+           #:timeout #f)))))
 
   (define (with-build-ids-for-status data
                                      build-ids