From 19de8273eefceac1ba6ddc8d7e374a13f57c678b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 7 Sep 2018 22:29:40 +0200
Subject: 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.
---
 gnu/tests/web.scm | 99 ++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 98 insertions(+), 1 deletion(-)

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

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))))
-- 
cgit v1.2.3