07/07: Try to avoid the metrics timing out

[Christopher Baines]

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

commit 37a07c2d6e8285877ad0440a7e4ae286b7b65177
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Nov 9 16:44:28 2023 +0000

    Try to avoid the metrics timing out
    
    As that makes debugging problems harder.
---
 guix-data-service/web/controller.scm | 45 ++++++++++++++++++++++++++++++------
 1 file changed, 38 insertions(+), 7 deletions(-)

diff --git a/guix-data-service/web/controller.scm 
b/guix-data-service/web/controller.scm
index a7ed02c..de7ba7c 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -209,6 +209,17 @@
           (metric-set internal-run-time
                       (get-internal-run-time)))))
 
+    (define (with-statement-timeout conn proc)
+      (with-postgresql-transaction
+       conn
+       (lambda (conn)
+         (exec-query
+          conn
+          (simple-format #f "SET statement_timeout = ~A" 6000))
+
+         (proc conn))
+       #:always-rollback? #t))
+
     (lambda ()
       (letpar& ((metric-values
                  (with-exception-handler
@@ -221,7 +232,10 @@
                    (lambda ()
                      (call-with-resource-from-pool
                          (reserved-connection-pool)
-                       fetch-high-level-table-size-metrics))
+                       (lambda (conn)
+                         (with-statement-timeout
+                          conn
+                          fetch-high-level-table-size-metrics))))
                    #:unwind? #t))
                 (guix-revisions-count
                  (with-exception-handler
@@ -234,7 +248,10 @@
                    (lambda ()
                      (call-with-resource-from-pool
                          (reserved-connection-pool)
-                       count-guix-revisions))
+                       (lambda (conn)
+                         (with-statement-timeout
+                          conn
+                          count-guix-revisions))))
                    #:unwind? #t))
                 (pg-stat-user-tables-metrics
                  (with-exception-handler
@@ -247,7 +264,10 @@
                    (lambda ()
                      (call-with-resource-from-pool
                          (reserved-connection-pool)
-                       fetch-pg-stat-user-tables-metrics))
+                       (lambda (conn)
+                         (with-statement-timeout
+                          conn
+                          fetch-pg-stat-user-tables-metrics))))
                    #:unwind? #t))
                 (pg-stat-user-indexes-metrics
                  (with-exception-handler
@@ -260,7 +280,10 @@
                    (lambda ()
                      (call-with-resource-from-pool
                          (reserved-connection-pool)
-                       fetch-pg-stat-user-indexes-metrics))
+                       (lambda (conn)
+                         (with-statement-timeout
+                          conn
+                          fetch-pg-stat-user-indexes-metrics))))
                    #:unwind? #t))
                 (pg-stats-metric-values
                  (with-exception-handler
@@ -273,7 +296,10 @@
                    (lambda ()
                      (call-with-resource-from-pool
                          (reserved-connection-pool)
-                       fetch-pg-stats-metrics))
+                       (lambda (conn)
+                         (with-statement-timeout
+                          conn
+                          fetch-pg-stats-metrics))))
                    #:unwind? #t))
                 (load-new-guix-revision-job-metrics
                  (with-exception-handler
@@ -286,7 +312,10 @@
                    (lambda ()
                      (call-with-resource-from-pool
                          (reserved-connection-pool)
-                       select-load-new-guix-revision-job-metrics))
+                       (lambda (conn)
+                         (with-statement-timeout
+                          conn
+                          select-load-new-guix-revision-job-metrics))))
                    #:unwind? #t)))
 
         (for-each
@@ -785,7 +814,9 @@
          #:sxml (view-statistics guix-revisions-count
                                  count-derivations))))
      (('GET "metrics")
-      (render-metrics))
+      (parameterize
+          ((resource-pool-default-timeout 6))
+        (render-metrics)))
      (('GET "revision" args ...)
       (delegate-to revision-controller))
      (('GET "repositories")