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, 61 insertions, 69 deletions

diff --git a/guix-data-service/web/build-server/controller.scm b/guix-data-service/web/build-server/controller.scm
index 7c31cf1..ca03284 100644
--- a/guix-data-service/web/build-server/controller.scm
+++ b/guix-data-service/web/build-server/controller.scm
@@ -26,6 +26,7 @@
   #:use-module (guix-data-service substitutes)
   #:use-module (guix-data-service web render)
   #:use-module (guix-data-service web query-parameters)
+  #:use-module (guix-data-service web controller)
   #:use-module (guix-data-service jobs load-new-guix-revision)
   #:use-module (guix-data-service model utils)
   #:use-module (guix-data-service model build)
@@ -60,18 +61,16 @@
              (build-server-build-id
               (assq-ref query-parameters 'build_server_build_id))
              (build
-              (parallel-via-thread-pool-channel
-               (with-thread-postgresql-connection
-                (lambda (conn)
-                  (if build-server-build-id
-                      (select-build-by-build-server-and-build-server-build-id
-                       conn
-                       build-server-id
-                       build-server-build-id)
-                      (select-build-by-build-server-and-derivation-file-name
-                       conn
-                       build-server-id
-                       derivation-file-name)))))))
+              (with-resource-from-pool (connection-pool) conn
+                (if build-server-build-id
+                    (select-build-by-build-server-and-build-server-build-id
+                     conn
+                     build-server-id
+                     build-server-build-id)
+                    (select-build-by-build-server-and-derivation-file-name
+                     conn
+                     build-server-id
+                     derivation-file-name)))))
         (if build
             (render-html
              #:sxml
@@ -88,13 +87,11 @@
                                                  ; guix-build-coordinator
                                                  ; doesn't mark builds as
                                                  ; failed-dependency
-                                (parallel-via-thread-pool-channel
-                                 (with-thread-postgresql-connection
-                                  (lambda (conn)
-                                    (select-required-builds-that-failed
-                                     conn
-                                     build-server-id
-                                     derivation-file-name))))
+                                (with-resource-from-pool (connection-pool) conn
+                                  (select-required-builds-that-failed
+                                   conn
+                                   build-server-id
+                                   derivation-file-name))
                                 #f)))))
             (render-html
              #:sxml (general-not-found
@@ -121,27 +118,26 @@
   (define build-server-id
     (string->number build-server-id-string))
 
-  (define (call-via-thread-pool-channel handler)
+  (define (spawn-fiber-for-handler handler)
     (spawn-fiber
      (lambda ()
-       (parallel-via-thread-pool-channel
-        (with-postgresql-connection
-         "build-event-handler-conn"
-         (lambda (conn)
-           (with-exception-handler
-               (lambda (exn)
-                 (simple-format
-                  (current-error-port)
-                  "exception in build event handler: ~A\n"
-                  exn))
-             (lambda ()
-               (with-throw-handler #t
-                 (lambda ()
-                   (handler conn))
-                 (lambda _
-                   (display (backtrace) (current-error-port))
-                   (display "\n" (current-error-port)))))
-             #:unwind? #t)))))))
+       (with-postgresql-connection
+        "build-event-handler-conn"
+        (lambda (conn)
+          (with-exception-handler
+              (lambda (exn)
+                (simple-format
+                 (current-error-port)
+                 "exception in build event handler: ~A\n"
+                 exn))
+            (lambda ()
+              (with-throw-handler #t
+                (lambda ()
+                  (handler conn))
+                (lambda _
+                  (display (backtrace) (current-error-port))
+                  (display "\n" (current-error-port)))))
+            #:unwind? #t))))))
 
   (define (with-build-ids-for-status data
                                      build-ids
@@ -217,24 +213,24 @@
                         #f))))
               items))
 
-    (letpar& ((build-ids
-               (with-thread-postgresql-connection
-                (lambda (conn)
-                  (with-postgresql-transaction
-                   conn
-                   (lambda (conn)
-                     (handle-derivation-events
-                      conn
-                      filtered-items)))))))
+    (let ((build-ids
+           (with-resource-from-pool (reserved-connection-pool) conn
+             (with-postgresql-transaction
+              conn
+              (lambda (conn)
+                (handle-derivation-events
+                 conn
+                 filtered-items))))))
 
       (with-build-ids-for-status
        items
        build-ids
        '("succeeded")
        (lambda (ids)
-         (call-via-thread-pool-channel
+         (spawn-fiber-for-handler
           (lambda (conn)
-            (handle-removing-blocking-build-entries-for-successful-builds conn ids)))
+            (handle-removing-blocking-build-entries-for-successful-builds
+             conn ids)))
 
          (request-query-of-build-server-substitutes build-server-id
                                                     ids)))
@@ -244,7 +240,7 @@
        build-ids
        '("scheduled")
        (lambda (ids)
-         (call-via-thread-pool-channel
+         (spawn-fiber-for-handler
           (lambda (conn)
             (handle-blocked-builds-entries-for-scheduled-builds conn ids)))))
 
@@ -253,7 +249,7 @@
        build-ids
        '("failed" "failed-dependency" "canceled")
        (lambda (ids)
-         (call-via-thread-pool-channel
+         (spawn-fiber-for-handler
           (lambda (conn)
             (handle-populating-blocked-builds-for-build-failures conn ids)))))))
 
@@ -263,12 +259,10 @@
        #:code 400)
       (let ((provided-token (assq-ref parsed-query-parameters 'token))
             (permitted-tokens
-             (parallel-via-thread-pool-channel
-              (with-thread-postgresql-connection
-               (lambda (conn)
-                 (compute-tokens-for-build-server conn
-                                                  secret-key-base
-                                                  build-server-id))))))
+             (with-resource-from-pool (reserved-connection-pool) conn
+               (compute-tokens-for-build-server conn
+                                                secret-key-base
+                                                build-server-id))))
         (if (member provided-token
                     (map cdr permitted-tokens)
                     string=?)
@@ -317,10 +311,8 @@
 (define (handle-signing-key-request id)
   (render-html
    #:sxml (view-signing-key
-           (parallel-via-thread-pool-channel
-            (with-thread-postgresql-connection
-             (lambda (conn)
-               (select-signing-key conn id)))))))
+           (with-resource-from-pool (connection-pool) conn
+             (select-signing-key conn id)))))
 
 (define (build-server-controller request
                                  method-and-path-components
@@ -329,17 +321,17 @@
                                  secret-key-base)
   (match method-and-path-components
     (('GET "build-servers")
-     (letpar& ((build-servers
-                (with-thread-postgresql-connection
-                 select-build-servers)))
+     (let ((build-servers
+            (with-resource-from-pool (connection-pool) conn
+              select-build-servers)))
        (render-build-servers mime-types
                              build-servers)))
     (('GET "build-server" build-server-id)
-     (letpar& ((build-server
-                (with-thread-postgresql-connection
-                 (lambda (conn)
-                   (select-build-server conn (string->number
-                                              build-server-id))))))
+     (let ((build-server
+            (with-resource-from-pool (connection-pool) conn
+              (lambda (conn)
+                (select-build-server conn (string->number
+                                           build-server-id))))))
        (if build-server
            (render-build-server mime-types
                                 build-server)