02/02: Add a Prometheus metrics page, with some database metrics

[Christopher Baines]

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

commit c596a1c6a90bb2fe07da5339b8dc832b81d94194
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sun Sep 6 13:14:31 2020 +0100

    Add a Prometheus metrics page, with some database metrics
    
    The database size is growing, but it's hard to know what parts are growing 
the
    fastest. These metrics will hopefully help with understanding that.
---
 Makefile.am                          |  1 +
 guix-data-service/metrics.scm        | 79 ++++++++++++++++++++++++++++++++++++
 guix-data-service/web/controller.scm | 44 ++++++++++++++++++++
 3 files changed, 124 insertions(+)

diff --git a/Makefile.am b/Makefile.am
index 1545dbb..ad5b26a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -73,6 +73,7 @@ SOURCES =                                                     
                \
   guix-data-service/comparison.scm                                             
\
   guix-data-service/config.scm                                                 
\
   guix-data-service/database.scm                                               
\
+  guix-data-service/metrics.scm                                                
\
   guix-data-service/substitutes.scm                                            
\
   guix-data-service/utils.scm                                                  
\
   guix-data-service/data-deletion.scm                                          
\
diff --git a/guix-data-service/metrics.scm b/guix-data-service/metrics.scm
new file mode 100644
index 0000000..0e5531c
--- /dev/null
+++ b/guix-data-service/metrics.scm
@@ -0,0 +1,79 @@
+;;; Guix Data Service -- Information about Guix over time
+;;; Copyright © 2020 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
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-data-service metrics)
+  #:use-module (ice-9 match)
+  #:use-module (squee)
+  #:export (fetch-high-level-table-size-metrics))
+
+(define (fetch-high-level-table-size-metrics conn)
+  ;; Adapted from https://wiki.postgresql.org/wiki/Disk_Usage
+  (define query
+    "
+WITH RECURSIVE pg_inherit(inhrelid, inhparent) AS (
+  SELECT inhrelid, inhparent
+  FROM pg_inherits
+  UNION
+  SELECT child.inhrelid, parent.inhparent
+  FROM pg_inherit child, pg_inherits parent
+  WHERE child.inhparent = parent.inhrelid
+), pg_inherit_short AS (
+  SELECT *
+  FROM pg_inherit
+  WHERE inhparent NOT IN (SELECT inhrelid FROM pg_inherit)
+)
+SELECT table_name,
+       row_estimate,
+       table_bytes,
+       index_bytes,
+       toast_bytes
+FROM (
+  SELECT *, total_bytes-index_bytes-COALESCE(toast_bytes,0) AS table_bytes
+  FROM (
+    SELECT c.oid,
+           nspname AS table_schema,
+           relname AS table_name,
+           SUM(c.reltuples) OVER (partition BY parent) AS row_estimate,
+           SUM(pg_total_relation_size(c.oid)) OVER (partition BY parent) AS 
total_bytes,
+           SUM(pg_indexes_size(c.oid)) OVER (partition BY parent) AS 
index_bytes,
+           SUM(pg_total_relation_size(reltoastrelid)) OVER (partition BY 
parent) AS toast_bytes,
+           parent
+    FROM (
+      SELECT pg_class.oid,
+             reltuples,
+             relname,
+             relnamespace,
+             pg_class.reltoastrelid,
+             COALESCE(inhparent, pg_class.oid) parent
+      FROM pg_class
+      LEFT JOIN pg_inherit_short ON inhrelid = oid
+      WHERE relkind IN ('r', 'p')
+    ) c
+    LEFT JOIN pg_namespace n ON n.oid = c.relnamespace
+  ) a
+  WHERE oid = parent
+    AND table_schema = 'guix_data_service'
+) a;")
+
+  (map (match-lambda
+         ((name row-estimate table-bytes index-bytes toast-bytes)
+          (list name
+                (or (string->number row-estimate) 0)
+                (or (string->number table-bytes) 0)
+                (or (string->number index-bytes) 0)
+                (or (string->number toast-bytes) 0))))
+       (exec-query conn query)))
diff --git a/guix-data-service/web/controller.scm 
b/guix-data-service/web/controller.scm
index 683ace1..a9a8a3e 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -33,9 +33,11 @@
   #:use-module (texinfo html)
   #:use-module (squee)
   #:use-module (json)
+  #:use-module (prometheus)
   #:use-module (guix-data-service config)
   #:use-module (guix-data-service comparison)
   #:use-module (guix-data-service database)
+  #:use-module (guix-data-service metrics)
   #:use-module (guix-data-service model git-branch)
   #:use-module (guix-data-service model git-repository)
   #:use-module (guix-data-service model guix-revision)
@@ -80,6 +82,46 @@
         target
         (list functions ...)))
 
+(define render-metrics
+  (let* ((registry                  (make-metrics-registry
+                                     #:namespace "guixdataservice"))
+         (table-row-estimate-metric (make-gauge-metric registry
+                                                       "table_row_estimate"
+                                                       #:labels '(name)))
+         (table-bytes-metric        (make-gauge-metric registry
+                                                       "table_bytes"
+                                                       #:labels '(name)))
+         (table-index-bytes-metric  (make-gauge-metric registry
+                                                       "table_index_bytes"
+                                                       #:labels '(name)))
+         (table-toast-bytes-metric  (make-gauge-metric registry
+                                                       "table_toast_bytes"
+                                                       #:labels '(name))))
+    (lambda (conn)
+      (let ((metric-values (fetch-high-level-table-size-metrics conn)))
+        (for-each (match-lambda
+                    ((name row-estimate table-bytes index-bytes toast-bytes)
+
+                     (metric-set table-row-estimate-metric
+                                 row-estimate
+                                 #:label-values `((name . ,name)))
+                     (metric-set table-bytes-metric
+                                 table-bytes
+                                 #:label-values `((name . ,name)))
+                     (metric-set table-index-bytes-metric
+                                 index-bytes
+                                 #:label-values `((name . ,name)))
+                     (metric-set table-toast-bytes-metric
+                                 toast-bytes
+                                 #:label-values `((name . ,name)))))
+                  metric-values))
+
+      (list (build-response
+             #:code 200
+             #:headers '((content-type . (text/plain))))
+            (lambda (port)
+              (write-metrics registry port))))))
+
 (define (render-derivation conn derivation-file-name)
   (let ((derivation (select-derivation-by-file-name conn
                                                     derivation-file-name)))
@@ -403,6 +445,8 @@
      (render-html
       #:sxml (view-statistics (count-guix-revisions conn)
                               (count-derivations conn))))
+    (('GET "metrics")
+     (render-metrics conn))
     (('GET "revision" args ...)
      (delegate-to revision-controller))
     (('GET "repositories")