From 0eb708c8117db8ca849348c3cfc4981948944800 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 7 Aug 2021 14:43:48 +0100
Subject: Move retrying uploads out of the with-upload-slot region

Such that the retry happens with a fresh slot (and the associated tracking
information).
---
 guix-build-coordinator/agent-messaging/http.scm | 22 ++++++++-----------
 guix-build-coordinator/agent.scm                | 28 ++++++++++++++-----------
 2 files changed, 25 insertions(+), 25 deletions(-)

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 5e753eb..5ae2929 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -266,19 +266,15 @@
        (with-store store
          (query-path-info store file)))
 
-     (retry-on-error
-      (lambda ()
-        (call-with-streaming-http-request
-         uri
-         (lambda (port)
-           (call-with-lzip-output-port port
-             (lambda (port)
-               (write-file file port))
-             #:level 9))
-         #:headers `((Authorization . ,auth-value))
-         #:report-bytes-sent report-bytes-sent))
-      #:times 48
-      #:delay (random 15)))
+     (call-with-streaming-http-request
+      uri
+      (lambda (port)
+        (call-with-lzip-output-port port
+          (lambda (port)
+            (write-file file port))
+          #:level 9))
+      #:headers `((Authorization . ,auth-value))
+      #:report-bytes-sent report-bytes-sent))
    args))
 
 (define-method (submit-log-file
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index d2611b7..b75fdca 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -838,18 +838,22 @@ but the guix-daemon claims it's unavailable"
       #:unwind? #t))
 
   (define (submit-one-output output-name output)
-    (with-upload-slot
-     lgr
-     (derivation-output-path output)
-     (lambda (report-bytes-sent)
-       (log-msg lgr 'INFO
-                build-id ": submitting output "
-                (derivation-output-path output))
-       (submit-output coordinator-interface
-                      build-id output-name
-                      (derivation-output-path output)
-                      #:log (build-log-procedure lgr build-id)
-                      #:report-bytes-sent report-bytes-sent))))
+    (retry-on-error
+     (lambda ()
+       (with-upload-slot
+        lgr
+        (derivation-output-path output)
+        (lambda (report-bytes-sent)
+          (log-msg lgr 'INFO
+                   build-id ": submitting output "
+                   (derivation-output-path output))
+          (submit-output coordinator-interface
+                         build-id output-name
+                         (derivation-output-path output)
+                         #:log (build-log-procedure lgr build-id)
+                         #:report-bytes-sent report-bytes-sent))))
+     #:times 48
+     #:delay (random 15)))
 
   (if submit-outputs?
       (begin
-- 
cgit v1.2.3