From bbf1c54399884df10ed225540f9e1579bdffc9f1 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 5 May 2020 09:13:45 +0100
Subject: Better guard against build setup issues

I've seen an agent miss dependencies, so this should help guard against that.
---
 guix-build-coordinator/agent.scm | 45 +++++++++++++++++++++++++---------------
 1 file changed, 28 insertions(+), 17 deletions(-)

diff --git a/guix-build-coordinator/agent.scm b/guix-build-coordinator/agent.scm
index 9db7e10..d54573e 100644
--- a/guix-build-coordinator/agent.scm
+++ b/guix-build-coordinator/agent.scm
@@ -22,6 +22,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 exceptions)
   #:use-module (rnrs bytevectors)
   #:use-module (web http)
   #:use-module (guix store)
@@ -104,23 +105,33 @@
                           #f))))
                  missing-paths))))
 
-      (if (member #f path-substitutes)
-          (fold (lambda (file substitute-available? result)
-                  (if substitute-available?
-                      result
-                      (cons file result)))
-                '()
-                missing-paths
-                path-substitutes)
-          (begin
-            ;; Download the substitutes
-            (with-store store
-              (set-build-options store
-                                 #:substitute-urls substitute-urls)
-
-              (build-things store missing-paths))
-
-            '()))))
+      (if (null? missing-paths)
+          '()
+          (if (member #f path-substitutes)
+              (fold (lambda (file substitute-available? result)
+                      (if substitute-available?
+                          result
+                          (cons file result)))
+                    '()
+                    missing-paths
+                    path-substitutes)
+              (begin
+                ;; Download the substitutes
+                (with-store store
+                  (set-build-options store
+                                     #:substitute-urls substitute-urls)
+
+                  (build-things store missing-paths))
+
+                ;; Double check everything is actually present.
+                (let ((missing-files (remove file-exists? output-paths)))
+                  (unless (null? missing-files)
+                    (raise-exception
+                     (make-exception-with-message
+                      (simple-format #f "failed to fetch substitutes for: ~A"
+                                     output-paths)))))
+
+                '())))))
 
   (define (delete-outputs derivation)
     (let* ((outputs (derivation-outputs derivation))
-- 
cgit v1.2.3