From aca5f8ca05956011c678fad80219fb2ee9526c98 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 8 Sep 2024 10:20:21 +0100
Subject: [PATCH] Add a new background connection pool

Mostly to constrain the build server event handlers.
---
 .../web/build-server/controller.scm            |  2 +-
 guix-data-service/web/controller.scm           |  4 ++++
 guix-data-service/web/server.scm               | 18 ++++++++++++++++--
 3 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm
index 70ee22e..570ae2f 100644
--- a/guix-data-service/web/build-server/controller.scm
+++ b/guix-data-service/web/build-server/controller.scm
@@ -124,7 +124,7 @@
   (define (spawn-fiber-for-handler handler)
     (spawn-fiber
      (lambda ()
-       (with-resource-from-pool (connection-pool) conn
+       (with-resource-from-pool (background-connection-pool) conn
          (with-exception-handler
              (lambda (exn)
                (simple-format
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 8f23af7..c69f9e6 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -75,9 +75,13 @@
             make-render-metrics
             controller
 
+            background-connection-pool
             connection-pool
             reserved-connection-pool))
 
+(define background-connection-pool
+  (make-parameter #f))
+
 (define connection-pool
   (make-parameter #f))
 
diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm
index 4e48802..4a38a72 100644
--- a/guix-data-service/web/server.scm
+++ b/guix-data-service/web/server.scm
@@ -198,7 +198,21 @@ port. Also, the port used can be changed by passing the --port option.\n"
                   (primitive-exit 1))
               (lambda ()
                 (parameterize
-                    ((connection-pool
+                    ((background-connection-pool
+                      (make-resource-pool
+                       (lambda ()
+                         (open-postgresql-connection
+                          "background"
+                          postgresql-statement-timeout))
+                       4
+                       #:name "background"
+                       #:idle-seconds 5
+                       #:destructor
+                       (lambda (conn)
+                         (close-postgresql-connection conn "background"))
+                       #:scheduler priority-scheduler))
+
+                     (connection-pool
                       (make-resource-pool
                        (lambda ()
                          (open-postgresql-connection
@@ -246,7 +260,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
 
                   (spawn-fiber
                    (lambda ()
-                     (with-resource-from-pool (connection-pool) conn
+                     (with-resource-from-pool (background-connection-pool) conn
                        (backfill-guix-revision-package-derivation-distribution-counts
                         conn)))
                    request-scheduler)