Store if the derivation is a fixed output derivation

As this information will come in useful when working out how to handle builds
for fixed output derivations. Specifically, I want to make it configurable
whether to add builds for fixed output derivations if a build already exists
for the output, but the derivation is different.

Currently, different fixed output derivations can be ignored but it's not
possible to just avoid adding more builds for non fixed output derivations
while adding builds when fixed output derivations change. This new information
will help enable that.

8 files changed, 102 insertions, 34 deletions

diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 435c600..503e088 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -1798,32 +1798,39 @@ SELECT name, id FROM derivation_outputs WHERE derivation_name = :derivation_name
 
       outputs)))
 
+(define (db-find-derivation db name)
+  (let ((statement
+         (sqlite-prepare
+          db
+          "
+SELECT system, fixed_output
+FROM derivations
+WHERE name = :name")))
+
+    (sqlite-bind-arguments
+     statement
+     #:name name)
+
+    (let ((result
+           (match (sqlite-step statement)
+             (#f #f)
+             (#(system fixed_output)
+              `((system        . ,system)
+                (fixed-output? . ,(cond
+                                   ((eq? fixed_output 0) #f)
+                                   ((eq? fixed_output 1) #t)
+                                   (else fixed_output))))))))
+      (sqlite-reset statement)
+
+      result)))
+
 (define-method (datastore-find-derivation
                 (datastore <sqlite-datastore>)
                 name)
   (call-with-worker-thread
    (slot-ref datastore 'worker-reader-thread-channel)
    (lambda (db)
-     (let ((statement
-            (sqlite-prepare
-             db
-             "
-SELECT system
-FROM derivations
-WHERE name = :name")))
-
-       (sqlite-bind-arguments
-        statement
-        #:name name)
-
-       (let ((result
-              (match (sqlite-step statement)
-                (#f #f)
-                (#(system)
-                 `((system . ,system))))))
-         (sqlite-reset statement)
-
-         result)))))
+     (db-find-derivation db name))))
 
 (define-method (datastore-find-derivation-outputs
                 (datastore <sqlite-datastore>)
@@ -1958,21 +1965,37 @@ WHERE derivation_inputs.derivation_name = :derivation_name"
     (derivation-file-name derivation))
 
   (define (insert-derivation)
-    (let ((statement
-           (sqlite-prepare
-            db
-            "
-INSERT OR IGNORE INTO derivations (name, system) VALUES (:name, :system)")))
-
-      (sqlite-bind-arguments
-       statement
-       #:name derivation-name
-       #:system (derivation-system derivation))
-
-      (sqlite-step statement)
-      (sqlite-reset statement)
+    (let ((derivation-details (db-find-derivation db derivation))
+          (fixed-output? (fixed-output-derivation? derivation)))
+      (if derivation-details
+          (begin
+            (unless (equal? (assq-ref derivation-details 'fixed-output?)
+                            fixed-output?)
+              (sqlite-exec
+               db
+               (simple-format #f
+                              "
+UPDATE derivations SET fixed_output = ~A WHERE name = '~A'"
+                              (if fixed-output? 1 0)
+                              derivation-name)))
+            0)
+          (let ((statement
+                 (sqlite-prepare
+                  db
+                  "
+INSERT OR IGNORE INTO derivations (name, system, fixed_output)
+  VALUES (:name, :system, :fixed_output)")))
+
+            (sqlite-bind-arguments
+             statement
+             #:name derivation-name
+             #:system (derivation-system derivation)
+             #:fixed_output fixed-output?)
+
+            (sqlite-step statement)
+            (sqlite-reset statement)
 
-      (changes-count db)))
+            (changes-count db)))))
 
   (let ((changes (insert-derivation)))
     (unless (eq? changes 0)
diff --git a/sqitch/pg/deploy/add_fixed_output_to_derivations.sql b/sqitch/pg/deploy/add_fixed_output_to_derivations.sql
new file mode 100644
index 0000000..b2c6755
--- /dev/null
+++ b/sqitch/pg/deploy/add_fixed_output_to_derivations.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-build-coordinator:add_fixed_output_to_derivations to pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/revert/add_fixed_output_to_derivations.sql b/sqitch/pg/revert/add_fixed_output_to_derivations.sql
new file mode 100644
index 0000000..7402822
--- /dev/null
+++ b/sqitch/pg/revert/add_fixed_output_to_derivations.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:add_fixed_output_to_derivations from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/verify/add_fixed_output_to_derivations.sql b/sqitch/pg/verify/add_fixed_output_to_derivations.sql
new file mode 100644
index 0000000..f6a1eca
--- /dev/null
+++ b/sqitch/pg/verify/add_fixed_output_to_derivations.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:add_fixed_output_to_derivations on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index a793617..7df0842 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -20,3 +20,4 @@ builds_created_at 2020-06-27T18:30:32Z Christopher Baines <mail@cbaines.net> # A
 build_starts 2020-06-27T20:23:38Z Christopher Baines <mail@cbaines.net> # Add build_starts table
 add_builds_end_time 2020-06-27T20:58:01Z Christopher Baines <mail@cbaines.net> # Add builds.end_time field
 build_allocation_agent_requested_systems 2020-07-02T19:45:02Z Christopher Baines <mail@cbaines.net> # Add new build_allocation_agent_requested_systems table
+add_fixed_output_to_derivations 2020-07-18T14:49:51Z Christopher Baines <mail@cbaines.net> # Add derivations.fixed_output
diff --git a/sqitch/sqlite/deploy/add_fixed_output_to_derivations.sql b/sqitch/sqlite/deploy/add_fixed_output_to_derivations.sql
new file mode 100644
index 0000000..992ee06
--- /dev/null
+++ b/sqitch/sqlite/deploy/add_fixed_output_to_derivations.sql
@@ -0,0 +1,9 @@
+-- Deploy guix-build-coordinator:add_fixed_output_to_derivations to sqlite
+
+BEGIN;
+
+ALTER TABLE derivations
+  ADD COLUMN fixed_output BOOLEAN
+  CHECK (fixed_output IN (0,1));
+
+COMMIT;
diff --git a/sqitch/sqlite/revert/add_fixed_output_to_derivations.sql b/sqitch/sqlite/revert/add_fixed_output_to_derivations.sql
new file mode 100644
index 0000000..4d92fb7
--- /dev/null
+++ b/sqitch/sqlite/revert/add_fixed_output_to_derivations.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:add_fixed_output_to_derivations from sqlite
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqlite/verify/add_fixed_output_to_derivations.sql b/sqitch/sqlite/verify/add_fixed_output_to_derivations.sql
new file mode 100644
index 0000000..b4aacf1
--- /dev/null
+++ b/sqitch/sqlite/verify/add_fixed_output_to_derivations.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:add_fixed_output_to_derivations on sqlite
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;