1 files changed, 58 insertions, 50 deletions
diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 66045b4..0baa75b 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -144,56 +144,64 @@
   (define first-request-failed? #f)
 
   (define (make-request)
-    (let-values (((response body)
-                  (http-request uri
-                                #:method method
-                                #:body (scm->json-string body)
-                                #:decode-body? #f
-                                #:headers
-                                `((Authorization . ,auth-value)
-                                  ,@headers))))
-      (let ((code (response-code response)))
-        (cond
-         ((= 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"))))))
-
-         ((= code 404)
-          (values
-           (and body (json-string->scm (utf8->string body)))
-           response))
-
-         ((>= (response-code response) 400)
-          (let ((body
-                 (coordinator-handle-failed-request log
-                                                    method
-                                                    path
-                                                    response
-                                                    body)))
-            (if (and first-request-failed?
-                     succeed-on-access-denied-retry?
-                     (equal? body
-                             '(("error" . "access denied"))))
-                (begin
-                  (log 'WARN
-                       "treating access denied response as success")
-                  (values body response))
-                (begin
-                  (set! first-request-failed? #t)
-                  (raise-exception
-                   (make-exception-with-message
-                    body))))))
-         (else
-          (values
-           (and body (json-string->scm (utf8->string body)))
-           response))))))
+    (let* ((port
+            socket
+            (open-socket-for-uri* uri))
+
+           (response
+            body
+            (http-request uri
+                          #:port port
+                          #:method method
+                          #:body (scm->json-string body)
+                          #:decode-body? #f
+                          #:headers
+                          `((Authorization . ,auth-value)
+                            ,@headers)))
+
+           (code (response-code response)))
+
+      (cond
+       ((= 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"))))))
+
+       ((= code 404)
+        (values
+         (and body (json-string->scm (utf8->string body)))
+         response))
+
+       ((>= (response-code response) 400)
+        (let ((body
+               (coordinator-handle-failed-request log
+                                                  method
+                                                  path
+                                                  response
+                                                  body)))
+          (if (and first-request-failed?
+                   succeed-on-access-denied-retry?
+                   (equal? body
+                           '(("error" . "access denied"))))
+              (begin
+                (log 'WARN
+                     "treating access denied response as success")
+                (values body response))
+              (begin
+                (set! first-request-failed? #t)
+                (raise-exception
+                 (make-exception-with-message
+                  body))))))
+       (else
+        (values
+         (and body (json-string->scm (utf8->string body)))
+         response)))))
 
   (retry-on-error (lambda ()
                     (with-port-timeouts make-request))