01/10: Always assume that resource pool waiters will stick around

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit 6bf1747f5580eb582789eb7b77f17c82c6489059
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Tue Nov 5 09:36:31 2024 +0000

    Always assume that resource pool waiters will stick around
    
    As I think this is a more efficient design.
---
 guix-data-service/jobs/load-new-guix-revision.scm |  1 -
 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))