Move output hash related operations in to the dedicated thread

So in case of connection loss, this still happens and the work to compute the
hash isn't wasted.

1 files changed, 51 insertions, 59 deletions

diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index 7fe3dd4..389277f 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -280,7 +280,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
   (define logger
     (build-coordinator-logger build-coordinator))
 
-  (define (compute-hash-of-uploaded-output channel filename)
+  (define (compute-hash-of-uploaded-output channel filename output-filename)
      (with-exception-handler
          (lambda (exn)
            (log-msg logger
@@ -307,22 +307,36 @@ port. Also, the port used can be changed by passing the --port option.\n"
 
            exn)
        (lambda ()
-         (bytevector->nix-base32-string
-          (call-with-input-file filename
-            (lambda (compressed-port)
-              (call-with-lzip-input-port
-               compressed-port
-               (lambda (port)
-                 (port-hash* (hash-algorithm sha256)
-                             port
-                             #:reporter
-                             (progress-reporter/hash
-                              (stat:size (stat filename))
-                              (lambda (processed-bytes)
-                                (put-message
-                                 channel
-                                 `(update ,filename ,processed-bytes))))))))
-            #:binary #t)))
+         (let ((hash
+                (bytevector->nix-base32-string
+                 (call-with-input-file filename
+                   (lambda (compressed-port)
+                     (call-with-lzip-input-port
+                         compressed-port
+                       (lambda (port)
+                         (port-hash* (hash-algorithm sha256)
+                                     port
+                                     #:reporter
+                                     (progress-reporter/hash
+                                      (stat:size (stat filename))
+                                      (lambda (processed-bytes)
+                                        (put-message
+                                         channel
+                                         `(update ,filename ,processed-bytes))))))))
+                   #:binary #t))))
+
+           (log-msg logger
+                    'DEBUG
+                    "computed the hash of " filename ", renaming")
+
+           (call-with-output-file (string-append output-filename ".hash")
+             (lambda (port)
+               (simple-format port "~A\n" hash)))
+
+           (rename-file filename
+                        output-filename)
+
+           hash))
        #:unwind? #t))
 
   (let ((channel (make-channel))
@@ -336,7 +350,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
                (log-msg 'ERROR "exception in output hash thread: " exn))
            (lambda ()
              (match (get-message channel)
-               (('request build-uuid filename update-channel)
+               (('request build-uuid filename output-filename update-channel)
                 (or (and=>
                      (hash-ref update-channels-by-filename
                                filename)
@@ -360,7 +374,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
                           (list 'result
                                 filename
                                 (compute-hash-of-uploaded-output channel
-                                                                 filename))))))))
+                                                                 filename
+                                                                 output-filename))))))))
                (('update filename bytes-processed)
                 (for-each
                  (lambda (update-channel)
@@ -394,7 +409,8 @@ port. Also, the port used can be changed by passing the --port option.\n"
                                          request
                                          response-port
                                          build-uuid
-                                         tmp-output-file-name)
+                                         tmp-output-file-name
+                                         output-file-name)
   (let ((channel (make-channel)))
     (define (write-to-response-port response)
       (display response response-port)
@@ -416,7 +432,7 @@ port. Also, the port used can be changed by passing the --port option.\n"
          (const 'timeout)))))
 
     (put-message output-hash-channel
-                 (list 'request build-uuid tmp-output-file-name channel))
+                 (list 'request build-uuid tmp-output-file-name output-file-name channel))
 
     (let loop ((previous-bytes-processed 0)
                (message (get-message* channel)))
@@ -770,25 +786,13 @@ port. Also, the port used can be changed by passing the --port option.\n"
                   ;; Make sure NGinx gets the response headers
                   (force-output (request-port request))
 
-                  (let ((result (compute-output-hash-via-channel
-                                 output-hash-channel
-                                 request
-                                 response-port
-                                 uuid
-                                 tmp-output-file-name)))
-                    ;; TODO: Maybe do something different here to
-                    ;; indicate the issue to the agent?
-                    (unless (exception? result)
-                      (log-msg logger
-                               'DEBUG
-                               "computed the hash of " tmp-output-file-name ", renaming")
-
-                      (call-with-output-file (string-append output-file-name ".hash")
-                        (lambda (port)
-                          (simple-format port "~A\n" result)))
-
-                      (rename-file tmp-output-file-name
-                                   output-file-name))))))
+                  (compute-output-hash-via-channel
+                   output-hash-channel
+                   request
+                   response-port
+                   uuid
+                   tmp-output-file-name
+                   output-file-name))))
              (render-json
               '(("error" . "access denied"))
               #:code 403))))
@@ -851,25 +855,13 @@ port. Also, the port used can be changed by passing the --port option.\n"
                   ;; Make sure NGinx gets the response headers
                   (force-output (request-port request))
 
-                  (let ((result (compute-output-hash-via-channel
-                                 output-hash-channel
-                                 request
-                                 response-port
-                                 uuid
-                                 tmp-output-file-name)))
-                    ;; TODO: Maybe do something different here to
-                    ;; indicate the issue to the agent?
-                    (unless (exception? result)
-                      (log-msg logger
-                               'DEBUG
-                               "computed the hash of " tmp-output-file-name ", renaming")
-
-                      (call-with-output-file (string-append output-file-name ".hash")
-                        (lambda (port)
-                          (simple-format port "~A\n" result)))
-
-                      (rename-file tmp-output-file-name
-                                   output-file-name))))))
+                  (compute-output-hash-via-channel
+                   output-hash-channel
+                   request
+                   response-port
+                   uuid
+                   tmp-output-file-name
+                   output-file-name))))
              (render-json
               '(("error" . "access denied"))
               #:code 403))))