From df85c9e7d3f0ef49f761f43e0edf105bf31949c7 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 19 Oct 2022 10:42:11 +0100
Subject: Tweak output uploading code

Force sending the file from the start the first time the upload is attempted.
---
 guix-build-coordinator/agent-messaging/http.scm | 115 +++++++++++++-----------
 1 file changed, 61 insertions(+), 54 deletions(-)

(limited to 'guix-build-coordinator/agent-messaging/http.scm')

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index deac4cd..217b2c1 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -313,11 +313,7 @@
                          ":"
                          (slot-ref interface 'password))))))
 
-     (define* (uri #:key resume?)
-       (coordinator-uri-for-path
-        (slot-ref interface 'coordinator-uri)
-        (string-append "/build/" build-id "/output/" output-name
-                       (if resume? "/partial" ""))))
+     (define %force-full-upload #t)
 
      (define (perform-upload)
        (define reset-timeout/throttled
@@ -326,63 +322,74 @@
            (lambda ()
              (reset-timeout (* 5 60)))))
 
-       (let* ((partial-upload-bytes (get-partial-upload-bytes))
-              (completed-upload-bytes (get-completed-upload-bytes))
-              (bytes (or partial-upload-bytes
-                         completed-upload-bytes)))
-         ;; Check if the server has all the bytes
-         (unless (and bytes
-                      (eq? bytes file-size))
-           (if bytes
+       (unless (and=>
+                (get-completed-upload-bytes)
+                (lambda (uploaded-bytes)
+                  (eq? uploaded-bytes file-size)))
+
+         (let* ((partial-upload-bytes (if %force-full-upload
+                                          #f
+                                          (get-partial-upload-bytes))))
+           (if partial-upload-bytes
                (log 'DEBUG "still more to send (bytes: " file-size
-                    ", partial upload bytes: " partial-upload-bytes
-                    ", completed upload bytes: " completed-upload-bytes ")")
+                    ", partial upload bytes: " partial-upload-bytes ")")
                (begin
                  (log 'DEBUG "starting sending file from start")
+                 (set! %force-full-upload #f)
                  (report-bytes-sent 'reset)))
 
            ;; Still more to send
            (call-with-input-file file
              (lambda (file-port)
-               (when bytes
-                 (seek file-port bytes SEEK_SET)
-                 (log 'INFO "resuming upload from byte " bytes))
-
-               (with-timeout (* 5 60) ; 5 minutes
-                 (raise-exception
-                  (make-exception-with-message "timeout submitting output"))
-                 (let-values (((response body)
-                               (call-with-streaming-http-request
-                                (uri #:resume? (integer? bytes))
-                                (lambda (port)
-                                  (with-time-logging
-                                      (simple-format #f "sending ~A" file)
-                                    (dump-port file-port port
-                                               #:buffer-size 65536)))
-                                #:headers `((Authorization . ,auth-value))
-                                #:method (if bytes 'POST 'PUT)
-                                #:report-bytes-sent
-                                (lambda args
-                                  (reset-timeout/throttled)
-                                  (apply report-bytes-sent args)))))
-                   (log 'DEBUG "perform upload " file ", response code: "
-                        (response-code response))
-
-                   (when (>= (response-code response) 400)
-                     (raise-exception
-                      (make-exception-with-message
-                       (coordinator-handle-failed-request
-                        log
-                        'PUT
-                        (uri-path
-                         (uri #:resume? (integer? bytes)))
-                        response
-                        body)))))))))))
-
-     (unless (get-completed-upload-bytes)
-       (retry-on-error perform-upload
-                       #:times 500
-                       #:delay (+ 60 (random 15)))))
+               (when partial-upload-bytes
+                 (seek file-port partial-upload-bytes SEEK_SET)
+                 (log 'INFO "resuming upload from byte " partial-upload-bytes))
+
+               (let ((upload-uri
+                      (coordinator-uri-for-path
+                       (slot-ref interface 'coordinator-uri)
+                       (string-append "/build/" build-id "/output/" output-name
+                                      (if (integer? partial-upload-bytes)
+                                          "/partial"
+                                          "")))))
+
+                 (with-timeout (* 5 60) ; 5 minutes
+                   (raise-exception
+                    (make-exception-with-message "timeout submitting output"))
+                   (let-values (((response body)
+                                 (call-with-streaming-http-request
+                                  upload-uri
+                                  (lambda (port)
+                                    (with-time-logging
+                                        (simple-format #f "sending ~A" file)
+                                      (dump-port file-port port
+                                                 #:buffer-size 65536)))
+                                  #:headers `((Authorization . ,auth-value))
+                                  #:method (if partial-upload-bytes 'POST 'PUT)
+                                  #:report-bytes-sent
+                                  (lambda args
+                                    (reset-timeout/throttled)
+                                    (apply report-bytes-sent args)))))
+                     (log 'DEBUG "perform upload " file ", response code: "
+                          (response-code response))
+
+                     (when (>= (response-code response) 400)
+                       (raise-exception
+                        (make-exception-with-message
+                         (coordinator-handle-failed-request
+                          log
+                          'PUT
+                          (uri-path upload-uri)
+                          response
+                          body))))))))))))
+
+       (unless (and=>
+                (get-completed-upload-bytes)
+                (lambda (uploaded-bytes)
+                  (eq? uploaded-bytes file-size)))
+         (retry-on-error perform-upload
+                         #:times 100
+                         #:delay 40)))
    args))
 
 (define-method (submit-log-file
-- 
cgit v1.2.3