Rework canceling builds

Previously there were some protections introduced against canceling builds
that were required by other builds, but this change wasn't quite complete as
at least the command line interface wasn't updated to take this in to account.

This commit updates the command line interface, as well as improving the
controller.

1 files changed, 50 insertions, 32 deletions

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 04d8aac..85c1a03 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -480,38 +480,56 @@
                        #:key (ignore-if-build-required-by-another? #t))
   (define datastore (build-coordinator-datastore build-coordinator))
 
-  (datastore-call-with-transaction
-   datastore
-   (lambda (db)
-     (let ((build-details (datastore-find-build datastore uuid)))
-       (when (assq-ref build-details 'canceled)
-         (raise-exception
-          (make-exception-with-message
-           "cannot cancel and already canceled build")))
-
-       (when (assq-ref build-details 'processed)
-         (raise-exception
-          (make-exception-with-message
-           "cannot cancel and already processed build")))
-
-       (when (and ignore-if-build-required-by-another?
-                  (datastore-build-required-by-another? datastore
-                                                        uuid))
-         (raise-exception
-          (make-exception-with-message
-           "build required by another"))))
-
-     (datastore-remove-build-from-allocation-plan datastore uuid)
-     (datastore-cancel-build datastore uuid)
-     (datastore-insert-unprocessed-hook-event datastore
-                                              "build-canceled"
-                                              (list uuid))))
-
-  (trigger-build-allocation build-coordinator)
-
-  (build-coordinator-prompt-hook-processing-for-event build-coordinator
-                                                      'build-canceled)
-  #t)
+  (define (perform-operation)
+    (let ((val
+           (datastore-call-with-transaction
+            datastore
+            (lambda (db)
+              (let ((build-details (datastore-find-build datastore uuid)))
+                (when (assq-ref build-details 'canceled)
+                  (raise-exception
+                   (make-exception-with-message
+                    "cannot cancel and already canceled build")))
+
+                (when (assq-ref build-details 'processed)
+                  (raise-exception
+                   (make-exception-with-message
+                    "cannot cancel and already processed build"))))
+
+              (when (and ignore-if-build-required-by-another?
+                         (datastore-build-required-by-another? datastore
+                                                               uuid))
+                (raise-exception
+                 (make-transaction-rollback-exception
+                  'skipped-as-build-required-by-another)))
+
+              (datastore-remove-build-from-allocation-plan datastore uuid)
+              (datastore-cancel-build datastore uuid)
+              (datastore-insert-unprocessed-hook-event datastore
+                                                       "build-canceled"
+                                                       (list uuid))
+              'build-canceled))))
+
+      (when (eq? val 'build-canceled)
+        (trigger-build-allocation build-coordinator)
+
+        (build-coordinator-prompt-hook-processing-for-event build-coordinator
+                                                            'build-canceled))
+
+      val))
+
+  (if ignore-if-build-required-by-another?
+      (let ((build-required
+             ;; Do this check here outside the transaction to avoid having to
+             ;; start a transaction if there are builds requiring this one
+             ;;
+             ;; It's important to repeat this check inside the transaction for
+             ;; correctness.
+             (datastore-build-required-by-another? datastore uuid)))
+        (if build-required
+            'skipped-as-build-required-by-another
+            (perform-operation)))
+      (perform-operation)))
 
 (define (update-build-priority build-coordinator uuid new-priority)
   (define datastore (build-coordinator-datastore build-coordinator))