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.

1 files changed, 57 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)