Send over some metadata from the agent for each output

This will hopefully make it easier to create narinfo files for the outputs. I
think all of this information can be derived from the nar, but I'm not sure
how to do that, so maybe this can eventually be removed.

10 files changed, 136 insertions, 14 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index a528143..ec4860d 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -26,6 +26,7 @@
   #:use-module (web http)
   #:use-module (guix store)
   #:use-module (guix derivations)
+  #:use-module (guix base32)
   #:use-module (guix-build-coordinator utils)
   #:use-module (guix-build-coordinator agent-messaging http)
   #:export (run-agent))
@@ -145,13 +146,29 @@
 
 (define (post-build uuid coordinator-uri password
                     build-id derivation)
-  (for-each
-   (match-lambda
-     ((output-name . output)
-      (submit-output coordinator-uri uuid password
-                     build-id output-name
-                     (derivation-output-path output))))
-   (derivation-outputs (read-derivation-from-file derivation)))
-
-  (submit-build-result coordinator-uri uuid password build-id
-                       '((result . success))))
+  (let ((output-details
+         (map
+          (match-lambda
+            ((output-name . output)
+             (submit-output coordinator-uri uuid password
+                            build-id output-name
+                            (derivation-output-path output))
+
+             (let ((path-info (with-store store
+                                (query-path-info
+                                 store
+                                 (derivation-output-path output)))))
+               `((name       . ,output-name)
+                 (hash       . ,(bytevector->nix-base32-string
+                                 (path-info-hash path-info)))
+                 (size       . ,(path-info-nar-size path-info))
+                 (references . ,(list->vector
+                                 (map basename
+                                      (path-info-references path-info))))))))
+
+          (derivation-outputs (read-derivation-from-file derivation)))))
+
+    (submit-build-result
+     coordinator-uri uuid password build-id
+     `((result  . success)
+       (outputs . ,(list->vector output-details))))))
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 37af6c4..9461220 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -180,14 +180,19 @@
 
 (define (handle-build-result datastore hook-channel
                              agent-id build-id result-json)
-  (let ((result (assoc-ref result-json "result")))
+  (let* ((result (assoc-ref result-json "result"))
+         (success? (string=? result "success")))
     (datastore-store-build-result datastore
                                   build-id
                                   agent-id
-                                  (if (string=? result "success")
+                                  (if success?
                                       "success"
                                       "failure")
-                                  #f) ;; TODO
+                                  #f    ; failure reason, TODO
+                                  (if success?
+                                      (vector->list
+                                       (assoc-ref result-json "outputs"))
+                                      #f))
 
     (put-message hook-channel
                  (list (if (string=? result "success")
diff --git a/guix-build-coordinator/datastore/sqlite.scm b/guix-build-coordinator/datastore/sqlite.scm
index a89ab3c..f8fd317 100644
--- a/guix-build-coordinator/datastore/sqlite.scm
+++ b/guix-build-coordinator/datastore/sqlite.scm
@@ -204,7 +204,8 @@ WHERE agent_id = :agent_id AND password = :password")))
                 build-id
                 agent-id
                 result
-                failure-reason)
+                failure-reason
+                output-metadata)
   (define (insert-build-result db build-id agent-id result failure-reason)
     (sqlite-exec
      db
@@ -239,6 +240,54 @@ DELETE FROM allocated_builds WHERE build_id = '"
       "
 UPDATE builds SET processed = 1 WHERE uuid = '" build-id "'")))
 
+  (define (store-output-metadata
+           db
+           build-id
+           output-metadata)
+    (define (name->output-id name)
+      (let ((statement
+             (sqlite-prepare
+              db
+              "
+SELECT derivation_outputs.id
+FROM derivation_outputs
+INNER JOIN builds
+  ON builds.derivation_name = derivation_outputs.derivation_name
+WHERE builds.uuid = :build_id AND derivation_outputs.name = :name")))
+
+        (sqlite-bind-arguments
+         statement
+         #:build_id build-id
+         #:name name)
+
+        (match (sqlite-step statement)
+          (#(id)
+           (sqlite-reset statement)
+
+           id))))
+
+    (sqlite-exec
+     db
+     (string-append
+      "
+INSERT INTO output_metadata (build_id, derivation_output_id,
+                             hash, size, store_references)
+VALUES "
+      (string-join
+       (map (lambda (output)
+              (simple-format
+               #f "('~A', ~A, '~A', ~A, '~A')"
+               build-id
+               (name->output-id (assoc-ref output "name"))
+               (assoc-ref output "hash")
+               (assoc-ref output "size")
+               (string-join
+                (vector->list (assoc-ref output "references"))
+                " ")))
+            output-metadata)
+       ", ")))
+    #t)
+
   (call-with-worker-thread
    (slot-ref datastore 'worker-thread-channel)
    (lambda (db)
@@ -253,6 +302,8 @@ UPDATE builds SET processed = 1 WHERE uuid = '" build-id "'")))
          (insert-build-result db build-id agent-id result failure-reason)
          (remove-build-allocation db build-id agent-id)
          (mark-build-as-processed db build-id)
+         (when output-metadata
+           (store-output-metadata db build-id output-metadata))
          (sqlite-exec db "COMMIT TRANSACTION;")))))
   #t)
 
diff --git a/sqitch/pg/deploy/output_metadata.sql b/sqitch/pg/deploy/output_metadata.sql
new file mode 100644
index 0000000..f730ca6
--- /dev/null
+++ b/sqitch/pg/deploy/output_metadata.sql
@@ -0,0 +1,7 @@
+-- Deploy guix-build-coordinator:output_metadata to pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/revert/output_metadata.sql b/sqitch/pg/revert/output_metadata.sql
new file mode 100644
index 0000000..dcff1c5
--- /dev/null
+++ b/sqitch/pg/revert/output_metadata.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:output_metadata from pg
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/pg/verify/output_metadata.sql b/sqitch/pg/verify/output_metadata.sql
new file mode 100644
index 0000000..f6abae8
--- /dev/null
+++ b/sqitch/pg/verify/output_metadata.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:output_metadata on pg
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;
diff --git a/sqitch/sqitch.plan b/sqitch/sqitch.plan
index 487fdf4..1e4414f 100644
--- a/sqitch/sqitch.plan
+++ b/sqitch/sqitch.plan
@@ -8,3 +8,4 @@ initial_agent_tables 2020-04-09T20:03:53Z Christopher Baines <mail@cbaines.net>
 build_allocation_tables 2020-04-10T19:26:36Z Christopher Baines <mail@cbaines.net> # Create initial tables for allocating builds
 build_results 2020-04-12T19:59:27Z Christopher Baines <mail@cbaines.net> # Create table for storing build results
 setup_failures 2020-04-13T13:05:29Z Christopher Baines <mail@cbaines.net> # Create table for storing setup_failures
+output_metadata 2020-04-23T14:26:15Z Christopher Baines <mail@cbaines.net> # Create table for storing output metadata
diff --git a/sqitch/sqlite/deploy/output_metadata.sql b/sqitch/sqlite/deploy/output_metadata.sql
new file mode 100644
index 0000000..a7c0124
--- /dev/null
+++ b/sqitch/sqlite/deploy/output_metadata.sql
@@ -0,0 +1,13 @@
+-- Deploy guix-build-coordinator:output_metadata to sqlite
+
+BEGIN;
+
+CREATE TABLE output_metadata (
+       build_id TEXT NOT NULL REFERENCES builds (uuid),
+       derivation_output_id INTEGER NOT NULL REFERENCES derivation_outputs (id),
+       hash TEXT NOT NULL,
+       size INTEGER NOT NULL,
+       store_references TEXT NOT NULL
+);
+
+COMMIT;
diff --git a/sqitch/sqlite/revert/output_metadata.sql b/sqitch/sqlite/revert/output_metadata.sql
new file mode 100644
index 0000000..bee5fd1
--- /dev/null
+++ b/sqitch/sqlite/revert/output_metadata.sql
@@ -0,0 +1,7 @@
+-- Revert guix-build-coordinator:output_metadata from sqlite
+
+BEGIN;
+
+-- XXX Add DDLs here.
+
+COMMIT;
diff --git a/sqitch/sqlite/verify/output_metadata.sql b/sqitch/sqlite/verify/output_metadata.sql
new file mode 100644
index 0000000..e1669ec
--- /dev/null
+++ b/sqitch/sqlite/verify/output_metadata.sql
@@ -0,0 +1,7 @@
+-- Verify guix-build-coordinator:output_metadata on sqlite
+
+BEGIN;
+
+-- XXX Add verifications here.
+
+ROLLBACK;