diff options
Diffstat (limited to 'gnu/tests/web.scm')
-rw-r--r-- | gnu/tests/web.scm | 104 |
1 files changed, 103 insertions, 1 deletions
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm index 319655396a..fbdf78a036 100644 --- a/gnu/tests/web.scm +++ b/gnu/tests/web.scm @@ -28,15 +28,27 @@ #:use-module (gnu system vm) #:use-module (gnu services) #:use-module (gnu services web) + #:use-module (gnu services databases) #:use-module (gnu services networking) + #:use-module (gnu services shepherd) + #:use-module (gnu packages databases) + #:use-module (gnu packages patchutils) + #:use-module (gnu packages python) + #:use-module (gnu packages web) + #:use-module (guix packages) + #:use-module (guix modules) + #:use-module (guix records) #:use-module (guix gexp) #:use-module (guix store) + #:use-module (guix utils) + #:use-module (ice-9 match) #:export (%test-httpd %test-nginx %test-varnish %test-php-fpm %test-hpcguix-web - %test-tailon)) + %test-tailon + %test-patchwork)) (define %index.html-contents ;; Contents of the /index.html file. @@ -498,3 +510,93 @@ HTTP-PORT." (name "tailon") (description "Connect to a running Tailon server.") (value (run-tailon-test)))) + + +;;; +;;; Patchwork +;;; + +(define %patchwork-os + (simple-operating-system + (service dhcp-client-service-type) + (service httpd-service-type + (httpd-configuration + (config + (httpd-config-file + (listen '("8080")))))) + (service postgresql-service-type) + (service patchwork-service-type + (patchwork-configuration + (settings-module + (patchwork-settings-module + (secret-key "00000") + (allowed-hosts '("*")) + (default-from-email "") + (debug? #t))) + (domain "localhost"))))) + +(define* (run-patchwork-test) + "Run tests in %NGINX-OS, which has nginx running and listening on +HTTP-PORT." + (define os + (marionette-operating-system + %patchwork-os + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define forwarded-port 8080) + + (define vm + (virtual-machine + (operating-system os) + (port-forwardings `((8080 . ,forwarded-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 "patchwork") + + (test-assert "httpd service running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (match (start-service 'httpd) + (#f #f) + (('service response-parts ...) + (match (assq-ref response-parts 'running) + ((#t) #t) + ((pid) (number? pid)))))) + marionette)) + + ;; Retrieve the index.html file we put in /srv. + (test-equal "http-get" + 200 + (let-values + (((response text) + (http-get #$(simple-format + #f "http://localhost:~A/" forwarded-port) + #:decode-body? #t))) + (response-code response))) + + (test-end) + (exit (= (test-runner-fail-count (test-runner-current)) 0))))) + + (gexp->derivation "patchwork-test" test)) + +(define %test-patchwork + (system-test + (name "patchwork") + (description "") + (value (run-patchwork-test)))) |