Compress outputs outside of the upload slot

So that the only thing taking place in the upload slot, is the actual upload,
which should improve throughput.

1 files changed, 36 insertions, 9 deletions

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 1bcbf2f..366666e 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -37,9 +37,11 @@
   #:use-module (logging logger)
   #:use-module (logging port-log)
   #:use-module (prometheus)
+  #:use-module (lzlib)
   #:use-module (guix store)
   #:use-module (guix derivations)
   #:use-module (guix base32)
+  #:use-module (guix serialization)
   #:use-module (guix-build-coordinator utils)
   #:use-module (guix-build-coordinator agent-messaging)
   #:use-module (guix-build-coordinator agent-messaging abstract)
@@ -756,6 +758,9 @@ but the guix-daemon claims it's unavailable"
                             build-id derivation end-time
                             submit-outputs?
                             with-upload-slot)
+  (define outputs
+    (derivation-outputs (read-derivation-from-file derivation)))
+
   (define output-details
     (map
      (match-lambda
@@ -771,8 +776,27 @@ but the guix-daemon claims it's unavailable"
             (references . ,(list->vector
                             (map basename
                                  (path-info-references path-info))))))))
-
-     (derivation-outputs (read-derivation-from-file derivation))))
+     outputs))
+
+  (define compressed-outputs
+    (map (match-lambda
+           ((output-name . output)
+            (let* ((file (derivation-output-path output))
+                   (directory (or (getenv "TMPDIR") "/tmp"))
+                   (template  (string-append directory
+                                             "/guix-build-coordinator-file.XXXXXX"))
+                   (out       (mkstemp! template)))
+              (log-msg lgr '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-msg lgr 'INFO "finished compressing " file)
+
+              (cons output-name template))))
+         outputs))
 
   (define (attempt-submit-build-result)
     (with-exception-handler
@@ -815,8 +839,7 @@ but the guix-daemon claims it's unavailable"
                                        (if (string=? name missing-output-name)
                                            output
                                            #f)))
-                                    (derivation-outputs
-                                     (read-derivation-from-file derivation)))))
+                                    outputs)))
                           (unless missing-output
                             (raise-exception
                              (make-exception
@@ -826,7 +849,9 @@ but the guix-daemon claims it's unavailable"
                                missing-output-name))))
 
                           (submit-one-output missing-output-name
-                                             missing-output))
+                                             missing-output
+                                             (assoc-ref compressed-outputs
+                                                        missing-output-name)))
 
                         (attempt-submit-build-result)))
                (raise-exception
@@ -845,7 +870,7 @@ but the guix-daemon claims it's unavailable"
          #:log (build-log-procedure lgr build-id)))
       #:unwind? #t))
 
-  (define (submit-one-output output-name output)
+  (define (submit-one-output output-name output compressed-file)
     (retry-on-error
      (lambda ()
        (with-upload-slot
@@ -857,7 +882,7 @@ but the guix-daemon claims it's unavailable"
                    (derivation-output-path output))
           (submit-output coordinator-interface
                          build-id output-name
-                         (derivation-output-path output)
+                         compressed-file
                          #:log (build-log-procedure lgr build-id)
                          #:report-bytes-sent report-bytes-sent))))
      #:times 48
@@ -868,8 +893,10 @@ but the guix-daemon claims it's unavailable"
         (log-msg lgr 'INFO build-id ": build successful, submitting outputs")
         (for-each (match-lambda
                     ((output-name . output)
-                     (submit-one-output output-name output)))
-                  (derivation-outputs (read-derivation-from-file derivation)))
+                     (submit-one-output output-name
+                                        output
+                                        (assoc-ref compressed-outputs output-name))))
+                  outputs)
         (log-msg lgr 'INFO build-id
                  ": finished submitting outputs, reporting build success"))
       (begin