Send more information on derivation outputs to the Guix Data Service

This will enable it to join builds to derivations, even if it doesn't know
about the derivation being built, since it'll be able to match the outputs
with other derivations it knows about.

3 files changed, 65 insertions, 0 deletions

diff --git a/guix-build-coordinator/datastore.scm b/guix-build-coordinator/datastore.scm
index 1dc3320..c67d9f1 100644
--- a/guix-build-coordinator/datastore.scm
+++ b/guix-build-coordinator/datastore.scm
@@ -72,6 +72,7 @@
 (re-export datastore-list-agent-builds)
 (re-export datastore-find-derivation)
 (re-export datastore-find-derivation-outputs)
+(re-export datastore-find-derivation-output-details)
 (re-export datastore-find-derivation-system)
 (re-export datastore-find-derivation-inputs)
 (re-export datastore-find-derivation-for-output)
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index 2249428..5bdbc6f 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -70,6 +70,7 @@
             datastore-find-derivation-inputs
             datastore-find-derivation-for-output
             datastore-find-derivation-outputs
+            datastore-find-derivation-output-details
             datastore-list-builds-for-output
             datastore-list-builds-for-output-and-system
             datastore-new-agent-password
@@ -3544,6 +3545,49 @@ WHERE derivation_id = :derivation_id"
              #f
              result))))))
 
+(define-method (datastore-find-derivation-output-details
+                (datastore <sqlite-datastore>)
+                derivation-name)
+  (call-with-worker-thread
+   (slot-ref datastore 'worker-reader-thread-channel)
+   (lambda (db)
+     (let ((statement
+            (sqlite-prepare
+             db
+             "
+SELECT outputs.output,
+       derivation_outputs.name,
+       derivation_output_details.hash_algorithm,
+       derivation_output_details.hash,
+       derivation_output_details.recursive
+FROM derivation_outputs
+INNER JOIN outputs
+  ON derivation_outputs.output_id = outputs.id
+INNER JOIN derivation_output_details
+  ON derivation_output_details.derivation_output_id = derivation_outputs.id
+WHERE derivation_id = :derivation_id"
+             #:cache? #t)))
+
+       (sqlite-bind-arguments
+        statement
+        #:derivation_id (db-find-derivation-id db derivation-name))
+
+       (let ((result
+              (sqlite-map
+               (match-lambda
+                 (#(output name hash-algorithm hash recursive)
+                  `((output . ,output)
+                    (name   . ,name)
+                    (hash-algorithm . ,hash-algorithm)
+                    (hash . ,hash)
+                    (recursive? . ,(eq? 1 recursive)))))
+               statement)))
+         (sqlite-reset statement)
+
+         (if (null? result)
+             #f
+             result))))))
+
 (define-method (datastore-list-unbuilt-derivation-outputs
                 (datastore <sqlite-datastore>)
                 derivation-name)
diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm
index 2053e90..277094f 100644
--- a/guix-build-coordinator/hooks.scm
+++ b/guix-build-coordinator/hooks.scm
@@ -472,6 +472,26 @@
          (event      . scheduled)
          (build_id   . ,build-id)
          (derivation . ,(assq-ref build-details 'derivation-name))
+         ,@(let ((output-details
+                  (datastore-find-derivation-output-details
+                   datastore
+                   (assq-ref build-details 'derivation-name))))
+             (if (null? output-details)
+                 '()
+                 `((derivation_outputs
+                    . ,(list->vector
+                        (map
+                         (lambda (output-details)
+                           `((output . ,(assq-ref output-details 'output))
+                             (name   . ,(assq-ref output-details 'name))
+                             ,@(if (assq-ref output-details 'hash)
+                                   `((hash_algorithm . ,(assq-ref output-details
+                                                                  'hash-algorithm))
+                                     (hash           . ,(assq-ref output-details
+                                                                  'hash)))
+                                   '())
+                             (recursive . ,(assq-ref output-details 'recursive?))))
+                         output-details))))))
          ,@(let ((created-at (assq-ref build-details 'created-at)))
              (if created-at
                  `((timestamp . ,(string->number