diff options
author | Leo Famulari <leo@famulari.name> | 2017-07-23 03:42:12 -0400 |
---|---|---|
committer | Leo Famulari <leo@famulari.name> | 2017-07-23 03:42:12 -0400 |
commit | 6c1a317e29c45e85e3a0e050612cdefe470b100c (patch) | |
tree | e65dedf933090b1a9f8398655b3b20eba49fae96 /gnu/tests/web.scm | |
parent | b7158b767b7fd9f0379dfe08083c48a0cf0f3d50 (diff) | |
parent | 9478c05955643f8ff95dabccc1e42b20abb88049 (diff) | |
download | patches-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.scm | 125 |
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 |