From b2989d107ea87f36bc4684cadc0f416bc251d6cb Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 11 May 2023 17:30:04 +0100
Subject: Clean up some handling of uploads for agents

This commit should correct the progress reporting on partial uploads.
---
 guix-build-coordinator/agent-messaging/http.scm |  8 +++-
 guix-build-coordinator/agent.scm                | 53 +++++++++++++------------
 2 files changed, 34 insertions(+), 27 deletions(-)

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 01a2c15..d2e0e0e 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -281,6 +281,7 @@
    (lambda* (build-id output-name file
                       #:key
                       (log default-log)
+                      reporter-set-bytes-already-sent
                       reporter
                       report-bytes-hashed)
      (define file-size
@@ -352,8 +353,11 @@
                       ", partial upload bytes: " bytes ")")
                  (begin
                    (log 'DEBUG "starting sending file from start")
-                   (set! %force-full-upload #f)
-                   (progress-reporter-report! reporter 'reset))))
+
+                   ;; Set this to enable partial uploads when retrying
+                   (set! %force-full-upload #f))))
+
+         (reporter-set-bytes-already-sent (or bytes 0))
 
          (let* ((bytes-to-send
                  (if bytes
diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 2779063..30af393 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -131,6 +131,8 @@
     (define upload-progress-record
       (make-upload-progress file 0 0 total-bytes))
 
+    (define bytes-already-sent 0)
+
     (define last-progress-update-bytes-sent 0)
     (define last-progress-update-bytes-hashed 0)
     (define last-progress-update-time 0)
@@ -151,8 +153,9 @@
                       (let ((total-bytes
                              (upload-progress-total-bytes upload-progress))
                             (bytes-sent
-                             (upload-progress-bytes-sent
-                              upload-progress))
+                             (+ bytes-already-sent
+                                (upload-progress-bytes-sent
+                                 upload-progress)))
                             (bytes-hashed
                              (upload-progress-bytes-hashed
                               upload-progress)))
@@ -171,31 +174,28 @@
          upload-slots)))
 
     (define (report-bytes-sent bytes-now-sent)
-      (if (eq? bytes-now-sent 'reset)
-          (begin
-            (set-upload-progress-bytes-sent! upload-progress-record
-                                             0)
-            (set! last-progress-update-bytes-sent 0))
-          (begin
-            (set-upload-progress-bytes-sent!
-             upload-progress-record
-             bytes-now-sent)
-
-            (when (or (> bytes-now-sent
-                         (+ last-progress-update-bytes-sent 10000000))
-                      (and (> (- (time-second (current-time)))
-                              (+ last-progress-update-time 15))))
-              (set! last-progress-update-bytes-sent
-                    bytes-now-sent)
-              (set! last-progress-update-time
-                    (time-second (current-time)))
-
-              (display-update)))))
+      (set-upload-progress-bytes-sent!
+       upload-progress-record
+       bytes-now-sent)
+
+      (when (or (> bytes-now-sent
+                   (+ last-progress-update-bytes-sent 10000000))
+                (and (> (- (time-second (current-time)))
+                        (+ last-progress-update-time 15))))
+        (set! last-progress-update-bytes-sent
+              bytes-now-sent)
+        (set! last-progress-update-time
+              (time-second (current-time)))
+
+        (display-update)))
+
+    (define (reporter-set-bytes-already-sent bytes)
+      (set! bytes-already-sent bytes))
 
     (define reporter
       (make-progress-reporter
        (lambda ()
-         (report-bytes-sent 'reset))
+         (report-bytes-sent 0))
        report-bytes-sent
        (lambda ()
          (report-bytes-sent total-bytes))))
@@ -250,7 +250,8 @@
 
                           (raise-exception exn))
                       (lambda ()
-                        (p reporter
+                        (p reporter-set-bytes-already-sent
+                           reporter
                            report-bytes-hashed))
                       #:unwind? #t))
                 (lambda vals
@@ -1120,7 +1121,7 @@ but the guix-daemon claims it's unavailable"
      lgr
      (derivation-output-path output)
      bytes
-     (lambda (reporter report-bytes-hashed)
+     (lambda (reporter-set-bytes-already-sent reporter report-bytes-hashed)
        (log-msg lgr 'INFO
                 build-id ": submitting output "
                 (derivation-output-path output))
@@ -1128,6 +1129,8 @@ but the guix-daemon claims it's unavailable"
                       build-id output-name
                       compressed-file
                       #:log (build-log-procedure lgr build-id)
+                      #:reporter-set-bytes-already-sent
+                      reporter-set-bytes-already-sent
                       #:reporter reporter
                       #:report-bytes-hashed report-bytes-hashed)
        (log-msg lgr 'INFO
-- 
cgit v1.2.3