1 files changed, 49 insertions, 2 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 1f2df0a..752f354 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -47,6 +47,8 @@
   #:use-module (guix-build-coordinator agent-messaging abstract)
   #:export (make-http-agent-interface
 
+            fetch-session-credentials
+
             submit-status
             submit-log-file
             submit-build-result
@@ -68,7 +70,8 @@
     #:agent-uuid agent-uuid
     #:password password))
 
-(define (coordinator-uri-for-path base-uri-string agent-path)
+(define* (coordinator-uri-for-path base-uri-string agent-path
+                                   #:key query)
   (let* ((base-uri (string->uri base-uri-string))
          (scheme (uri-scheme base-uri))
          (host   (uri-host base-uri))
@@ -82,7 +85,8 @@
                 path
                 (if (string-suffix? path "/")
                     agent-path
-                    (string-drop agent-path 1))))))
+                    (string-drop agent-path 1)))
+               #:query query)))
 
 (define (with-request-mutex thunk)
   (if (running-on-the-hurd?)
@@ -184,6 +188,49 @@
                   #:delay 10
                   #:ignore agent-error-from-coordinator?))
 
+(define* (fetch-session-credentials coordinator
+                                    name
+                                    token
+                                    #:key (log default-log))
+  (define method 'POST)
+  (define path "/agent/fetch-session-credentials")
+  (define uri (coordinator-uri-for-path coordinator path
+                                        #:query
+                                        (simple-format #f "name=~A&token=~A"
+                                                       name token)))
+
+  (let-values (((response body)
+                (http-request uri
+                              #:method method
+                              #:decode-body? #f)))
+    (let ((code (response-code response)))
+      (cond
+       ((eq? code 400)
+        (and=> (coordinator-handle-failed-request log
+                                                  method
+                                                  path
+                                                  response
+                                                  body)
+               (lambda (error)
+                 (raise-exception
+                  (make-agent-error-from-coordinator
+                   (assoc-ref error "error"))))))
+
+       ((>= (response-code response) 400)
+        (let ((body
+               (coordinator-handle-failed-request log
+                                                  method
+                                                  path
+                                                  response
+                                                  body)))
+          (raise-exception
+           (make-exception-with-message
+            body))))
+       (else
+        (values
+         (json-string->scm (utf8->string body))
+         response))))))
+
 (define-method (submit-status
                 (interface <http-agent-interface>)
                 .