Pull fetching the event to process out of the process-event procedure

This will make introducing processing hook events in parallel easier.

1 files changed, 48 insertions, 50 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 52dd50c..08eecf3 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -692,51 +692,47 @@
      "hook_failure_total"
      #:labels '(event)))
 
-  (define (process-event event-name handler)
-    (match (datastore-list-unprocessed-hook-events datastore event-name 1)
-      (() #f)
-      (((id event arguments))
-       (catch
-         #t
-         (lambda ()
-           (log-msg (build-coordinator-logger build-coordinator)
-                    'DEBUG
-                    "processing " event " event: " arguments)
-           (with-throw-handler #t
+  (define (process-event id event arguments handler)
+    (catch
+      #t
+      (lambda ()
+        (log-msg (build-coordinator-logger build-coordinator)
+                 'DEBUG
+                 "processing " event " event: " arguments)
+        (with-throw-handler #t
+          (lambda ()
+            (call-with-duration-metric
+             (build-coordinator-metrics-registry build-coordinator)
+             "hook_duration_seconds"
              (lambda ()
-               (call-with-duration-metric
-                (build-coordinator-metrics-registry build-coordinator)
-                "hook_duration_seconds"
-                (lambda ()
-                  (apply handler build-coordinator arguments))
-                #:labels '(event)
-                #:label-values `((event . ,event))))
-             (lambda _
-               (backtrace)))
-           (log-msg (build-coordinator-logger build-coordinator)
-                    'DEBUG
-                    event " handler finished")
-           (datastore-delete-unprocessed-hook-event datastore id)
-
-           ;; If this is the hook for a successful build, once the hook
-           ;; completed successfully, delete the nar files for this build.
-           (when (eq? 'build-success event)
-             (match arguments
-               ((build-id)
-                (let ((data-location (build-data-location build-id)))
-                  (when (file-exists? data-location)
-                    (delete-file-recursively data-location))))))
-           (metric-increment success-counter-metric
-                             #:label-values
-                             `((event . ,event))))
-         (lambda (key . args)
-           (log-msg (build-coordinator-logger build-coordinator)
-                    'ERROR
-                    "error running " event " hook: " key " " args)
-           (metric-increment failure-counter-metric
-                             #:label-values
-                             `((event . ,event)))))
-       #t)))
+               (apply handler build-coordinator arguments))
+             #:labels '(event)
+             #:label-values `((event . ,event))))
+          (lambda _
+            (backtrace)))
+        (log-msg (build-coordinator-logger build-coordinator)
+                 'DEBUG
+                 event " handler finished")
+        (datastore-delete-unprocessed-hook-event datastore id)
+
+        ;; If this is the hook for a successful build, once the hook
+        ;; completed successfully, delete the nar files for this build.
+        (when (eq? 'build-success event)
+          (match arguments
+            ((build-id)
+             (let ((data-location (build-data-location build-id)))
+               (when (file-exists? data-location)
+                 (delete-file-recursively data-location))))))
+        (metric-increment success-counter-metric
+                          #:label-values
+                          `((event . ,event))))
+      (lambda (key . args)
+        (log-msg (build-coordinator-logger build-coordinator)
+                 'ERROR
+                 "error running " event " hook: " key " " args)
+        (metric-increment failure-counter-metric
+                          #:label-values
+                          `((event . ,event))))))
 
   (map
    (match-lambda
@@ -764,12 +760,14 @@
                      #:unwind? #t))
                (lambda ()
                  (while #t
-                   (unless (process-event event-name handler)
-                     (wait-condition-variable condvar
-                                              mtx
-                                              (+ (time-second (current-time))
-                                                 wait-timeout-seconds
-                                                 (random 30))))))
+                   (match (datastore-list-unprocessed-hook-events datastore event-name 1)
+                     (()
+                      (wait-condition-variable condvar
+                                               mtx
+                                               (+ (time-second (current-time))
+                                                  wait-timeout-seconds)))
+                     (((id event arguments))
+                      (process-event id event arguments handler)))))
                #:unwind? #t)
              (sleep 10))))
         (cons event-name condvar))))