From b782e752205422054c932bd3a8196dcfdc33b346 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 21 Oct 2022 11:43:39 +0100
Subject: Log the file size and md5 hash on the agent side

When errors occur during upload.
---
 guix-build-coordinator/agent-messaging/http.scm | 16 +++++++++++++++-
 guix-build-coordinator/utils.scm                |  6 +++++-
 2 files changed, 20 insertions(+), 2 deletions(-)

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 217b2c1..c4cf59b 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -37,6 +37,8 @@
   #:use-module (web request)
   #:use-module (web response)
   #:use-module (web uri)
+  #:use-module (gcrypt base16)
+  #:use-module (gcrypt hash)
   #:use-module (lzlib)
   #:use-module ((gnutls) #:select (gnutls-version))
   #:use-module ((guix config) #:select (%guix-version))
@@ -277,6 +279,11 @@
      (define file-size
        (stat:size (stat file)))
 
+     (define file-md5-hash-promise
+       (delay
+         (bytevector->base16-string
+          (file-hash (hash-algorithm md5) file))))
+
      (define (get-partial-upload-bytes)
        (let-values (((body response)
                      (coordinator-http-request
@@ -389,7 +396,14 @@
                   (eq? uploaded-bytes file-size)))
          (retry-on-error perform-upload
                          #:times 100
-                         #:delay 40)))
+                         #:delay 40
+                         #:error-hook
+                         (lambda _
+                           (log 'DEBUG
+                                "perform-upload " file
+                                " (bytes: " file-size ", "
+                                "md5: " (force file-md5-hash-promise)
+                                ")")))))
    args))
 
 (define-method (submit-log-file
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 67ebf72..961e225 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -732,7 +732,7 @@ References: ~a~%"
                       (canonical-sexp->string (signed-string info)))))
   (format #f "~aSignature: 1;~a;~a~%" info (gethostname) signature)))
 
-(define* (retry-on-error f #:key times delay ignore)
+(define* (retry-on-error f #:key times delay ignore error-hook)
   (let loop ((attempt 1))
     (match (with-exception-handler
                (lambda (exn)
@@ -773,6 +773,8 @@ References: ~a~%"
               attempt
               times
               delay)
+             (when error-hook
+               (error-hook attempt exn))
              (sleep delay)
              (simple-format
               (current-error-port)
@@ -789,6 +791,8 @@ References: ~a~%"
               attempt
               times
               delay)
+             (when error-hook
+               (error-hook attempt exn))
              (sleep delay)
              (loop (+ 1 attempt))))))))
 
-- 
cgit v1.2.3