Add initial support for sending/storing build outputs

1 files changed, 16 insertions, 1 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index c5094d4..9c75253 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -22,6 +22,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (web http)
   #:use-module (guix store)
   #:use-module (guix status)
   #:use-module (guix derivations)
@@ -41,7 +43,10 @@
     (for-each (lambda (build)
                 (let ((derivation-name (assoc-ref build "derivation-name")))
                   (pre-build-process derivation-name)
-                  (perform-build derivation-name)))
+                  (let ((result (perform-build derivation-name)))
+                    (post-build uuid coordinator-uri password
+                                (assoc-ref build "uuid")
+                                derivation-name))))
               builds)))
 
 (define (pre-build-process derivation-name)
@@ -93,3 +98,13 @@
                        #:use-substitutes? #f)
 
     (build-things store (list derivation-name))))
+
+(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))))