From d773cf49579af6a96736959e97314ce1218382e7 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 24 Oct 2020 14:54:45 +0100
Subject: Better handle agent errors on the coordinator side

Things like the agent not having the log file, or an output. This will allow
the agent to actually retry the relevant thing.
---
 .../agent-messaging/http/server.scm                | 31 +++++++++++++---------
 guix-build-coordinator/coordinator.scm             | 19 ++++++++-----
 2 files changed, 31 insertions(+), 19 deletions(-)

diff --git a/guix-build-coordinator/agent-messaging/http/server.scm b/guix-build-coordinator/agent-messaging/http/server.scm
index c9d70d6..a8e0d46 100644
--- a/guix-build-coordinator/agent-messaging/http/server.scm
+++ b/guix-build-coordinator/agent-messaging/http/server.scm
@@ -457,16 +457,21 @@ port. Also, the port used can be changed by passing the --port option.\n"
         "not-found"
         #:code 404))))
 
-  (call-with-error-handling
-   controller-thunk
-   #:on-error 'backtrace
-   #:post-error (lambda args
-                  (match method-and-path-components
-                    ((method path-components ...)
-                     (simple-format
-                      (current-error-port)
-                      "error: when processing: /~A ~A\n"
-                      method (string-join path-components "/"))))
-                  (render-json
-                   `((error . ,(simple-format #f "~A" args)))
-                   #:code 500))))
+  (with-exception-handler
+      (lambda (exn)
+        (match method-and-path-components
+          ((method path-components ...)
+           (simple-format
+            (current-error-port)
+            "error: when processing: /~A ~A\n"
+            method (string-join path-components "/"))))
+        (if (agent-error? exn)
+            (render-json
+             `((error . ,(agent-error-details exn)))
+             #:code 400)
+            (render-json
+             `((error . ,(simple-format #f "~A" exn)))
+             #:code 500)))
+    controller-thunk
+    #:unwind? #t))
+
diff --git a/guix-build-coordinator/coordinator.scm b/guix-build-coordinator/coordinator.scm
index 62d181b..bc742cf 100644
--- a/guix-build-coordinator/coordinator.scm
+++ b/guix-build-coordinator/coordinator.scm
@@ -42,7 +42,10 @@
   #:use-module (guix-build-coordinator build-allocator)
   #:use-module (guix-build-coordinator agent-messaging http server)
   #:use-module (guix-build-coordinator client-communication)
-  #:export (make-build-coordinator
+  #:export (agent-error?
+            agent-error-details
+
+            make-build-coordinator
             build-coordinator-datastore
             build-coordinator-hooks
             build-coordinator-metrics-registry
@@ -68,6 +71,11 @@
             handle-build-result
             handle-setup-failure-report))
 
+(define-exception-type &agent-error &error
+  make-agent-error
+  agent-error?
+  (details agent-error-details))
+
 (define-record-type <build-coordinator>
   (make-build-coordinator-record datastore hooks metrics-registry
                                  allocation-strategy)
@@ -527,12 +535,12 @@
        (let ((build-details (datastore-find-build datastore build-id)))
          (when (assq-ref build-details 'processed)
            (raise-exception
-            (make-exception-with-message "build already processed"))))
+            (make-agent-error 'build_already_processed))))
 
        (when success?
          (unless (build-log-file-location build-id)
            (raise-exception
-            (make-exception-with-message "missing build log file")))
+            (make-agent-error 'missing_build_log_file)))
 
          (for-each
           (lambda (output)
@@ -541,9 +549,8 @@
                                                (assq-ref output 'name))))
               (unless (file-exists? output-location)
                 (raise-exception
-                 (make-exception-with-message
-                  (simple-format #f "missing output ~A"
-                                 (assq-ref output 'name)))))))
+                 (make-agent-error
+                  `((missing_output . ,(assq-ref output 'name))))))))
           (datastore-list-build-outputs datastore build-id)))
 
        (datastore-store-build-result datastore
-- 
cgit v1.2.3