From a6eabc572445869e0494a2b9962407352bb86c1d Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 17 May 2020 21:00:54 +0100
Subject: Convert the client actions to happen over HTTP

There were a few issues with the previous approach, I was concerned about
trying to write to the SQLite database from two processes, it's already
segfaulting occasionally when accessing it from just one. Additionally, the
client actions were already doing things that should happen in the coordinator
process, like allocating builds.

I'm trying to not turn this in to a web app, but not doing very well. Although
having this information and these actions available over the network does make
it possible to build a web app frontend, which I've had in mind.
---
 guix-build-coordinator/coordinator.scm | 92 ++++++++++++++++++++++------------
 1 file changed, 59 insertions(+), 33 deletions(-)

(limited to 'guix-build-coordinator/coordinator.scm')

diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index f0987a4..0eb8bd0 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -85,41 +85,67 @@
                        #:key
                        requested-uuid
                        (priority 0)
+                       (ignore-if-build-for-derivation-exists? #f)
+                       (ignore-if-build-for-outputs-exists? #f)
                        (ensure-all-related-derivation-outputs-have-builds? #f))
-  (let ((datastore (build-coordinator-datastore build-coordinator))
-        (uuid (or requested-uuid (random-v4-uuid))))
-    (datastore-store-derivation datastore derivation)
-
-    (when ensure-all-related-derivation-outputs-have-builds?
-      (let ((derivations-lacking-builds
-             (datastore-list-related-derivations-with-no-build-for-outputs
-              datastore
-              (derivation-file-name derivation))))
-        (for-each
-         (lambda (related-derivation)
-           (let ((related-uuid (random-v4-uuid)))
-             (simple-format #t "submtiting ~A for related ~A\n"
-                            related-uuid
-                            related-derivation)
-             (datastore-store-build datastore
-                                    related-derivation
+  (define datastore (build-coordinator-datastore build-coordinator))
+
+  (define (build-for-derivation-exists?)
+    (not
+     (null? (datastore-list-builds-for-derivation
+             datastore
+             (derivation-file-name derivation)))))
+
+  (define (build-for-output-already-exists?)
+    (any
+     (match-lambda
+       ((name . derivation-output)
+        (let ((builds-for-output
+               (datastore-list-builds-for-output
+                datastore
+                (derivation-output-path derivation-output))))
+
+          (not (null? builds-for-output)))))
+     (derivation-outputs derivation)))
+
+  (if (and ignore-if-build-for-derivation-exists?
+           (build-for-derivation-exists?))
+      '((no-build-submitted . build-already-exists-for-this-derivation))
+      (if (and ignore-if-build-for-outputs-exists?
+               (build-for-output-already-exists?))
+          '((no-build-submitted . build-already-exists-for-a-output))
+
+          ;; Actually create a build
+          (let ((uuid (or requested-uuid (random-v4-uuid))))
+            (datastore-store-derivation datastore derivation)
+
+            (when ensure-all-related-derivation-outputs-have-builds?
+              (let ((derivations-lacking-builds
+                     (datastore-list-related-derivations-with-no-build-for-outputs
+                      datastore
+                      (derivation-file-name derivation))))
+                (for-each
+                 (lambda (related-derivation)
+                   (let ((related-uuid (random-v4-uuid)))
+                     (simple-format #t "submtiting ~A for related ~A\n"
                                     related-uuid
-                                    ;; Let the scheduler take care of
-                                    ;; the prioritisation
-                                    0)))
-         derivations-lacking-builds)))
-
-    (datastore-store-build datastore
-                           (derivation-file-name derivation)
-                           uuid
-                           priority)
-
-    (unless defer-allocation?
-      ;; This can be removed once allocation in the main coordinator process can
-      ;; be triggered
-      (allocate-builds build-coordinator))
-
-    uuid))
+                                    related-derivation)
+                     (datastore-store-build datastore
+                                            related-derivation
+                                            related-uuid
+                                            ;; Let the scheduler take care of
+                                            ;; the prioritisation
+                                            0)))
+                 derivations-lacking-builds)))
+
+            (datastore-store-build datastore
+                                   (derivation-file-name derivation)
+                                   uuid
+                                   priority)
+
+            (trigger-build-allocation build-coordinator)
+
+            `((build-submitted . ,uuid))))))
 
 (define* (new-agent datastore
                     #:key
-- 
cgit v1.2.3