Stop using chunked transfers for file uploads

As the amount of data to upload is known, this is unnecessary complexity and
overhead.

1 files changed, 64 insertions, 66 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 7a56520..2703c91 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -21,6 +21,7 @@
 (define-module (guix-build-coordinator agent-messaging http)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-71)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 threads)
@@ -370,57 +371,58 @@
                      (seek file-port bytes SEEK_SET)
                      (log 'INFO "resuming upload from byte " bytes))
 
-                   (let ((upload-uri
-                          (coordinator-uri-for-path
-                           (slot-ref interface 'coordinator-uri)
-                           (string-append "/build/" build-id "/output/" output-name
-                                          (if (integer? bytes)
-                                              "/partial"
-                                              "")))))
-
-                     (let-values (((response body)
-                                   ;; TODO This chunks the transfer, but it
-                                   ;; doesn't need to since the length of the
-                                   ;; body is known. The chunking is useful
-                                   ;; however, as it matches up with the
-                                   ;; read-request-body hack to avoid reading
-                                   ;; the entire request body in to memory.
-                                   (call-with-streaming-http-request
-                                    upload-uri
-                                    (lambda (port)
-                                      (with-time-logging
-                                          (simple-format #f "sending ~A" file)
-                                        (dump-port* file-port port
-                                                    #:reporter reporter)))
-                                    #:headers `((Authorization . ,auth-value))
-                                    #:method (if bytes 'POST 'PUT))))
-                       (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)
-                  (= uploaded-bytes file-size)))
-         (retry-on-error perform-upload
-                         #:times 100
-                         #:delay 15
-                         #:error-hook
-                         (lambda _
-                           (log 'DEBUG
-                                "perform-upload " file
-                                " (bytes: " file-size ", "
-                                "md5: " (force file-md5-hash-promise)
-                                ")")))))
+                   (let* ((upload-uri
+                           (coordinator-uri-for-path
+                            (slot-ref interface 'coordinator-uri)
+                            (string-append "/build/" build-id "/output/" output-name
+                                           (if (integer? bytes)
+                                               "/partial"
+                                               ""))))
+                          (bytes-to-send
+                           (if bytes
+                               (- file-size bytes)
+                               file-size))
+                          (response
+                           body
+                           (call-with-streaming-http-request
+                            upload-uri
+                            bytes-to-send
+                            (lambda (port)
+                              (with-time-logging
+                                  (simple-format #f "sending ~A" file)
+                                (dump-port* file-port port
+                                            #:reporter reporter)))
+                            #:headers `((Authorization . ,auth-value))
+                            #:method (if bytes 'POST 'PUT))))
+
+                     (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))))))
+                 #:binary #t)))))
+
+     (unless (and=>
+              (get-completed-upload-bytes)
+              (lambda (uploaded-bytes)
+                (= uploaded-bytes file-size)))
+       (retry-on-error perform-upload
+                       #:times 100
+                       #:delay 15
+                       #:error-hook
+                       (lambda _
+                         (log 'DEBUG
+                              "perform-upload " file
+                              " (bytes: " file-size ", "
+                              "md5: " (force file-md5-hash-promise)
+                              ")")))))
    args))
 
 (define-method (submit-log-file
@@ -452,21 +454,17 @@
 
      (retry-on-error
       (lambda ()
-        (let-values (((response body)
-                      ;; TODO This chunks the transfer, but it doesn't need to
-                      ;; since the length of the body is known. The chunking
-                      ;; is useful however, as it matches up with the
-                      ;; read-request-body hack to avoid reading the entire
-                      ;; request body in to memory.
-                      (call-with-streaming-http-request
-                       uri
-                       (lambda (request-port)
-                         (call-with-input-file file
-                           (lambda (file-port)
-                             (dump-port file-port request-port
-                                        #:buffer-size (expt 2 20)))
-                           #:binary #t))
-                       #:headers `((Authorization . ,auth-value)))))
+        (let ((response
+               body
+               (call-with-streaming-http-request
+                uri
+                (stat:size (stat file))
+                (lambda (request-port)
+                  (call-with-input-file file
+                    (lambda (file-port)
+                      (dump-port file-port request-port))
+                    #:binary #t))
+                #:headers `((Authorization . ,auth-value)))))
           (if (>= (response-code response) 400)
               (raise-exception
                (make-exception-with-message