aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests/web.scm
diff options
context:
space:
mode:
authorLeo Famulari <leo@famulari.name>2017-07-23 03:42:12 -0400
committerLeo Famulari <leo@famulari.name>2017-07-23 03:42:12 -0400
commit6c1a317e29c45e85e3a0e050612cdefe470b100c (patch)
treee65dedf933090b1a9f8398655b3b20eba49fae96 /gnu/tests/web.scm
parentb7158b767b7fd9f0379dfe08083c48a0cf0f3d50 (diff)
parent9478c05955643f8ff95dabccc1e42b20abb88049 (diff)
downloadpatches-6c1a317e29c45e85e3a0e050612cdefe470b100c.tar
patches-6c1a317e29c45e85e3a0e050612cdefe470b100c.tar.gz
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/tests/web.scm')
-rw-r--r--gnu/tests/web.scm125
1 files changed, 62 insertions, 63 deletions
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