Add a hook to handle missing inputs

That submits new build jobs to build these missing inputs if appropriate.

This means that you can tell the coordinator to build something, and it will
automatically attempt to build the dependencies if they're missing.

1 files changed, 42 insertions, 2 deletions

diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm
index ed0b890..0116605 100644
--- a/guix-build-coordinator/hooks.scm
+++ b/guix-build-coordinator/hooks.scm
@@ -19,9 +19,13 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (guix-build-coordinator hooks)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:use-module (guix-build-coordinator datastore)
+  #:use-module (guix-build-coordinator coordinator)
   #:export (default-build-success-hook
-            default-build-failure-hook))
+            default-build-failure-hook
+            default-build-missing-inputs-hook))
 
 (define (default-build-success-hook datastore build-id)
   (let ((agent-id
@@ -32,7 +36,7 @@
                     build-id agent-id)
      (current-error-port))))
 
-(define* (default-build-failure-hook datastore build-id)
+(define (default-build-failure-hook datastore build-id)
   (let ((agent-id
          (datastore-agent-for-build datastore build-id)))
     (display
@@ -40,3 +44,39 @@
                     "build ~A failed (on agent ~A)\n"
                     build-id agent-id)
      (current-error-port))))
+
+(define (default-build-missing-inputs-hook datastore build-id missing-inputs)
+  (let ((build (datastore-find-build datastore build-id)))
+    (let ((derivation-inputs
+           (datastore-find-derivation-inputs datastore
+                                             (assq-ref build 'derivation-name))))
+      (simple-format #t "missing-inputs: ~A\n~A\n"
+                     build-id
+                     (string-join (map (lambda (input)
+                                         (string-append " - " input))
+                                       missing-inputs)
+                                  "\n"))
+      (for-each (lambda (missing-input)
+                  (let ((input-derivation
+                         (any (lambda (derivation-input)
+                                (if (string=? (assq-ref derivation-input 'output)
+                                              missing-input)
+                                    (assq-ref derivation-input 'derivation)
+                                    #f))
+                              derivation-inputs)))
+                    (unless input-derivation
+                      (error "couldn't find a derivation for " missing-input))
+
+                    (let ((builds-for-output
+                           (datastore-list-builds-for-output datastore
+                                                             missing-input)))
+                      (if (null? builds-for-output)
+                          (begin
+                            (simple-format #t
+                                           "submitting build for ~A\n"
+                                           input-derivation)
+                            (submit-build datastore input-derivation))
+                          (simple-format #t "~A builds exist for ~A, skipping\n"
+                                         (length builds-for-output)
+                                         missing-input)))))
+                missing-inputs))))