[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: Support instrumenting the number of database connections
From: |
Christopher Baines |
Subject: |
02/03: Support instrumenting the number of database connections |
Date: |
Sun, 1 Jan 2023 07:46:11 -0500 (EST) |
cbaines pushed a commit to branch master
in repository data-service.
commit 05c437d26ae0cf5aed344afb30408ec99e883805
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sun Jan 1 12:42:41 2023 +0000
Support instrumenting the number of database connections
Since this is now quite dynamic, it's useful to have a metric for it.
---
guix-data-service/database.scm | 55 ++++++++++++++++++++++++++++++++++++++----
1 file changed, 50 insertions(+), 5 deletions(-)
diff --git a/guix-data-service/database.scm b/guix-data-service/database.scm
index 25305b2..8ed87de 100644
--- a/guix-data-service/database.scm
+++ b/guix-data-service/database.scm
@@ -1,5 +1,5 @@
;;; Guix Data Service -- Information about Guix over time
-;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
+;;; Copyright © 2019, 2020, 2021, 2022, 2023 Christopher Baines
<mail@cbaines.net>
;;;
;;; This program is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU Affero General Public License
@@ -20,8 +20,10 @@
#:use-module (ice-9 match)
#:use-module (ice-9 threads)
#:use-module (squee)
+ #:use-module (prometheus)
#:use-module (guix-data-service config)
#:export (get-database-config
+ %database-metrics-registry
with-postgresql-connection
@@ -42,6 +44,33 @@
(define pg-conn-finish
(@@ (squee) pg-conn-finish))
+(define %database-metrics-registry
+ (make-parameter #f))
+
+(define (with-connection-gauge-metric proc)
+ (and=>
+ (%database-metrics-registry)
+ (lambda (registry)
+ (proc
+ (or (metrics-registry-fetch-metric registry
"postgresql_connections_total")
+ (make-gauge-metric registry
+ "postgresql_connections_total"
+ #:labels '(name)))))))
+
+(define (increment-connection-gauge name)
+ (with-connection-gauge-metric
+ (lambda (connection-gauge-metric)
+ (metric-increment connection-gauge-metric
+ #:label-values
+ `((name . ,name))))))
+
+(define (decrement-connection-gauge name)
+ (with-connection-gauge-metric
+ (lambda (connection-gauge-metric)
+ (metric-decrement connection-gauge-metric
+ #:label-values
+ `((name . ,name))))))
+
(define (paramstring->alist s)
(map
(lambda (param)
@@ -77,6 +106,8 @@
(simple-format #f "SET statement_timeout = ~A"
statement-timeout)))
+ (increment-connection-gauge name)
+
conn))
(define* (with-postgresql-connection name f #:key (statement-timeout #f))
@@ -89,9 +120,13 @@
(f conn))
(lambda vals
(pg-conn-finish conn)
+
+ (decrement-connection-gauge name)
+
(apply values vals))))
(lambda (key . args)
- (pg-conn-finish conn)))))
+ (pg-conn-finish conn)
+ (decrement-connection-gauge name)))))
(define %postgresql-connection-parameters
(make-parameter #f))
@@ -99,18 +134,24 @@
(define %postgresql-connections-hash-table
(make-parameter #f))
+(define %postgresql-connections-name
+ (make-parameter #f))
+
(define* (with-postgresql-connection-per-thread name thunk
#:key (statement-timeout #f))
(parameterize ((%postgresql-connection-parameters
(list name statement-timeout))
(%postgresql-connections-hash-table
- (make-hash-table)))
+ (make-hash-table))
+ (%postgresql-connections-name
+ name))
(call-with-values
thunk
(lambda vals
(hash-for-each
(lambda (thread conn)
- (pg-conn-finish conn))
+ (pg-conn-finish conn)
+ (decrement-connection-gauge name))
(%postgresql-connections-hash-table))
(apply values vals)))))
@@ -136,6 +177,8 @@
(with-exception-handler
(lambda (exn)
(pg-conn-finish conn)
+ (decrement-connection-gauge
+ (%postgresql-connections-name))
(set-current-thread-connection #f)
(raise-exception exn))
(lambda ()
@@ -153,7 +196,9 @@
(pg-conn-finish conn)
(hash-remove! (%postgresql-connections-hash-table)
(current-thread))
- (fluid-set! %thread-postgresql-connection #f))))
+ (fluid-set! %thread-postgresql-connection #f)
+ (decrement-connection-gauge
+ (%postgresql-connections-name)))))
(define* (with-postgresql-transaction conn f
#:key always-rollback?)