From 77b860d7f42821b4c191476183784a404c46785e Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 6 May 2020 09:02:42 +0100
Subject: Move retry-on-error to utils

So that it can be used outside of the http module.
---
 guix-build-coordinator/agent-messaging/http.scm | 22 ---------------------
 guix-build-coordinator/utils.scm                | 26 ++++++++++++++++++++++++-
 2 files changed, 25 insertions(+), 23 deletions(-)

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 12b3be7..2b67a59 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -407,28 +407,6 @@ port. Also, the port used can be changed by passing the --port option.\n"
                     agent-path
                     (string-drop agent-path 1))))))
 
-(define* (retry-on-error f #:key times delay)
-  (let loop ((attempt 1))
-    (match (with-exception-handler
-               (lambda (exn)
-                 (cons #f exn))
-             (lambda ()
-               (cons #t (f)))
-             #:unwind? #t)
-      ((#t . return-value)
-       return-value)
-      ((#f . exn)
-       (if (>= attempt times)
-           (raise-exception exn)
-           (begin
-             (simple-format
-              (current-error-port)
-              "error: ~A, retrying in ~A\n"
-              exn
-              delay)
-             (sleep delay)
-             (loop (+ 1 attempt))))))))
-
 (define* (coordinator-http-request coordinator-uri agent-uuid password
                                    path
                                    #:key method body (headers '()))
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index d30fa9f..0b9c8f7 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -39,7 +39,9 @@
 
             substitute-derivation
 
-            narinfo-string))
+            narinfo-string
+
+            retry-on-error))
 
 
 (define %worker-thread-args
@@ -392,3 +394,25 @@ References: ~a~%"
          (signature  (base64-encode-string
                       (canonical-sexp->string (signed-string info)))))
   (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
+
+(define* (retry-on-error f #:key times delay)
+  (let loop ((attempt 1))
+    (match (with-exception-handler
+               (lambda (exn)
+                 (cons #f exn))
+             (lambda ()
+               (cons #t (f)))
+             #:unwind? #t)
+      ((#t . return-value)
+       return-value)
+      ((#f . exn)
+       (if (>= attempt times)
+           (raise-exception exn)
+           (begin
+             (simple-format
+              (current-error-port)
+              "error: ~A, retrying in ~A\n"
+              exn
+              delay)
+             (sleep delay)
+             (loop (+ 1 attempt))))))))
-- 
cgit v1.2.3