diff options
| -rw-r--r-- | guix-data-service/utils.scm | 22 | ||||
| -rw-r--r-- | guix-data-service/web/controller.scm | 7 |
2 files changed, 22 insertions, 7 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 diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index de7ba7c..1ac081b 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -190,7 +190,12 @@ (waiters . ,(make-gauge-metric registry "resource_pool_waiters_total" - #:labels '(pool_name))))) + #:labels '(pool_name))) + (checkout-failure-count + . ,(make-gauge-metric + registry + "resource_pool_checkout_failures_total" + #:labels '(pool_name))))) (gc-metrics-updater (get-gc-metrics-updater registry)) |