Support agents fetching builds

1 files changed, 35 insertions, 1 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 7c36c02..2401d41 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -19,6 +19,7 @@
 ;;; <http://www.gnu.org/licenses/>.
 
 (define-module (guix-build-coordinator agent-messaging http)
+  #:use-module (srfi srfi-11)
   #:use-module (ice-9 match)
   #:use-module (system repl error-handling)
   #:use-module (fibers web server)
@@ -31,9 +32,11 @@
   #:use-module (web uri)
   #:use-module (guix base64)
   #:use-module (guix-build-coordinator datastore)
+  #:use-module (guix-build-coordinator coordinator)
   #:export (http-agent-messaging-start-server
 
-            submit-status))
+            submit-status
+            fetch-builds-for-agent))
 
 (define (http-agent-messaging-start-server port host secret-key-base
                                            datastore)
@@ -122,6 +125,14 @@ port. Also, the port used can be changed by passing the --port option.\n"
            (render-json
             "access denied"
             #:code 403)))
+      (('POST "agent" uuid "fetch-builds")
+       (if (authenticated? uuid request)
+           (let ((builds (fetch-builds datastore uuid)))
+             (render-json
+              `((builds . ,(list->vector builds)))))
+           (render-json
+            "access denied"
+            #:code 403)))
       (_
        (render-json
         "not-found"
@@ -172,3 +183,26 @@ port. Also, the port used can be changed by passing the --port option.\n"
            `((status . ,status)))
    #:headers
    `((Authorization . ,auth-value))))
+
+(define (fetch-builds-for-agent coordinator-uri agent-uuid password)
+  (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 "/agent/" agent-uuid "/fetch-builds")))
+
+  (let-values (((response body)
+                (http-request
+                 uri
+                 #:method 'POST
+                 #:headers
+                 `((Authorization . ,auth-value)))))
+    (vector->list
+     (assoc-ref (json-string->scm (utf8->string body))
+                "builds"))))