From 8b113790fa3bfd2300c737901ba161f079fedbdf Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 18 Jul 2017 10:41:51 +0200
Subject: tests: Use 'virtual-machine' records instead of monadic procedures.

* gnu/tests/base.scm (%test-basic-os): Use 'let*' instead of 'mlet*' and
'virtual-machine' instead of 'system-qemu-image/shared-store-script'.
(run-mcron-test): Likewise.
(run-nss-mdns-test): Likewise.
* gnu/tests/dict.scm (run-dicod-test): Likewise.
* gnu/tests/mail.scm (run-opensmtpd-test): Likewise.
(run-exim-test): Likewise.
* gnu/tests/messaging.scm (run-xmpp-test): Likewise.
* gnu/tests/networking.scm (run-inetd-test): Likewise.
* gnu/tests/nfs.scm (run-nfs-test): Likewise.
* gnu/tests/ssh.scm (run-ssh-test): Likewise.
* gnu/tests/web.scm (run-nginx-test): Likewise.
---
 gnu/tests/web.scm | 125 +++++++++++++++++++++++++++---------------------------
 1 file changed, 62 insertions(+), 63 deletions(-)

(limited to 'gnu/tests/web.scm')

diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index bc7e3b89a9..3fa272c676 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -27,7 +27,6 @@
   #:use-module (gnu services networking)
   #:use-module (guix gexp)
   #:use-module (guix store)
-  #:use-module (guix monads)
   #:export (%test-nginx))
 
 (define %index.html-contents
@@ -65,68 +64,68 @@
 (define* (run-nginx-test #:optional (http-port 8042))
   "Run tests in %NGINX-OS, which has nginx running and listening on
 HTTP-PORT."
-  (mlet* %store-monad ((os ->   (marionette-operating-system
-                                 %nginx-os
-                                 #:imported-modules '((gnu services herd)
-                                                      (guix combinators))))
-                       (command (system-qemu-image/shared-store-script
-                                 os #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (srfi srfi-11) (srfi srfi-64)
-                         (gnu build marionette)
-                         (web uri)
-                         (web client)
-                         (web response))
-
-            (define marionette
-              ;; Forward the guest's HTTP-PORT, where nginx is listening, to
-              ;; port 8080 in the host.
-              (make-marionette (list #$command "-net"
-                                     (string-append
-                                      "user,hostfwd=tcp::8080-:"
-                                      #$(number->string http-port)))))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "nginx")
-
-            ;; Wait for nginx to be up and running.
-            (test-eq "service running"
-              'running!
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'nginx)
-                  'running!)
-               marionette))
-
-            ;; Make sure the PID file is created.
-            (test-assert "PID file"
-              (marionette-eval
-               '(file-exists? "/var/run/nginx/pid")
-               marionette))
-
-            ;; Retrieve the index.html file we put in /srv.
-            (test-equal "http-get"
-              '(200 #$%index.html-contents)
-              (let-values (((response text)
-                            (http-get "http://localhost:8080/index.html"
-                                      #:decode-body? #t)))
-                (list (response-code response) text)))
-
-            ;; There should be a log file in here.
-            (test-assert "log file"
-              (marionette-eval
-               '(file-exists? "/var/log/nginx/access.log")
-               marionette))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation "nginx-test" test)))
+  (define os
+    (marionette-operating-system
+     %nginx-os
+     #:imported-modules '((gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings `((8080 . ,http-port)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette)
+                       (web uri)
+                       (web client)
+                       (web response))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "nginx")
+
+          ;; Wait for nginx to be up and running.
+          (test-eq "service running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'nginx)
+                'running!)
+             marionette))
+
+          ;; Make sure the PID file is created.
+          (test-assert "PID file"
+            (marionette-eval
+             '(file-exists? "/var/run/nginx/pid")
+             marionette))
+
+          ;; Retrieve the index.html file we put in /srv.
+          (test-equal "http-get"
+            '(200 #$%index.html-contents)
+            (let-values (((response text)
+                          (http-get "http://localhost:8080/index.html"
+                                    #:decode-body? #t)))
+              (list (response-code response) text)))
+
+          ;; There should be a log file in here.
+          (test-assert "log file"
+            (marionette-eval
+             '(file-exists? "/var/log/nginx/access.log")
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "nginx-test" test))
 
 (define %test-nginx
   (system-test
-- 
cgit v1.2.3