01/05: Make the build event handling code more generic

[Christopher Baines]

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

commit 7524d23b44b7aa3db42b9d5344eefa6440467189
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Tue Jun 6 12:32:53 2023 +0100

    Make the build event handling code more generic
    
    So that triggering a check for substitutes can be integrated in.
---
 guix-data-service/web/build-server/controller.scm | 84 +++++++++++++----------
 1 file changed, 48 insertions(+), 36 deletions(-)

diff --git a/guix-data-service/web/build-server/controller.scm 
b/guix-data-service/web/build-server/controller.scm
index bbc4a93..babf59d 100644
--- a/guix-data-service/web/build-server/controller.scm
+++ b/guix-data-service/web/build-server/controller.scm
@@ -120,10 +120,32 @@
   (define build-server-id
     (string->number build-server-id-string))
 
-  (define (spawn-fiber-for-build-handler handler
-                                         statuses
-                                         data
-                                         build-ids)
+  (define (call-via-thread-pool-channel 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)))))))
+
+  (define (with-build-ids-for-status data
+                                     build-ids
+                                     statuses
+                                     handler)
     (let ((ids
            (delete-duplicates
             (filter-map
@@ -138,26 +160,7 @@
              data)
             =)))
       (unless (null? ids)
-        (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 ids))
-                     (lambda _
-                       (display (backtrace) (current-error-port))
-                       (display "\n" (current-error-port)))))
-                 #:unwind? #t)))))))))
+        (handler ids))))
 
   (define (handle-derivation-events conn items)
     (if (null? items)
@@ -223,23 +226,32 @@
                       conn
                       filtered-items)))))))
 
-      (spawn-fiber-for-build-handler
-       handle-removing-blocking-build-entries-for-successful-builds
-       '("succeeded")
+      (with-build-ids-for-status
        items
-       build-ids)
+       build-ids
+       '("succeeded")
+       (lambda (ids)
+         (call-via-thread-pool-channel
+          (lambda (conn)
+            (handle-removing-blocking-build-entries-for-successful-builds conn 
ids)))))
 
-      (spawn-fiber-for-build-handler
-       handle-blocked-builds-entries-for-scheduled-builds
-       '("scheduled")
+      (with-build-ids-for-status
        items
-       build-ids)
+       build-ids
+       '("scheduled")
+       (lambda (ids)
+         (call-via-thread-pool-channel
+          (lambda (conn)
+            (handle-blocked-builds-entries-for-scheduled-builds conn ids)))))
 
-      (spawn-fiber-for-build-handler
-       handle-populating-blocked-builds-for-build-failures
-       '("failed" "failed-dependency" "canceled")
+      (with-build-ids-for-status
        items
-       build-ids)))
+       build-ids
+       '("failed" "failed-dependency" "canceled")
+       (lambda (ids)
+         (call-via-thread-pool-channel
+          (lambda (conn)
+            (handle-populating-blocked-builds-for-build-failures conn 
ids)))))))
 
   (if (any-invalid-query-parameters? parsed-query-parameters)
       (render-json