diff options
Diffstat (limited to 'guix-data-service/utils.scm')
-rw-r--r-- | guix-data-service/utils.scm | 22 |
1 files changed, 16 insertions, 6 deletions
diff --git a/guix-data-service/utils.scm b/guix-data-service/utils.scm index 5d7d4ba..2f7ac60 100644 --- a/guix-data-service/utils.scm +++ b/guix-data-service/utils.scm @@ -123,7 +123,8 @@ (sleep 5) (destructor/safe args))))) - (let ((channel (make-channel))) + (let ((channel (make-channel)) + (checkout-failure-count 0)) (spawn-fiber (lambda () (while #t @@ -164,8 +165,12 @@ (wrap-operation (put-operation reply new-resource) (const #t)) - (wrap-operation (sleep-operation 0.2) + (wrap-operation (sleep-operation 1) (const #f)))))) + (unless checkout-success? + (set! checkout-failure-count + (+ 1 checkout-failure-count))) + (loop (cons new-resource resources) (if checkout-success? available @@ -183,8 +188,12 @@ (wrap-operation (put-operation reply (car available)) (const #t)) - (wrap-operation (sleep-operation 0.2) + (wrap-operation (sleep-operation 1) (const #f)))))) + (unless checkout-success? + (set! checkout-failure-count + (+ 1 checkout-failure-count))) + (if checkout-success? (loop resources (cdr available) @@ -222,9 +231,10 @@ resources-last-used))) (('stats reply) (let ((stats - `((resources . ,(length resources)) - (available . ,(length available)) - (waiters . ,(length waiters))))) + `((resources . ,(length resources)) + (available . ,(length available)) + (waiters . ,(length waiters)) + (checkout-failure-count . ,checkout-failure-count)))) (perform-operation (choice-operation |