Support reporting setup failures to the coordinator

1 files changed, 37 insertions, 0 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 97cffdf..78c3a7b 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -43,6 +43,7 @@
 
             submit-status
             submit-build-result
+            report-setup-failure
             submit-output
             fetch-builds-for-agent))
 
@@ -178,6 +179,19 @@ port. Also, the port used can be changed by passing the --port option.\n"
              (render-json
               "access denied"
               #:code 403))))
+      (('POST "build" uuid "report-setup-failure")
+       (let ((agent-id-for-build
+              (datastore-agent-for-build datastore uuid)))
+         (if (authenticated? agent-id-for-build request)
+             (begin
+               (handle-setup-failure-report
+                datastore agent-id-for-build uuid
+                (json-string->scm (utf8->string body)))
+               (render-json
+                "message received"))
+             (render-json
+              "access denied"
+              #:code 403))))
       (('PUT "build" uuid "output" output-name)
        (let ((agent-id-for-build
               (datastore-agent-for-build datastore uuid)))
@@ -322,6 +336,29 @@ port. Also, the port used can be changed by passing the --port option.\n"
                  `((Authorization . ,auth-value)))))
     (json-string->scm (utf8->string body))))
 
+(define (report-setup-failure coordinator-uri agent-uuid password
+                              build-id report)
+  (define auth-value
+    (string-append
+     "Basic "
+     (base64-encode
+      (string->utf8
+       (string-append agent-uuid ":" password)))))
+
+  (define uri
+    (coordinator-uri-for-path
+     coordinator-uri
+     (string-append "/build/" build-id "/report-setup-failure")))
+
+  (let-values (((response body)
+                (http-request
+                 uri
+                 #:method 'POST
+                 #:body (scm->json-string report)
+                 #:headers
+                 `((Authorization . ,auth-value)))))
+    (json-string->scm (utf8->string body))))
+
 (define (fetch-builds-for-agent coordinator-uri agent-uuid password)
   (define auth-value
     (string-append