Add --ignore-if-build-for-outputs-exists

2 files changed, 43 insertions, 21 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index e8c5440..a2c961e 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -51,26 +51,20 @@
 (define coordinator-metrics-registry
   (make-metrics-registry))
 
-(define* (submit-build datastore derivation-file
+(define* (submit-build datastore derivation
                        #:key
                        requested-uuid
                        (priority 0)
                        (defer-allocation? #f)
                        (ensure-all-related-derivations-have-builds? #f))
-  (unless (file-exists? derivation-file)
-    (substitute-derivation derivation-file))
-
-  (let ((derivation
-         (read-derivation-from-file derivation-file))
-        (uuid
-         (or requested-uuid (random-v4-uuid))))
-
+  (let ((uuid (or requested-uuid (random-v4-uuid))))
     (datastore-store-derivation datastore derivation)
 
     (when ensure-all-related-derivations-have-builds?
       (let ((related-derivations
-             (datastore-list-related-derivations-with-no-build datastore
-                                                               derivation-file)))
+             (datastore-list-related-derivations-with-no-build
+              datastore
+              (peek "DRV" (derivation-file-name derivation)))))
         (for-each
          (lambda (related-derivation)
            (let ((related-uuid (random-v4-uuid)))
@@ -86,7 +80,7 @@
          related-derivations)))
 
     (datastore-store-build datastore
-                           derivation-file
+                           (derivation-file-name derivation)
                            uuid
                            priority)
 
diff --git a/scripts/guix-build-coordinator.in b/scripts/guix-build-coordinator.in
index 38fdea9..04c52e2 100644
--- a/scripts/guix-build-coordinator.in
+++ b/scripts/guix-build-coordinator.in
@@ -26,7 +26,9 @@
              (srfi srfi-37)
              (ice-9 match)
              ((guix ui) #:select (read/eval))
+             (guix derivations)
              (guix-build-coordinator hooks)
+             (guix-build-coordinator utils)
              (guix-build-coordinator config)
              (guix-build-coordinator datastore)
              (guix-build-coordinator coordinator)
@@ -73,6 +75,9 @@
         (option '("ignore-if-build-for-derivation-exists") #f #f
                 (lambda (opt name _ result)
                   (alist-cons 'ignore-if-build-for-derivation-exists #t result)))
+        (option '("ignore-if-build-for-outputs-exists") #f #f
+                (lambda (opt name _ result)
+                  (alist-cons 'ignore-if-build-for-outputs-exists #t result)))
         (option '("ensure-all-related-derivations-have-builds") #f #f
                 (lambda (opt name _ result)
                   (alist-cons 'ensure-all-related-derivations-have-builds
@@ -86,6 +91,7 @@
 (define %build-option-defaults
   `((priority                                   . 0)
     (ignore-if-build-for-derivation-exists      . #f)
+    (ignore-if-build-for-outputs-exists         . #f)
     (ensure-all-related-derivations-have-builds . #f)
     (defer-allocation                           . #f)))
 
@@ -182,15 +188,37 @@
                                derivation-file)
                 (exit 0))))
 
-          (let ((uuid (submit-build
-                       datastore
-                       derivation-file
-                       #:priority (assq-ref opts 'priority)
-                       #:defer-allocation? (assq-ref opts 'defer-allocation)
-                       #:ensure-all-related-derivations-have-builds?
-                       (assq-ref
-                        opts 'ensure-all-related-derivations-have-builds))))
-            (simple-format #t "build submitted as ~A\n" uuid)))))))
+          (unless (file-exists? derivation-file)
+            (substitute-derivation derivation-file))
+
+          (let ((derivation (read-derivation-from-file derivation-file)))
+
+            (when (assq-ref opts 'ignore-if-build-for-outputs-exists)
+              (for-each
+               (match-lambda
+                 ((name . derivation-output)
+                  (let ((builds-for-output
+                         (datastore-list-builds-for-output
+                          datastore
+                          (derivation-output-path derivation-output))))
+
+                    (unless (null? builds-for-output)
+                      (simple-format
+                       #t "there are already ~A builds for ~A, skipping\n"
+                       (length builds-for-output)
+                       (derivation-output-path derivation-output))
+                      (exit 0)))))
+               (derivation-outputs derivation)))
+
+            (let ((uuid (submit-build
+                         datastore
+                         derivation
+                         #:priority (assq-ref opts 'priority)
+                         #:defer-allocation? (assq-ref opts 'defer-allocation)
+                         #:ensure-all-related-derivations-have-builds?
+                         (assq-ref
+                          opts 'ensure-all-related-derivations-have-builds))))
+              (simple-format #t "build submitted as ~A\n" uuid))))))))
   (("agent" "new" rest ...)
    (let ((opts (parse-options (append %agent-options
                                       %base-options)