From df656c1518a2b8008e0d26fc98bc36673eac64a6 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Fri, 29 Jan 2021 11:35:03 +0100
Subject: [PATCH] tests: cuirass: Add Cuirass remote test.

* gnu/tests/cuirass.scm (run-cuirass-test): Add "name" and "remote-build?"
arguments.
(%cuirass-test): Adapt it.
(%cuirass-remote-test): New variable.
---
 gnu/tests/cuirass.scm | 74 +++++++++++++++++++++++++++++++------------
 1 file changed, 53 insertions(+), 21 deletions(-)

diff --git a/gnu/tests/cuirass.scm b/gnu/tests/cuirass.scm
index 209e995d44..391f4820df 100644
--- a/gnu/tests/cuirass.scm
+++ b/gnu/tests/cuirass.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2020 Mathieu Othacehe <othacehe@gnu.org>
+;;; Copyright © 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,11 +30,13 @@ (define-module (gnu tests cuirass)
   #:use-module (gnu services cuirass)
   #:use-module (gnu services databases)
   #:use-module (gnu services networking)
+  #:use-module (gnu system nss)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:export (%cuirass-test))
+  #:export (%cuirass-test
+            %cuirass-remote-test))
 
-(define (run-cuirass-test)
+(define* (run-cuirass-test name #:key remote-build?)
   (define %cuirass-specs
     #~(list
        '((#:name . "test")
@@ -93,6 +95,8 @@ (define os
       (service cuirass-service-type
                (cuirass-configuration
                 (specifications %cuirass-specs)
+                (remote-server (and remote-build?
+                                    (cuirass-remote-server-configuration)))
                 (host "0.0.0.0")
                 (use-substitutes? #t)))
       (service dhcp-client-service-type)
@@ -135,12 +139,25 @@ (define os
                           (guix build syscalls)
                           (guix build utils))))
 
+  (define os*
+    (operating-system
+      (inherit os)
+      (name-service-switch %mdns-host-lookup-nss)
+      (services
+       (append (if remote-build?
+                   (list
+                    (service avahi-service-type)
+                    (service cuirass-remote-worker-service-type
+                             (cuirass-remote-worker-configuration)))
+                   '())
+               (operating-system-user-services os)))))
+
   (define cuirass-web-port 8081)
   (define forward-port 5000)
 
   (define vm
     (virtual-machine
-     (operating-system os)
+     (operating-system os*)
      (memory-size 1024)
      (port-forwardings `((,forward-port . ,cuirass-web-port)))))
 
@@ -169,13 +186,13 @@ (define* (retry f #:key times delay)
               (let loop ((attempt 1))
                 (let ((result (f)))
                   (cond
-                    (result result)
-                    (else
-                     (if (>= attempt times)
-                         #f
-                         (begin
-                           (sleep delay)
-                           (loop (+ 1 attempt)))))))))
+                   (result result)
+                   (else
+                    (if (>= attempt times)
+                        #f
+                        (begin
+                          (sleep delay)
+                          (loop (+ 1 attempt)))))))))
 
             (mkdir #$output)
             (chdir #$output)
@@ -205,12 +222,18 @@ (define* (retry f #:key times delay)
             (test-equal "cuirass-web evaluation"
               "test"
               (begin
-                (let-values (((response text)
-                              (query "/api/evaluation?id=1")))
-                  (let ((result
-                         (json-string->scm
-                          (utf8->string text))))
-                    (assoc-ref result "specification")))))
+                (retry
+                 (lambda ()
+                   (let-values (((response text)
+                                 (query "/api/evaluation?id=1")))
+                     (let ((result
+                            (false-if-exception
+                             (json-string->scm
+                              (utf8->string text)))))
+                       (and result
+                            (assoc-ref result "specification")))))
+                 #:times 5
+                 #:delay 5)))
 
             ;; Even though there's a store overlay, the Guix database is not
             ;; initialized, meaning that we won't be able to perform the
@@ -226,8 +249,11 @@ (define* (retry f #:key times delay)
                              (utf8->string text))))
                        (match (vector->list result)
                          ((build)
-                          (string=? (assoc-ref build "job")
-                                    "test-job"))
+                          (and (string=? (assoc-ref build "job")
+                                         "test-job")
+                               (or (not #$remote-build?)
+                                   ;; Check if the build is started.
+                                   (= (assoc-ref build "buildstatus") -1))))
                          (else #f)))))
                  #:times 5
                  #:delay 5)))
@@ -235,10 +261,16 @@ (define* (retry f #:key times delay)
             (test-end)
             (exit (= (test-runner-fail-count (test-runner-current)) 0))))))
 
-  (gexp->derivation "cuirass-test" test))
+  (gexp->derivation name test))
 
 (define %cuirass-test
   (system-test
    (name "cuirass")
    (description "Connect to a Cuirass server.")
-   (value (run-cuirass-test))))
+   (value (run-cuirass-test name))))
+
+(define %cuirass-remote-test
+  (system-test
+   (name "cuirass-remote")
+   (description "Connect to a Cuirass server with remote build.")
+   (value (run-cuirass-test name #:remote-build? #t))))