Implement initial support for resuming HTTP uploads

This means agents reattempting uploads don't have to start from scratch, and
can instead pick up from what's already been uploaded to the coordinator.

1 files changed, 42 insertions, 20 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index a29c908..2252293 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -253,6 +253,20 @@
                       #:key
                       (log default-log)
                       report-bytes-sent)
+     (define (get-partial-upload-bytes)
+       (let-values (((body response)
+                     (coordinator-http-request
+                      log
+                      interface
+                      (string-append "/build/" build-id
+                                     "/output/" output-name
+                                     "/partial")
+                      #:method 'HEAD)))
+         (if (eq? (response-code response)
+                  404)
+             #f
+             (response-content-length response))))
+
      (define auth-value
        (string-append
         "Basic "
@@ -262,10 +276,11 @@
                          ":"
                          (slot-ref interface 'password))))))
 
-     (define uri
+     (define* (uri #:key resume?)
        (coordinator-uri-for-path
         (slot-ref interface 'coordinator-uri)
-        (string-append "/build/" build-id "/output/" output-name)))
+        (string-append "/build/" build-id "/output/" output-name
+                       (if resume? "/partial" ""))))
 
      (define path-info
        (with-store store
@@ -287,24 +302,31 @@
         (lambda ()
           (call-with-input-file template
             (lambda (file-port)
-              (let-values (((response body)
-                            (call-with-streaming-http-request
-                             uri
-                             (lambda (port)
-                               (with-time-logging
-                                   (simple-format #f "sending ~A" file)
-                                 (dump-port file-port port
-                                            #:buffer-size 65536)))
-                             #:headers `((Authorization . ,auth-value)))))
-                (when (>= (response-code response) 400)
-                  (raise-exception
-                   (make-exception-with-message
-                    (coordinator-handle-failed-request log
-                                                       'PUT
-                                                       (uri-path uri)
-                                                       response
-                                                       body))))))))
-        #:times 12
+              (let ((bytes (get-partial-upload-bytes)))
+                (when bytes
+                  (seek file-port bytes SEEK_SET)
+                  (log 'INFO "resuming upload from byte " bytes))
+
+                (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 (bytes) (when (eq? bytes 65536) (error "FOO"))))))
+                  (when (>= (response-code response) 400)
+                    (raise-exception
+                     (make-exception-with-message
+                      (coordinator-handle-failed-request log
+                                                         'PUT
+                                                         (uri-path uri)
+                                                         response
+                                                         body)))))))))
+        #:times 100
         #:delay (random 15))
 
        (delete-file template)))