From 5251f1f58de2d0786592beaaf1fbed4b052e9283 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Mon, 27 Apr 2020 19:09:32 +0100
Subject: Retry requests a few times if they error

This should make agent <-> coordinator communication more failure tolerant.
---
 guix-build-coordinator/agent-messaging/http.scm | 63 +++++++++++++------------
 1 file changed, 34 insertions(+), 29 deletions(-)

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 9b8b9ac..6c5bf51 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -366,35 +366,40 @@ port. Also, the port used can be changed by passing the --port option.\n"
     (coordinator-uri-for-path coordinator-uri
                               path))
 
-  (let-values (((response body)
-                (http-request uri
-                              #:method method
-                              #:body (scm->json-string body)
-                              #:decode-body? #f
-                              #:headers
-                              `((Authorization . ,auth-value)
-                                ,@headers))))
-    (if (>= (response-code response) 400)
-        (begin
-          (simple-format
-           (current-error-port)
-           "error: coordinator-http-request: ~A ~A: ~A\n"
-           method path (response-code response))
-          (error (catch #t
-                   (lambda ()
-                     (if (eq? '(application/json (charset . "utf-8"))
-                              (response-content-type response))
-                         (json-string->scm (utf8->string body))
-                         (utf8->string body)))
-                   (lambda (key . args)
-                     (simple-format
-                      (current-error-port)
-                      "error decoding body ~A ~A\n"
-                      key args)
-                     #f))))
-        (values
-         (json-string->scm (utf8->string body))
-         response))))
+  (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))))
+      (if (>= (response-code response) 400)
+          (begin
+            (simple-format
+             (current-error-port)
+             "error: coordinator-http-request: ~A ~A: ~A\n"
+             method path (response-code response))
+            (error (catch #t
+                     (lambda ()
+                       (if (eq? '(application/json (charset . "utf-8"))
+                                (response-content-type response))
+                           (json-string->scm (utf8->string body))
+                           (utf8->string body)))
+                     (lambda (key . args)
+                       (simple-format
+                        (current-error-port)
+                        "error decoding body ~A ~A\n"
+                        key args)
+                       #f))))
+          (values
+           (json-string->scm (utf8->string body))
+           response))))
+
+  (retry-on-error make-request
+                  #:times 3
+                  #:delay 10))
 
 (define (submit-status coordinator-uri agent-uuid password
                        status)
-- 
cgit v1.2.3