From c146e61ae6edcf0ae2d4eb11cf553e6500326c3a Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 24 Oct 2020 14:57:45 +0100
Subject: Have the agent handle errors from the coordinator

When submitting builds. The agent will now retry the relevant thing, like
uploading the log file if the coordinator says that still needs doing.
---
 guix-build-coordinator/agent-messaging/http.scm | 32 +++++++++++++++++++++----
 1 file changed, 27 insertions(+), 5 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 202b90e..285ef5a 100644
--- a/guix-build-coordinator/agent-messaging/http.scm
+++ b/guix-build-coordinator/agent-messaging/http.scm
@@ -44,7 +44,10 @@
   #:use-module (guix-build-coordinator utils)
   #:use-module (guix-build-coordinator datastore)
   #:use-module (guix-build-coordinator coordinator)
-  #:export (submit-status
+  #:export (agent-error-from-coordinator?
+            agent-error-from-coordinator-details
+
+            submit-status
             submit-log-file
             submit-build-result
             report-build-start
@@ -52,6 +55,11 @@
             submit-output
             fetch-builds-for-agent))
 
+(define-exception-type &agent-error-from-coordinator &error
+  make-agent-error-from-coordinator
+  agent-error-from-coordinator?
+  (details agent-error-from-coordinator-details))
+
 (define (coordinator-uri-for-path base-uri-string agent-path)
   (let* ((base-uri (string->uri base-uri-string))
          (scheme (uri-scheme base-uri))
@@ -119,7 +127,19 @@
                                    #:headers
                                    `((Authorization . ,auth-value)
                                      ,@headers))))))
-      (if (>= (response-code response) 400)
+      (let ((code (response-code response)))
+        (cond
+         ((eq? code 400)
+          (and=> (coordinator-handle-failed-request method
+                                                    path
+                                                    response
+                                                    body)
+                 (lambda (error)
+                   (raise-exception
+                    (make-agent-error-from-coordinator
+                     (assoc-ref error "error"))))))
+
+         ((>= (response-code response) 400)
           (let ((body
                  (coordinator-handle-failed-request method
                                                     path
@@ -138,14 +158,16 @@
                   (set! first-request-failed? #t)
                   (raise-exception
                    (make-exception-with-message
-                    body)))))
+                    body))))))
+         (else
           (values
            (json-string->scm (utf8->string body))
-           response))))
+           response))))))
 
   (retry-on-error make-request
                   #:times 9
-                  #:delay 10))
+                  #:delay 10
+                  #:ignore agent-error-from-coordinator?))
 
 (define (submit-status coordinator-uri agent-uuid password
                        status)
-- 
cgit v1.2.3