02/02: Track some pg_stat metrics

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit 7f49756bac06bda7f0df72345d604196dee0e3f9
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Oct 1 21:43:41 2020 +0100

    Track some pg_stat metrics
    
    Hopefully this'll help track database things better.
---
 guix-data-service/metrics.scm        | 46 +++++++++++++++++++++++++++++++++++-
 guix-data-service/web/controller.scm | 38 ++++++++++++++++++++++++++++-
 2 files changed, 82 insertions(+), 2 deletions(-)

diff --git a/guix-data-service/metrics.scm b/guix-data-service/metrics.scm
index 0e5531c..d330c88 100644
--- a/guix-data-service/metrics.scm
+++ b/guix-data-service/metrics.scm
@@ -18,7 +18,8 @@
 (define-module (guix-data-service metrics)
   #:use-module (ice-9 match)
   #:use-module (squee)
-  #:export (fetch-high-level-table-size-metrics))
+  #:export (fetch-high-level-table-size-metrics
+            fetch-pg-stat-user-tables-metrics))
 
 (define (fetch-high-level-table-size-metrics conn)
   ;; Adapted from https://wiki.postgresql.org/wiki/Disk_Usage
@@ -77,3 +78,46 @@ FROM (
                 (or (string->number index-bytes) 0)
                 (or (string->number toast-bytes) 0))))
        (exec-query conn query)))
+
+(define (fetch-pg-stat-user-tables-metrics conn)
+  (define query
+    "
+SELECT relname, seq_scan, seq_tup_read,
+       idx_scan, idx_tup_fetch,
+       n_tup_ins, n_tup_upd, n_tup_del, n_tup_hot_upd,
+       n_live_tup, n_dead_tup, n_mod_since_analyze,
+       COALESCE(extract(epoch from last_vacuum), 0),
+       COALESCE(extract(epoch from last_autovacuum), 0),
+       COALESCE(extract(epoch from last_analyze), 0),
+       COALESCE(extract(epoch from last_autoanalyze), 0),
+       vacuum_count, autovacuum_count, analyze_count, autoanalyze_count
+ FROM pg_stat_user_tables")
+
+  (map (match-lambda
+         ((relname seq-scan seq-tup-read
+                   idx-scan idx-tup-fetch
+                   n-tup-ins n-tup-upd n-tup-del n-tup-hot-upd
+                   n-live-tup n-dead-tup n-mod-since-analyze
+                   last-vacuum last-autovacuum last-analyze last-autoanalyze
+                   vacuum-count autovacuum-count analyze-count 
autoanalyze-count)
+          `((name                . ,relname)
+            (seq-scan            . ,seq-scan)
+            (seq-tup-read        . ,seq-tup-read)
+            (idx-scan            . ,idx-scan)
+            (idx-tup-fetch       . ,idx-tup-fetch)
+            (n-tup-ins           . ,n-tup-ins)
+            (n-tup-upd           . ,n-tup-upd)
+            (n-tup-del           . ,n-tup-del)
+            (n-tup-hot-upd       . ,n-tup-hot-upd)
+            (n-live-tup          . ,n-live-tup)
+            (n-dead-tup          . ,n-dead-tup)
+            (n-mod-since-analyze . ,n-mod-since-analyze)
+            (last-vacuum         . ,last-vacuum)
+            (last-autovacuum     . ,last-autovacuum)
+            (last-analyze        . ,last-analyze)
+            (last-autoanalyze    . ,last-autoanalyze)
+            (vacuum-count        . ,vacuum-count)
+            (autovacuum-count    . ,autovacuum-count)
+            (analyze-count       . ,analyze-count)
+            (autoanalyze-count   . ,autoanalyze-count))))
+       (exec-query conn query)))
diff --git a/guix-data-service/web/controller.scm 
b/guix-data-service/web/controller.scm
index 0e0150e..4cf1f82 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -21,6 +21,7 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 pretty-print)
   #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 string-fun)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -106,7 +107,28 @@
                                                        #:labels '(name)))
          (table-toast-bytes-metric  (make-gauge-metric registry
                                                        "table_toast_bytes"
-                                                       #:labels '(name))))
+                                                       #:labels '(name)))
+
+         (pg-stat-fields '(seq-scan seq-tup-read idx-scan idx-tup-fetch
+                           n-tup-ins n-tup-upd n-tup-del
+                           n-tup-hot-upd n-live-tup n-dead-tup
+                           n-mod-since-analyze last-vacuum
+                           last-autovacuum last-analyze last-autoanalyze
+                           vacuum-count autovacuum-count
+                           analyze-count autoanalyze-count))
+
+         (pg-stat-metrics (map (lambda (field)
+                                 (cons
+                                  field
+                                  (make-gauge-metric
+                                   registry
+                                   (string-append "pg_stat_"
+                                                  (string-replace-substring
+                                                   (symbol->string field)
+                                                   "-"
+                                                   "_"))
+                                   #:labels '(name))))
+                               pg-stat-fields)))
     (lambda (conn)
       (let ((metric-values (fetch-high-level-table-size-metrics conn)))
         (for-each (match-lambda
@@ -129,6 +151,20 @@
       (metric-set revisions-count-metric
                   (count-guix-revisions conn))
 
+      (map (lambda (field-values)
+             (let ((name (assq-ref field-values 'name)))
+               (for-each
+                (match-lambda
+                  (('name . _) #f)
+                  ((field . value)
+                   (let ((metric (or (assq-ref pg-stat-metrics field)
+                                     (error field))))
+                     (metric-set metric
+                                 value
+                                 #:label-values `((name . ,name))))))
+                field-values)))
+           (fetch-pg-stat-user-tables-metrics conn))
+
       (for-each (match-lambda
                   ((repository-label completed count)
                    (metric-set