Instrument the resource pool checkout timeouts

This commit is contained in:
Christopher Baines 2024-04-15 13:54:25 +01:00
parent f1add88867
commit c18589249f

View file

@ -142,6 +142,22 @@
(resource-pool-default-timeout 5))
(let ((resource-pool-checkout-failures-metric
(make-counter-metric registry
"resource_pool_checkout_timeouts_total"
#:labels '(pool_name))))
(%resource-pool-timeout-handler
(lambda (pool proc timeout)
(let ((pool-name
(cond
((eq? pool (connection-pool)) "normal")
((eq? pool (reserved-connection-pool)) "reserved")
(else #f))))
(when pool-name
(metric-increment
resource-pool-checkout-failures-metric
#:label-values `((pool_name . ,pool-name))))))))
(spawn-fiber
(lambda ()
(with-resource-from-pool (connection-pool) conn