Stop using a pool of threads for database operations

Now that squee cooperates with suspendable ports, this is unnecessary. Use a
connection pool to still support running queries in parallel using multiple
connections.

1 files changed, 47 insertions, 18 deletions

diff --git a/guix-data-service/web/server.scm b/guix-data-service/web/server.scm
index 6570c1a..84a0e6b 100644
--- a/guix-data-service/web/server.scm
+++ b/guix-data-service/web/server.scm
@@ -25,8 +25,10 @@
   #:use-module (web uri)
   #:use-module (system repl error-handling)
   #:use-module (ice-9 atomic)
-  #:use-module (fibers web server)
+  #:use-module (fibers)
+  #:use-module (fibers conditions)
   #:use-module (prometheus)
+  #:use-module (guix-data-service utils)
   #:use-module (guix-data-service database)
   #:use-module (guix-data-service web controller)
   #:use-module (guix-data-service web util)
@@ -60,7 +62,9 @@
                        render-metrics))))
 
 (define* (start-guix-data-service-web-server port host secret-key-base
-                                             startup-completed)
+                                             startup-completed
+                                             #:key postgresql-statement-timeout
+                                             postgresql-connections)
   (define registry
     (make-metrics-registry #:namespace "guixdataservice"))
 
@@ -69,25 +73,50 @@
 
   (%database-metrics-registry registry)
 
-  (call-with-error-handling
-   (lambda ()
-     (run-server (lambda (request body)
+  (let ((finished? (make-condition)))
+    (call-with-sigint
+     (lambda ()
+       (run-fibers
+        (lambda ()
+          (parameterize
+              ((connection-pool
+                (make-resource-pool
+                 (lambda ()
+                   (open-postgresql-connection
+                    "web"
+                    postgresql-statement-timeout))
+                 (floor (/ postgresql-connections 2))))
+
+               (reserved-connection-pool
+                (make-resource-pool
+                 (lambda ()
+                   (open-postgresql-connection
+                    "web-reserved"
+                    postgresql-statement-timeout))
+                 (floor (/ postgresql-connections 2))))
+
+               (resource-pool-default-timeout 10))
+
+            (with-exception-handler
+                (lambda (exn)
+                  (simple-format
+                   (current-error-port)
+                   "\n
+error: guix-data-service could not start: ~A
+
+Check if it's already running, or whether another process is using that
+port. Also, the port used can be changed by passing the --port option.\n"
+                   exn)
+                  (primitive-exit 1))
+              (lambda ()
+                (run-server/patched
+                 (lambda (request body)
                    (handler request body controller
                             secret-key-base
                             startup-completed
                             render-metrics))
                  #:host host
                  #:port port))
-   #:on-error 'backtrace
-   #:post-error (lambda (key . args)
-                  (when (eq? key 'system-error)
-                    (match args
-                      (("bind" "~A" ("Address already in use") _)
-                       (simple-format
-                        (current-error-port)
-                        "\n
-error: guix-data-service could not start, as it could not bind to port ~A
-
-Check if it's already running, or whether another process is using that
-port. Also, the port used can be changed by passing the --port option.\n"
-                        port)))))))
+              #:unwind? #t))
+          (wait finished?))))
+     finished?)))