From 7251c7d653de29f36d50b33badf05a5db983b8e7 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 9 Jul 2023 16:52:35 +0100
Subject: 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.
---
 guix-data-service/web/jobs/controller.scm | 51 +++++++++++++++----------------
 1 file changed, 25 insertions(+), 26 deletions(-)

(limited to 'guix-data-service/web/jobs')

diff --git a/guix-data-service/web/jobs/controller.scm b/guix-data-service/web/jobs/controller.scm
index 47034ee..b8b494d 100644
--- a/guix-data-service/web/jobs/controller.scm
+++ b/guix-data-service/web/jobs/controller.scm
@@ -20,6 +20,7 @@
   #:use-module (guix-data-service utils)
   #:use-module (guix-data-service database)
   #:use-module (guix-data-service web render)
+  #:use-module (guix-data-service web controller)
   #:use-module (guix-data-service web query-parameters)
   #:use-module (guix-data-service web util)
   #:use-module (guix-data-service jobs load-new-guix-revision)
@@ -73,14 +74,14 @@
   (define limit-results (assq-ref query-parameters 'limit_results))
 
   (letpar& ((jobs
-             (with-thread-postgresql-connection
-              (lambda (conn)
-                (select-jobs-and-events
-                 conn
-                 (assq-ref query-parameters 'before_id)
-                 limit-results))))
+             (with-resource-from-pool (connection-pool) conn
+               (select-jobs-and-events
+                conn
+                (assq-ref query-parameters 'before_id)
+                limit-results)))
             (recent-events
-             (with-thread-postgresql-connection
+             (call-with-resource-from-pool
+              (connection-pool)
               select-recent-job-events)))
     (case (most-appropriate-mime-type
            '(application/json text/html)
@@ -116,14 +117,13 @@
                          limit-results))))))))
 
 (define (render-job-events mime-types query-parameters)
-  (letpar& ((recent-events
-             (with-thread-postgresql-connection
-              (lambda (conn)
-                (select-recent-job-events
-                 conn
-                 ;; TODO Ideally there wouldn't be a limit
-                 #:limit (or (assq-ref query-parameters 'limit_results)
-                             1000000))))))
+  (let ((recent-events
+         (with-resource-from-pool (connection-pool) conn
+           (select-recent-job-events
+            conn
+            ;; TODO Ideally there wouldn't be a limit
+            #:limit (or (assq-ref query-parameters 'limit_results)
+                        1000000)))))
     (render-html
      #:sxml (view-job-events
              query-parameters
@@ -132,19 +132,18 @@
 (define (render-job-queue mime-types)
   (render-html
    #:sxml (view-job-queue
-           (parallel-via-thread-pool-channel
-            (with-thread-postgresql-connection
-             select-unprocessed-jobs-and-events)))))
+           (call-with-resource-from-pool
+            (connection-pool)
+            select-unprocessed-jobs-and-events))))
 
 (define (render-job mime-types job-id query-parameters)
-  (letpar& ((log-text
-             (with-thread-postgresql-connection
-              (lambda (conn)
-                (log-for-job conn job-id
-                             #:character-limit
-                             (assq-ref query-parameters 'characters)
-                             #:start-character
-                             (assq-ref query-parameters 'start_character))))))
+  (let ((log-text
+         (with-resource-from-pool (connection-pool) conn
+           (log-for-job conn job-id
+                        #:character-limit
+                        (assq-ref query-parameters 'characters)
+                        #:start-character
+                        (assq-ref query-parameters 'start_character)))))
     (case (most-appropriate-mime-type
            '(text/plain text/html)
            mime-types)
-- 
cgit v1.2.3