aboutsummaryrefslogtreecommitdiff
path: root/gnu/tests/web.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-09-07 22:29:40 +0200
committerLudovic Courtès <ludo@gnu.org>2018-09-10 12:12:50 +0200
commit19de8273eefceac1ba6ddc8d7e374a13f57c678b (patch)
tree66d77ef9a6500cc3feb630bf5c3c3a977d2bac21 /gnu/tests/web.scm
parentd930374014eb159ef1e01d7c54d04fadd4889e4a (diff)
downloadguix-19de8273eefceac1ba6ddc8d7e374a13f57c678b.tar
guix-19de8273eefceac1ba6ddc8d7e374a13f57c678b.tar.gz
services: tailon: Move to (gnu services web).
This allows (gnu services admin) to remain deeper in the module graph and to be used by (gnu services web). * gnu/services/admin.scm (<tailon-configuration-file>) (tailon-configuration-files-string) (tailon-configuration-file-compiler, <tailon-configuration>) (tailon-shepherd-service, %tailon-accounts) (tailon-service-type): Move to... * gnu/services/web.scm: ... here. * gnu/tests/admin.scm: Remove. Move test to... * gnu/tests/web.scm (%tailon-os) (run-tailon-test, %test-tailon): ... here.
Diffstat (limited to 'gnu/tests/web.scm')
-rw-r--r--gnu/tests/web.scm99
1 files changed, 98 insertions, 1 deletions
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index 73d502dd0e..45fcb668fb 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -33,7 +33,8 @@
#:export (%test-httpd
%test-nginx
%test-php-fpm
- %test-hpcguix-web))
+ %test-hpcguix-web
+ %test-tailon))
(define %index.html-contents
;; Contents of the /index.html file.
@@ -359,3 +360,99 @@ HTTP-PORT, along with php-fpm."
(name "hpcguix-web")
(description "Connect to a running hpcguix-web server.")
(value (run-hpcguix-web-server-test name %hpcguix-web-os))))
+
+
+(define %tailon-os
+ ;; Operating system under test.
+ (simple-operating-system
+ (dhcp-client-service)
+ (service tailon-service-type
+ (tailon-configuration
+ (config-file
+ (tailon-configuration-file
+ (bind "0.0.0.0:8080")))))))
+
+(define* (run-tailon-test #:optional (http-port 8081))
+ "Run tests in %TAILON-OS, which has tailon running and listening on
+HTTP-PORT."
+ (define os
+ (marionette-operating-system
+ %tailon-os
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (port-forwardings `((,http-port . 8080)))))
+
+ (define test
+ (with-imported-modules '((gnu build marionette))
+ #~(begin
+ (use-modules (srfi srfi-11) (srfi srfi-64)
+ (ice-9 match)
+ (gnu build marionette)
+ (web uri)
+ (web client)
+ (web response))
+
+ (define marionette
+ ;; Forward the guest's HTTP-PORT, where tailon is listening, to
+ ;; port 8080 in the host.
+ (make-marionette (list #$vm)))
+
+ (mkdir #$output)
+ (chdir #$output)
+
+ (test-begin "tailon")
+
+ (test-assert "service running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (start-service 'tailon))
+ marionette))
+
+ (define* (retry-on-error f #:key times delay)
+ (let loop ((attempt 1))
+ (match (catch
+ #t
+ (lambda ()
+ (cons #t
+ (f)))
+ (lambda args
+ (cons #f
+ args)))
+ ((#t . return-value)
+ return-value)
+ ((#f . error-args)
+ (if (>= attempt times)
+ error-args
+ (begin
+ (sleep delay)
+ (loop (+ 1 attempt))))))))
+
+ (test-equal "http-get"
+ 200
+ (retry-on-error
+ (lambda ()
+ (let-values (((response text)
+ (http-get #$(format
+ #f
+ "http://localhost:~A/"
+ http-port)
+ #:decode-body? #t)))
+ (response-code response)))
+ #:times 10
+ #:delay 5))
+
+ (test-end)
+ (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+ (gexp->derivation "tailon-test" test))
+
+(define %test-tailon
+ (system-test
+ (name "tailon")
+ (description "Connect to a running Tailon server.")
+ (value (run-tailon-test))))