Switch to a database table rather than a channel for hook events

The channel caused problems, as it would potentially block processing requests
if the hook event couldn't be processed immediately. This approach should
avoid that, as well as providing more reliability because the events are
stored in the database.

2 files changed, 24 insertions, 67 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index dacf254..103e962 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -80,9 +80,6 @@ if there was no request body."
   (define trigger-build-allocation
     (make-build-allocator-thread datastore))
 
-  (define hook-channel
-    (make-hook-channel datastore hooks))
-
   (define chunked-request-channel
     ;; There are fibers issues when trying to read the chunked requests
     (make-worker-thread-channel (const '())
@@ -92,6 +89,7 @@ if there was no request body."
     (base-datastore-metrics-updater datastore
                                     coordinator-metrics-registry))
 
+  (start-hook-processing-thread datastore hooks)
   (trigger-build-allocation)
   (call-with-error-handling
    (lambda ()
@@ -110,7 +108,6 @@ if there was no request body."
                            secret-key-base
                            datastore
                            trigger-build-allocation
-                           hook-channel
                            chunked-request-channel
                            update-base-datastore-metrics!)))
       #:host host
@@ -221,7 +218,6 @@ port. Also, the port used can be changed by passing the --port option.\n"
                     secret-key-base
                     datastore
                     trigger-build-allocation
-                    hook-channel
                     chunked-request-channel
                     update-base-datastore-metrics!)
   (define (authenticated? uuid request)
@@ -289,8 +285,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
                        (backtrace)
                        (raise-exception exn))
                    (lambda ()
-                     (handle-build-result datastore hook-channel
-                                          agent-id-for-build uuid
+                     (handle-build-result datastore agent-id-for-build uuid
                                           (json-string->scm (utf8->string body)))
                      ;; Trigger build allocation, as the result of this build
                      ;; could change the allocation
@@ -307,7 +302,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
          (if (authenticated? agent-id-for-build request)
              (begin
                (handle-setup-failure-report
-                datastore hook-channel
+                datastore
                 agent-id-for-build uuid
                 (json-string->scm (utf8->string body)))
                ;; Trigger build allocation, so that the allocator can handle
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index fd11161..ce67cfd 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -41,7 +41,7 @@
             fetch-builds
             agent-details
             make-build-allocator-thread
-            make-hook-channel
+            start-hook-processing-thread
 
             build-output-file-location
             build-log-file-location
@@ -151,48 +151,23 @@
 
   trigger-build-allocation)
 
-
-(define (make-hook-channel datastore hooks)
-  (let ((channel (make-channel)))
-    (call-with-new-thread
-     (lambda ()
-       (let loop ((message (get-message channel)))
-         (match message
-           (('build-success build-id)
-            (catch
-              #t
-              (lambda ()
-                ((assq-ref hooks 'build-success) datastore build-id))
-              (lambda (key . args)
-                (simple-format #t "error: running build-success hook: ~A ~A\n"
-                               key args)
-                #f)))
-           (('build-failure build-id)
-            (catch
-              #t
-              (lambda ()
-                ((assq-ref hooks 'build-failure) datastore build-id))
-              (lambda (key . args)
-                (simple-format #t "error: running build-failure hook: ~A ~A\n"
-                               key args)
-                #f)))
-           (('build-missing-inputs build-id missing-inputs)
-            (catch
-              #t
-              (lambda ()
-                ((assq-ref hooks 'build-missing-inputs) datastore build-id
-                                                        missing-inputs))
-              (lambda (key . args)
-                (simple-format
-                 #t "error: running build-missing-inputs hook: ~A ~A\n"
-                 key args)
-                #f)))
-           (unknown
-            (simple-format #t "error: hooks: unknown message: ~A\n"
-                           unknown)))
-         (loop (get-message channel)))))
-
-    channel))
+(define (start-hook-processing-thread datastore hooks)
+  (call-with-new-thread
+   (lambda ()
+     (while #t
+       (match (datastore-list-unprocessed-hook-events datastore 1)
+         (() (sleep 1))
+         (((id event arguments))
+          (catch
+            #t
+            (lambda ()
+              (apply (assq-ref hooks event) datastore arguments)
+              (datastore-delete-unprocessed-hook-event datastore id))
+            (lambda (key . args)
+              (simple-format #t "error: running ~A hook: ~A ~A\n"
+                             event key args)
+              #f)))))))
+  #t)
 
 (define (fetch-builds datastore agent)
   (call-with-duration-metric
@@ -250,7 +225,7 @@
               (simple-format #f "found multiple files for ~A: ~A"
                              build-id files))))))
 
-(define (handle-build-result datastore hook-channel
+(define (handle-build-result datastore
                              agent-id build-id result-json)
   (call-with-duration-metric
    coordinator-metrics-registry
@@ -291,16 +266,9 @@
                                          (vector->list
                                           (assoc-ref result-json "outputs"))
                                          #f))
-
-       (put-message hook-channel
-                    (list (if (string=? result "success")
-                              'build-success
-                              'build-failure)
-                          build-id))
-
        #t))))
 
-(define (handle-setup-failure-report datastore hook-channel
+(define (handle-setup-failure-report datastore
                                      agent-id build-id report-json)
   (let ((failure-reason (assoc-ref report-json "failure_reason")))
     (if (string=? failure-reason "missing_inputs")
@@ -311,13 +279,7 @@
           (datastore-store-setup-failure/missing-inputs datastore
                                                         build-id
                                                         agent-id
-                                                        missing-inputs)
-
-          (put-message hook-channel
-                       (list 'build-missing-inputs
-                             build-id
-                             missing-inputs)))
-
+                                                        missing-inputs))
         (datastore-store-setup-failure datastore
                                        build-id
                                        agent-id