Have the build priorities propagate between builds

This should at least do a better job of boosting the priority of builds
required to perform builds which have high priorities.

I'm expecting this to result in contiguous chunks of builds with all the same
priority, and the ordering within those chunks isn't yet decided
intelligently.

1 files changed, 77 insertions, 26 deletions

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index bba3143..02af0b4 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -36,24 +36,24 @@
                                        args)
                                   " "))))
 
-  (define output-has-successful-build?
+  (define cached/list-builds-for-output
     (mlambda (output)
-      (log "considering missing input:" output)
-      (any (lambda (output-build)
-             (let ((build-successful?
-                    (string=? (or (assq-ref output-build 'result)
-                                  "unknown")
-                              "success")))
-               (when build-successful?
-                 (log "found successful build:" (assq-ref output-build 'uuid)))
+      (datastore-list-builds-for-output datastore output)))
 
-               build-successful?))
-           (datastore-list-builds-for-output datastore output))))
-
-  (let ((agents (datastore-list-agents datastore))
-        (builds (datastore-list-unprocessed-builds datastore))
-        (setup-failures-hash
-         (datastore-fetch-setup-failures datastore)))
+  (let* ((agents (datastore-list-agents datastore))
+         (builds (datastore-list-unprocessed-builds datastore))
+         (setup-failures-hash
+          (datastore-fetch-setup-failures datastore))
+         (derived-build-priorities-hash
+          ;; Mapping from build_id to priority, initialised at the individual
+          ;; priorities for the builds
+          (let ((table (make-hash-table (length builds))))
+            (for-each (lambda (build)
+                        (hash-set! table
+                                   (assq-ref build 'uuid)
+                                   (assq-ref build 'priority)))
+                      builds)
+            table)))
 
     (define (filter-builds-for-agent agent-id)
       (define (relevant-setup-failure? setup-failure)
@@ -62,14 +62,9 @@
                (assq-ref setup-failure 'failure-reason)))
           (cond
            ((string=? failure-reason "missing_inputs")
-            ;; If all outputs have had at least one successful build, then the
-            ;; inputs should be available. Otherwise, treat the setup failure
-            ;; as still relevant (return #t)
-            (not
-             (every output-has-successful-build?
-                    (datastore-list-setup-failure-missing-inputs
-                     datastore
-                     (assq-ref setup-failure 'id)))))
+            ;; missing_inputs setup failures that should be resolved have been
+            ;; filtered out by this point, so this is a relevant setup failure
+            #t)
            ((string=? failure-reason "could_not_delete_outputs")
             ;; This problem might go away, but just don't try the same agent
             ;; again for now.
@@ -94,8 +89,10 @@
 
     (define (build-sorting-function-for-agent agent-id)
       (lambda (a b)
-        (let ((a-priority (assq-ref a 'priority))
-              (b-priority (assq-ref b 'priority)))
+        (let ((a-priority (hash-ref derived-build-priorities-hash
+                                    (assq-ref a 'uuid)))
+              (b-priority (hash-ref derived-build-priorities-hash
+                                    (assq-ref b 'uuid))))
           (< b-priority a-priority))))
 
     (define (limit-planned-builds builds)
@@ -105,6 +102,60 @@
               builds)
           builds))
 
+    ;; Go through the setup failures and look specifically at the
+    ;; missing_inputs ones. Eliminate any missing_inputs failures if all the
+    ;; missing inputs appear to have been built successfully, and update the
+    ;; derived-build-priorities-hash to reflect the priorities of builds based
+    ;; on the builds that would be "unblocked" if they were completed.
+    (for-each
+     (lambda (setup-failure-build-id)
+       (let ((setup-failures (hash-ref setup-failures-hash
+                                       setup-failure-build-id))
+             (setup-failure-build-derived-priority
+              (hash-ref derived-build-priorities-hash
+                        setup-failure-build-id)))
+         (for-each
+          (lambda (setup-failure)
+            (when (string=? "missing_inputs"
+                            (assq-ref setup-failure 'failure-reason))
+              (for-each
+               (lambda (output)
+                 (let ((builds (cached/list-builds-for-output output)))
+                   (if (any (lambda (output-build)
+                              (string=? (or (assq-ref output-build 'result)
+                                            "unknown")
+                                        "success"))
+                            builds)
+                       ;; At least one build for this output has been successful,
+                       ;; so delete the setup failure
+                       (hash-remove! setup-failures-hash
+                                     setup-failure-build-id)
+                       ;; The missing input isn't available, so set the derived
+                       ;; priority to be as least as high as this build
+                       (for-each
+                        (lambda (build)
+                          (when (eq? 0 (assq-ref build 'processed))
+                            (let* ((missing-input-build-id
+                                    (assq-ref build 'uuid))
+                                   (missing-input-build-derived-priority
+                                    (hash-ref derived-build-priorities-hash
+                                              missing-input-build-id)))
+                              (when (> setup-failure-build-derived-priority
+                                       missing-input-build-derived-priority)
+                                ;; Bump the priority of the build
+                                (hash-set!
+                                 derived-build-priorities-hash
+                                 missing-input-build-id
+                                 setup-failure-build-derived-priority)))))
+                        builds))))
+               (datastore-list-setup-failure-missing-inputs
+                datastore
+                (assq-ref setup-failure 'id)))))
+          setup-failures)))
+     (hash-map->list
+      (lambda (key value) key)
+      setup-failures-hash))
+
     (let ((result
            (append-map
             (lambda (agent-id)