From 2770c1ad70ede355d4b630ea29818b9e508fff1c Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 12 Jan 2026 10:50:11 +0000
Subject: [PATCH] Address issue with failures when creating resource pool
 resources

Previously failures could lead to no resources in the pool, and
waiters which will never get a resource. Retrying here fixes that
issue, although maybe another approach is needed that keeps track of
new resources being created, as that'll allow keeping track of this
when destroying resource pools.
---
 knots/resource-pool.scm | 62 ++++++++++++++++++++++++-----------------
 1 file changed, 37 insertions(+), 25 deletions(-)

diff --git a/knots/resource-pool.scm b/knots/resource-pool.scm
index d7bdfa3..553df68 100644
--- a/knots/resource-pool.scm
+++ b/knots/resource-pool.scm
@@ -562,31 +562,43 @@
                  #f
                  (raise-exception exn)))
          (lambda ()
-           (with-parallelism-limiter
-            return-new-resource/parallelism-limiter
-            (let ((max-size
-                   (assq-ref (resource-pool-configuration pool)
-                             'max-size))
-                  (size (count-resources resources)))
-              (unless (>= size max-size)
-                (with-exception-handler
-                    (lambda _ #f)
-                  (lambda ()
-                    (with-exception-handler
-                        (lambda (exn)
-                          (simple-format
-                           (current-error-port)
-                           "exception adding resource to pool ~A: ~A\n\n"
-                           name
-                           return-new-resource)
-                          (print-backtrace-and-exception/knots exn)
-                          (raise-exception exn))
-                      (lambda ()
-                        (let ((new-resource
-                               (start-stack #t (return-new-resource))))
-                          (put-message channel
-                                       (list 'add-resource new-resource))))))
-                  #:unwind? #t)))))
+           (let loop ()
+             (with-parallelism-limiter
+              return-new-resource/parallelism-limiter
+              (let ((max-size
+                     (assq-ref (resource-pool-configuration pool)
+                               'max-size))
+                    (size (count-resources resources)))
+                (unless (>= size max-size)
+                  (let ((success?
+                         (with-exception-handler
+                             (lambda _ #f)
+                           (lambda ()
+                             (with-exception-handler
+                                 (lambda (exn)
+                                   (simple-format
+                                    (current-error-port)
+                                    "exception adding resource to pool ~A: ~A\n\n"
+                                    name
+                                    return-new-resource)
+                                   (print-backtrace-and-exception/knots exn)
+                                   (raise-exception exn))
+                               (lambda ()
+                                 (let ((new-resource
+                                        (start-stack #t (return-new-resource))))
+                                   (put-message channel
+                                                (list 'add-resource new-resource)))
+                                 #t)))
+                           #:unwind? #t)))
+                    (unless success?
+                      ;; TODO Maybe this should be configurable?
+                      (sleep 1)
+
+                      ;; Important to retry here and eventually create
+                      ;; a new resource, as there might be waiters
+                      ;; stuck waiting for a resource, especially if
+                      ;; the pool is empty.
+                      (loop))))))))
          #:unwind? #t))))
 
   (define (spawn-fiber-to-destroy-resource resource-id resource-value)