aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2024-02-10 10:11:29 +0000
committerChristopher Baines <mail@cbaines.net>2024-02-10 10:11:29 +0000
commit76712e2b007d502eba51bfcc122f6f4acfe7ae10 (patch)
tree7d3287e9e33c7021d5fd1de0a0575561594f06b8
parent26f517d9c20d357c5df6c87690ec92c970755b9b (diff)
downloaddata-service-76712e2b007d502eba51bfcc122f6f4acfe7ae10.tar
data-service-76712e2b007d502eba51bfcc122f6f4acfe7ae10.tar.gz
Instrument resource pool checkout failures
As I've got no idea why the resource pools sometimes stop working.
-rw-r--r--guix-data-service/utils.scm22
-rw-r--r--guix-data-service/web/controller.scm7
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))