Improve the logging from the agent -> coordinator communication

1 files changed, 55 insertions, 37 deletions

diff --git a/guix-build-coordinator/agent-messaging/http.scm b/guix-build-coordinator/agent-messaging/http.scm
index 25fa28c..80d451a 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -29,6 +29,7 @@
   #:use-module (ice-9 binary-ports)
   #:use-module (system repl error-handling)
   #:use-module (rnrs bytevectors)
+  #:use-module (logging logger)
   #:use-module (json)
   #:use-module (web http)
   #:use-module (web client)
@@ -79,12 +80,15 @@
 (define (with-request-mutex thunk)
   (monitor (thunk)))
 
-(define* (coordinator-handle-failed-request method path response body
+(define (default-log level . components)
+  (apply log-msg level components))
+
+(define* (coordinator-handle-failed-request log method path response body
                                             #:key first-request-failed?)
-  (simple-format
-   (current-error-port)
-   "error: coordinator-http-request: ~A ~A: ~A\n"
-   method path (response-code response))
+  (log 'ERROR
+       "coordinator-http-request: "
+       method path " "
+       (response-code response))
 
   (catch #t
     (lambda ()
@@ -93,13 +97,12 @@
           (json-string->scm (utf8->string body))
           (utf8->string body)))
     (lambda (key . args)
-      (simple-format
-       (current-error-port)
-       "error decoding body ~A ~A\n"
-       key args)
+      (log 'ERROR
+           "error decoding body " key " " args)
       #f)))
 
-(define* (coordinator-http-request coordinator-uri agent-uuid password
+(define* (coordinator-http-request log
+                                   coordinator-uri agent-uuid password
                                    path
                                    #:key method body (headers '())
                                    succeed-on-access-denied-retry?)
@@ -130,7 +133,8 @@
       (let ((code (response-code response)))
         (cond
          ((eq? code 400)
-          (and=> (coordinator-handle-failed-request method
+          (and=> (coordinator-handle-failed-request log
+                                                    method
                                                     path
                                                     response
                                                     body)
@@ -141,7 +145,8 @@
 
          ((>= (response-code response) 400)
           (let ((body
-                 (coordinator-handle-failed-request method
+                 (coordinator-handle-failed-request log
+                                                    method
                                                     path
                                                     response
                                                     body)))
@@ -150,9 +155,8 @@
                      (equal? body
                              '(("error" . "access denied"))))
                 (begin
-                  (simple-format
-                   (current-error-port)
-                   "warning: treating access denied response as success\n")
+                  (log 'WARNING
+                       "treating access denied response as success")
                   (values body response))
                 (begin
                   (set! first-request-failed? #t)
@@ -169,16 +173,19 @@
                   #:delay 10
                   #:ignore agent-error-from-coordinator?))
 
-(define (submit-status coordinator-uri agent-uuid password
-                       status)
+(define* (submit-status coordinator-uri agent-uuid password
+                        status
+                        #:key (log default-log))
   (coordinator-http-request
+   log
    coordinator-uri agent-uuid password
    (string-append "/agent/" agent-uuid)
    #:method 'PUT                        ; TODO Should be PATCH
    #:body `((status . ,status))))
 
-(define (submit-output coordinator-uri agent-uuid password
-                       build-id output-name file)
+(define* (submit-output coordinator-uri agent-uuid password
+                        build-id output-name file
+                        #:key (log default-log))
   (define auth-value
     (string-append
      "Basic "
@@ -218,15 +225,14 @@
              (template  (string-append directory
                                        "/guix-build-coordinator-file.XXXXXX"))
              (out       (mkstemp! template)))
-        (simple-format #t "compressing ~A -> ~A prior to sending\n"
-                       file 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)
 
-        (simple-format #t "finished compressing ~A, now sending\n" file)
+        (log 'INFO "finished compressing " file ", now sending")
         (retry-on-error
          (lambda ()
            (with-request-mutex
@@ -238,14 +244,15 @@
                                  uri
                                  (lambda (port)
                                    (with-time-logging
-                                    (simple-format #f "sending ~A" file)
+                                    (log 'INFO "sending " file)
                                     (dump-port file-port port
                                                #:buffer-size (expt 2 20))))
                                  #:headers `((Authorization . ,auth-value)))))
                     (when (>= (response-code response) 400)
                       (raise-exception
                        (make-exception-with-message
-                        (coordinator-handle-failed-request 'PUT
+                        (coordinator-handle-failed-request log
+                                                           'PUT
                                                            (uri-path uri)
                                                            response
                                                            body))))))))))
@@ -254,8 +261,9 @@
 
         (delete-file template))))
 
-(define (submit-log-file coordinator-uri agent-uuid password
-                         build-id file)
+(define* (submit-log-file coordinator-uri agent-uuid password
+                          build-id file
+                          #:key (log default-log))
   (define auth-value
     (string-append
      "Basic "
@@ -291,36 +299,44 @@
           (if (>= (response-code response) 400)
               (raise-exception
                (make-exception-with-message
-                (coordinator-handle-failed-request 'PUT
+                (coordinator-handle-failed-request log
+                                                   'PUT
                                                    (uri-path uri)
                                                    response
                                                    body)))
               (begin
-                (simple-format #t "~A: successfully uploaded log file (~A)\n"
-                               build-id
-                               (response-code response))
+                (log 'INFO
+                     "successfully uploaded log file ("
+                     (response-code response)
+                     ")")
                 #t))))))
    #:times 9
    #:delay (+ 30 (random 60))))
 
-(define (submit-build-result coordinator-uri agent-uuid password
-                             build-id result)
+(define* (submit-build-result coordinator-uri agent-uuid password
+                              build-id result
+                              #:key (log default-log))
   (coordinator-http-request
+   log
    coordinator-uri agent-uuid password
    (string-append "/build/" build-id)
    #:method 'PUT                        ; TODO Should be PATCH
    #:body result))
 
-(define (report-build-start coordinator-uri agent-uuid password
-                            build-id)
+(define* (report-build-start coordinator-uri agent-uuid password
+                             build-id
+                             #:key (log default-log))
   (coordinator-http-request
+   log
    coordinator-uri agent-uuid password
    (string-append "/build/" build-id "/report-build-start")
    #:method 'POST))
 
-(define (report-setup-failure coordinator-uri agent-uuid password
-                              build-id report)
+(define* (report-setup-failure coordinator-uri agent-uuid password
+                               build-id report
+                               #:key (log default-log))
   (coordinator-http-request
+   log
    coordinator-uri agent-uuid password
    (string-append "/build/" build-id "/report-setup-failure")
    #:method 'POST
@@ -329,9 +345,11 @@
 
 (define* (fetch-builds-for-agent coordinator-uri agent-uuid password
                                  systems
-                                 target-count)
+                                 target-count
+                                 #:key (log default-log))
   (vector->list
    (assoc-ref (coordinator-http-request
+               log
                coordinator-uri agent-uuid password
                (string-append "/agent/" agent-uuid "/fetch-builds")
                #:body `((target_count . ,target-count)