Add some logging in to build-coordinator-fetch-build-to-allocate

1 files changed, 38 insertions, 18 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index dc72ca9..b51c791 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -1238,24 +1238,44 @@
   (define datastore
     (build-coordinator-datastore coordinator))
 
-  (let loop ((planned-builds
-              (build-coordinator-fetch-agent-allocation-plan coordinator
-                                                             agent-id)))
-
-    (if (null? planned-builds)
-        #f
-        (match (datastore-fetch-build-to-allocate datastore (first planned-builds))
-          (#f #f)
-          (#(uuid derivation-id derivation-name derived_priority)
-
-           (if (datastore-check-if-derivation-conflicts?
-                datastore
-                agent-id
-                derivation-id)
-               (loop (cdr planned-builds))
-               `((uuid . ,uuid)
-                 (derivation_name . ,derivation-name)
-                 (derived_priority . ,derived_priority))))))))
+  (let ((all-planned-builds
+         (build-coordinator-fetch-agent-allocation-plan coordinator
+                                                        agent-id)))
+
+    (log-msg (build-coordinator-logger coordinator)
+             'DEBUG
+             "fetching build to allocate to " agent-id ", "
+             (length all-planned-builds) " to consider")
+
+    (let loop ((planned-builds all-planned-builds))
+      (if (null? planned-builds)
+          #f
+          (match (datastore-fetch-build-to-allocate datastore
+                                                    (first planned-builds))
+            (#f
+             (log-msg (build-coordinator-logger coordinator)
+                      'DEBUG
+                      agent-id ": ignoring " (first planned-builds))
+             #f)
+            (#(uuid derivation-id derivation-name derived_priority)
+
+             (if (datastore-check-if-derivation-conflicts?
+                  datastore
+                  agent-id
+                  derivation-id)
+                 (begin
+                   (log-msg (build-coordinator-logger coordinator)
+                            'DEBUG
+                            agent-id ": " uuid " conflicts with allocated build")
+                   (loop (cdr planned-builds)))
+                 (begin
+                   (log-msg (build-coordinator-logger coordinator)
+                            'DEBUG
+                            agent-id ": " uuid " selected")
+
+                   `((uuid . ,uuid)
+                     (derivation_name . ,derivation-name)
+                     (derived_priority . ,derived_priority))))))))))
 
 (define* (build-coordinator-list-allocation-plan-builds coordinator
                                                         agent-id