From b37a051b82efbc0c521c533176e22bf68fd7e18f Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 16 Nov 2021 20:35:54 +0000
Subject: Check if an output has been uploaded before trying to upload it

This can help if the output has been uploaded, but the hash isn't present,
since trying to submit the build result will prompt for the output to be sent
again, but it doesn't need to be, the agent just needs to wait.

This is a little inelegant, maybe there needs to be some way for the agent to
explicitly check for the hash to be computed, but I'm hoping these changes
will help with uploading large outputs.
---
 guix-build-coordinator/agent-messaging/http.scm | 120 ++++++++++++++----------
 1 file changed, 69 insertions(+), 51 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 9116b05..ac45ca3 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -267,6 +267,19 @@
              #f
              (response-content-length response))))
 
+     (define (get-completed-upload-bytes)
+       (let-values (((body response)
+                     (coordinator-http-request
+                      log
+                      interface
+                      (string-append "/build/" build-id
+                                     "/output/" output-name)
+                      #:method 'HEAD)))
+         (if (eq? (response-code response)
+                  404)
+             #f
+             (response-content-length response))))
+
      (define auth-value
        (string-append
         "Basic "
@@ -286,57 +299,62 @@
        (with-store store
          (query-path-info store file)))
 
-     (let* ((directory (or (getenv "TMPDIR") "/tmp"))
-            (template  (string-append directory
-                                      "/guix-build-coordinator-file.XXXXXX"))
-            (out       (mkstemp! template)))
-       (log 'INFO "compressing " file " -> " template " prior to sending")
-       (call-with-lzip-output-port out
-         (lambda (port)
-           (write-file file port))
-         #:level 9)
-       (close-port out)
-
-       (log 'INFO "finished compressing " file ", now sending")
-       (retry-on-error
-        (lambda ()
-          (let ((bytes (get-partial-upload-bytes)))
-            ;; Check if the server has all the bytes
-            (unless (and bytes
-                         (eq? bytes (stat:size (stat template))))
-
-              ;; Still more to send
-              (call-with-input-file template
-                (lambda (file-port)
-                  (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 report-bytes-sent)))
-                    (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))))))))))
-        #:times 100
-        #:delay (random 15))
-
-       (delete-file template)))
+     (define (perform-upload)
+       (let* ((directory (or (getenv "TMPDIR") "/tmp"))
+              (template  (string-append directory
+                                        "/guix-build-coordinator-file.XXXXXX"))
+              (out       (mkstemp! template)))
+         (log 'INFO "compressing " file " -> " template " prior to sending")
+         (call-with-lzip-output-port out
+           (lambda (port)
+             (write-file file port))
+           #:level 9)
+         (close-port out)
+
+         (log 'INFO "finished compressing " file ", now sending")
+         (retry-on-error
+          (lambda ()
+            (let ((bytes (or (get-partial-upload-bytes)
+                             (get-completed-upload-bytes))))
+              ;; Check if the server has all the bytes
+              (unless (and bytes
+                           (eq? bytes (stat:size (stat template))))
+
+                ;; Still more to send
+                (call-with-input-file template
+                  (lambda (file-port)
+                    (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 report-bytes-sent)))
+                      (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))))))))))
+          #:times 100
+          #:delay (random 15))
+
+         (delete-file template)))
+
+     (unless (get-completed-upload-bytes)
+       (perform-upload)))
    args))
 
 (define-method (submit-log-file
-- 
cgit v1.2.3