[jackhill/guix/guix.git] / gnu / tests / web.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu tests web)
  #:use-module (gnu tests)
  #:use-module (gnu system)
  #:use-module (gnu system file-systems)
  #:use-module (gnu system shadow)
  #:use-module (gnu system vm)
  #:use-module (gnu services)
  #:use-module (gnu services web)
  #:use-module (gnu services networking)
  #:use-module (guix gexp)
  #:use-module (guix store)
  #:export (%test-httpd
            %test-nginx
            %test-php-fpm
            %test-hpcguix-web))

(define %index.html-contents
  ;; Contents of the /index.html file.
  "Hello, guix!")

(define %make-http-root
  ;; Create our server root in /srv.
  #~(begin
      (mkdir "/srv")
      (mkdir "/srv/http")
      (call-with-output-file "/srv/http/index.html"
        (lambda (port)
          (display #$%index.html-contents port)))))

(define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080))
  "Run tests in %NGINX-OS, which has nginx running and listening on
HTTP-PORT."
  (define os
    (marionette-operating-system
     test-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define forwarded-port 8080)

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings `((,http-port . ,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 #$name)

          (test-assert #$(string-append name " service running")
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (match (start-service '#$(string->symbol name))
                  (#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 #$%index.html-contents)
            (let-values
                (((response text)
                  (http-get #$(simple-format
                               #f "http://localhost:~A/index.html" forwarded-port)
                            #:decode-body? #t)))
              (list (response-code response) text)))

          #$@(if log-file
                 `((test-assert ,(string-append "log file exists " log-file)
                     (marionette-eval
                      '(file-exists? ,log-file)
                      marionette)))
                 '())

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation (string-append name "-test") test))

\f
;;;
;;; HTTPD
;;;

(define %httpd-os
  (simple-operating-system
   (dhcp-client-service)
   (service httpd-service-type
            (httpd-configuration
             (config
              (httpd-config-file
               (listen '("8080"))))))
   (simple-service 'make-http-root activation-service-type
                   %make-http-root)))

(define %test-httpd
  (system-test
   (name "httpd")
   (description "Connect to a running HTTPD server.")
   (value (run-webserver-test name %httpd-os
                              #:log-file "/var/log/httpd/error_log"))))

\f
;;;
;;; NGINX
;;;

(define %nginx-servers
  ;; Server blocks.
  (list (nginx-server-configuration
         (listen '("8080")))))

(define %nginx-os
  ;; Operating system under test.
  (simple-operating-system
   (dhcp-client-service)
   (service nginx-service-type
            (nginx-configuration
             (log-directory "/var/log/nginx")
             (server-blocks %nginx-servers)))
   (simple-service 'make-http-root activation-service-type
                   %make-http-root)))

(define %test-nginx
  (system-test
   (name "nginx")
   (description "Connect to a running NGINX server.")
   (value (run-webserver-test name %nginx-os
                              #:log-file "/var/log/nginx/access.log"))))

\f
;;;
;;; PHP-FPM
;;;

(define %make-php-fpm-http-root
  ;; Create our server root in /srv.
  #~(begin
      (mkdir "/srv")
      (call-with-output-file "/srv/index.php"
        (lambda (port)
          (display "<?php
phpinfo();
echo(\"Computed by php:\".((string)(2+3)));
?>\n" port)))))

(define %php-fpm-nginx-server-blocks
  (list (nginx-server-configuration
         (root "/srv")
         (locations
          (list (nginx-php-location)))
         (listen '("8042"))
         (ssl-certificate #f)
         (ssl-certificate-key #f))))

(define %php-fpm-os
  ;; Operating system under test.
  (simple-operating-system
   (dhcp-client-service)
   (service php-fpm-service-type)
   (service nginx-service-type
            (nginx-configuration
             (server-blocks %php-fpm-nginx-server-blocks)))
   (simple-service 'make-http-root activation-service-type
                   %make-php-fpm-http-root)))

(define* (run-php-fpm-test #:optional (http-port 8042))
  "Run tests in %PHP-FPM-OS, which has nginx running and listening on
HTTP-PORT, along with php-fpm."
  (define os
    (marionette-operating-system
     %php-fpm-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)
                             (guix build utils))
      #~(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 "php-fpm")

          (test-assert "php-fpm running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (match (start-service 'php-fpm)
                  (#f #f)
                  (('service response-parts ...)
                   (match (assq-ref response-parts 'running)
                     ((pid) (number? pid))))))
             marionette))

          (test-assert "nginx running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (start-service 'nginx))
             marionette))

          (test-equal "http-get"
            200
            (let-values (((response text)
                          (http-get "http://localhost:8080/index.php"
                                    #:decode-body? #t)))
              (response-code response)))

          (test-equal "php computed result is sent"
            "Computed by php:5"
            (let-values (((response text)
                          (http-get "http://localhost:8080/index.php"
                                    #:decode-body? #t)))
              (begin
                (use-modules (ice-9 regex))
                (let ((matches (string-match "Computed by php:5" text)))
                  (and matches
                       (match:substring matches 0))))))

          (test-end)

          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation "php-fpm-test" test))

(define %test-php-fpm
  (system-test
   (name "php-fpm")
   (description "Test PHP-FPM through nginx.")
   (value (run-php-fpm-test))))

\f
;;;
;;; hpcguix-web
;;;

(define* (run-hpcguix-web-server-test name test-os)
  "Run tests in %HPCGUIX-WEB-OS, which has hpcguix-web running."
  (define os
    (marionette-operating-system
     test-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define vm
    (virtual-machine
     (operating-system os)
     (port-forwardings '((8080 . 5000)))))

  (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 #$name)

          (test-assert "hpcguix-web running"
            (marionette-eval
             '(begin
                (use-modules (gnu services herd))
                (match (start-service 'hpcguix-web)
                  (#f #f)
                  (('service response-parts ...)
                   (match (assq-ref response-parts 'running)
                     ((pid) (number? pid))))))
             marionette))

          (test-equal "http-get"
            200
            (begin
              (wait-for-tcp-port 5000 marionette)
              (let-values (((response text)
                            (http-get "http://localhost:8080")))
                (response-code response))))

          (test-end)
          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))

  (gexp->derivation (string-append name "-test") test))

(define %hpcguix-web-specs
  ;; Server config gexp.
  #~(define site-config
      (hpcweb-configuration
       (title-prefix "[TEST] HPCGUIX-WEB"))))

(define %hpcguix-web-os
  (simple-operating-system
   (dhcp-client-service)
   (service hpcguix-web-service-type
            (hpcguix-web-configuration
             (specs %hpcguix-web-specs)))))

(define %test-hpcguix-web
  (system-test
   (name "hpcguix-web")
   (description "Connect to a running hpcguix-web server.")
   (value (run-hpcguix-web-server-test name %hpcguix-web-os))))
Commit	Line	Data
11f3885b LC	1	;;; GNU Guix --- Functional package management for GNU
11f3885b LC	2	;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
64bae723	3	;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
c24b1547	4	;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
93b83eb3	5	;;; Copyright © 2018 Pierre-Antoine Rouby <pierre-antoine.rouby@inria.fr>
11f3885b LC	6	;;;
	7	;;; This file is part of GNU Guix.
	8	;;;
	9	;;; GNU Guix is free software; you can redistribute it and/or modify it
	10	;;; under the terms of the GNU General Public License as published by
	11	;;; the Free Software Foundation; either version 3 of the License, or (at
	12	;;; your option) any later version.
	13	;;;
	14	;;; GNU Guix is distributed in the hope that it will be useful, but
	15	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	16	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	17	;;; GNU General Public License for more details.
	18	;;;
	19	;;; You should have received a copy of the GNU General Public License
	20	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	21
	22	(define-module (gnu tests web)
	23	#:use-module (gnu tests)
	24	#:use-module (gnu system)
11f3885b LC	25	#:use-module (gnu system file-systems)
	26	#:use-module (gnu system shadow)
	27	#:use-module (gnu system vm)
	28	#:use-module (gnu services)
11f3885b LC	29	#:use-module (gnu services web)
	30	#:use-module (gnu services networking)
	31	#:use-module (guix gexp)
	32	#:use-module (guix store)
d067e4ba CB	33	#:export (%test-httpd
d067e4ba CB	34	%test-nginx
93b83eb3 PAR	35	%test-php-fpm
93b83eb3 PAR	36	%test-hpcguix-web))
11f3885b LC	37
11f3885b LC	38	(define %index.html-contents
d9b53081 CB	39	;; Contents of the /index.html file.
d9b53081 CB	40	"Hello, guix!")
11f3885b LC	41
	42	(define %make-http-root
	43	;; Create our server root in /srv.
	44	#~(begin
	45	(mkdir "/srv")
d9b53081 CB	46	(mkdir "/srv/http")
d9b53081 CB	47	(call-with-output-file "/srv/http/index.html"
11f3885b LC	48	(lambda (port)
	49	(display #$%index.html-contents port)))))
	50
d9b53081	51	(define* (run-webserver-test name test-os #:key (log-file #f) (http-port 8080))
11f3885b LC	52	"Run tests in %NGINX-OS, which has nginx running and listening on
11f3885b LC	53	HTTP-PORT."
8b113790 LC	54	(define os
8b113790 LC	55	(marionette-operating-system
d9b53081	56	test-os
8b113790 LC	57	#:imported-modules '((gnu services herd)
	58	(guix combinators))))
	59
d9b53081 CB	60	(define forwarded-port 8080)
d9b53081 CB	61
8b113790 LC	62	(define vm
	63	(virtual-machine
	64	(operating-system os)
d9b53081	65	(port-forwardings `((,http-port . ,forwarded-port)))))
8b113790 LC	66
	67	(define test
	68	(with-imported-modules '((gnu build marionette))
	69	#~(begin
	70	(use-modules (srfi srfi-11) (srfi srfi-64)
	71	(gnu build marionette)
	72	(web uri)
	73	(web client)
	74	(web response))
	75
	76	(define marionette
	77	(make-marionette (list #$vm)))
	78
	79	(mkdir #$output)
	80	(chdir #$output)
	81
d9b53081	82	(test-begin #$name)
8b113790	83
d9b53081	84	(test-assert #$(string-append name " service running")
8b113790 LC	85	(marionette-eval
	86	'(begin
	87	(use-modules (gnu services herd))
d9b53081 CB	88	(match (start-service '#$(string->symbol name))
	89	(#f #f)
	90	(('service response-parts ...)
	91	(match (assq-ref response-parts 'running)
	92	((#t) #t)
	93	((pid) (number? pid))))))
8b113790 LC	94	marionette))
	95
	96	;; Retrieve the index.html file we put in /srv.
	97	(test-equal "http-get"
	98	'(200 #$%index.html-contents)
d9b53081 CB	99	(let-values
	100	(((response text)
	101	(http-get #$(simple-format
	102	#f "http://localhost:~A/index.html" forwarded-port)
	103	#:decode-body? #t)))
8b113790 LC	104	(list (response-code response) text)))
8b113790 LC	105
d9b53081 CB	106	#$@(if log-file
	107	`((test-assert ,(string-append "log file exists " log-file)
	108	(marionette-eval
	109	'(file-exists? ,log-file)
	110	marionette)))
	111	'())
8b113790 LC	112
	113	(test-end)
	114	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
	115
d9b53081 CB	116	(gexp->derivation (string-append name "-test") test))
	117
	118	\f
d067e4ba CB	119	;;;
	120	;;; HTTPD
	121	;;;
	122
	123	(define %httpd-os
	124	(simple-operating-system
	125	(dhcp-client-service)
	126	(service httpd-service-type
	127	(httpd-configuration
	128	(config
	129	(httpd-config-file
	130	(listen '("8080"))))))
	131	(simple-service 'make-http-root activation-service-type
	132	%make-http-root)))
	133
	134	(define %test-httpd
	135	(system-test
	136	(name "httpd")
	137	(description "Connect to a running HTTPD server.")
	138	(value (run-webserver-test name %httpd-os
	139	#:log-file "/var/log/httpd/error_log"))))
	140
	141	\f
d9b53081 CB	142	;;;
	143	;;; NGINX
	144	;;;
	145
	146	(define %nginx-servers
	147	;; Server blocks.
	148	(list (nginx-server-configuration
	149	(listen '("8080")))))
	150
	151	(define %nginx-os
	152	;; Operating system under test.
	153	(simple-operating-system
	154	(dhcp-client-service)
	155	(service nginx-service-type
	156	(nginx-configuration
	157	(log-directory "/var/log/nginx")
	158	(server-blocks %nginx-servers)))
	159	(simple-service 'make-http-root activation-service-type
	160	%make-http-root)))
11f3885b LC	161
	162	(define %test-nginx
	163	(system-test
	164	(name "nginx")
	165	(description "Connect to a running NGINX server.")
d9b53081 CB	166	(value (run-webserver-test name %nginx-os
d9b53081 CB	167	#:log-file "/var/log/nginx/access.log"))))
64bae723	168
	169	\f
	170	;;;
	171	;;; PHP-FPM
	172	;;;
	173
	174	(define %make-php-fpm-http-root
	175	;; Create our server root in /srv.
	176	#~(begin
	177	(mkdir "/srv")
	178	(call-with-output-file "/srv/index.php"
	179	(lambda (port)
	180	(display "<?php
	181	phpinfo();
	182	echo(\"Computed by php:\".((string)(2+3)));
	183	?>\n" port)))))
	184
	185	(define %php-fpm-nginx-server-blocks
	186	(list (nginx-server-configuration
	187	(root "/srv")
	188	(locations
	189	(list (nginx-php-location)))
a1ac7bf3	190	(listen '("8042"))
64bae723	191	(ssl-certificate #f)
	192	(ssl-certificate-key #f))))
	193
	194	(define %php-fpm-os
	195	;; Operating system under test.
	196	(simple-operating-system
	197	(dhcp-client-service)
	198	(service php-fpm-service-type)
	199	(service nginx-service-type
	200	(nginx-configuration
	201	(server-blocks %php-fpm-nginx-server-blocks)))
	202	(simple-service 'make-http-root activation-service-type
	203	%make-php-fpm-http-root)))
	204
	205	(define* (run-php-fpm-test #:optional (http-port 8042))
	206	"Run tests in %PHP-FPM-OS, which has nginx running and listening on
	207	HTTP-PORT, along with php-fpm."
	208	(define os
	209	(marionette-operating-system
	210	%php-fpm-os
	211	#:imported-modules '((gnu services herd)
	212	(guix combinators))))
	213
	214	(define vm
	215	(virtual-machine
	216	(operating-system os)
	217	(port-forwardings `((8080 . ,http-port)))))
	218
	219	(define test
	220	(with-imported-modules '((gnu build marionette)
	221	(guix build utils))
	222	#~(begin
	223	(use-modules (srfi srfi-11) (srfi srfi-64)
	224	(gnu build marionette)
	225	(web uri)
	226	(web client)
	227	(web response))
	228
	229	(define marionette
	230	(make-marionette (list #$vm)))
	231
	232	(mkdir #$output)
	233	(chdir #$output)
	234
	235	(test-begin "php-fpm")
	236
	237	(test-assert "php-fpm running"
	238	(marionette-eval
	239	'(begin
	240	(use-modules (gnu services herd))
	241	(match (start-service 'php-fpm)
	242	(#f #f)
	243	(('service response-parts ...)
	244	(match (assq-ref response-parts 'running)
	245	((pid) (number? pid))))))
	246	marionette))
	247
c24b1547	248	(test-assert "nginx running"
64bae723	249	(marionette-eval
	250	'(begin
	251	(use-modules (gnu services herd))
c24b1547	252	(start-service 'nginx))
64bae723	253	marionette))
	254
	255	(test-equal "http-get"
	256	200
	257	(let-values (((response text)
	258	(http-get "http://localhost:8080/index.php"
	259	#:decode-body? #t)))
	260	(response-code response)))
	261
	262	(test-equal "php computed result is sent"
	263	"Computed by php:5"
	264	(let-values (((response text)
	265	(http-get "http://localhost:8080/index.php"
	266	#:decode-body? #t)))
	267	(begin
	268	(use-modules (ice-9 regex))
	269	(let ((matches (string-match "Computed by php:5" text)))
	270	(and matches
	271	(match:substring matches 0))))))
	272
	273	(test-end)
	274
	275	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
	276
	277	(gexp->derivation "php-fpm-test" test))
	278
	279	(define %test-php-fpm
	280	(system-test
	281	(name "php-fpm")
	282	(description "Test PHP-FPM through nginx.")
	283	(value (run-php-fpm-test))))
93b83eb3 PAR	284
	285	\f
	286	;;;
	287	;;; hpcguix-web
	288	;;;
	289
	290	(define* (run-hpcguix-web-server-test name test-os)
	291	"Run tests in %HPCGUIX-WEB-OS, which has hpcguix-web running."
	292	(define os
	293	(marionette-operating-system
	294	test-os
	295	#:imported-modules '((gnu services herd)
	296	(guix combinators))))
	297
	298	(define vm
	299	(virtual-machine
	300	(operating-system os)
	301	(port-forwardings '((8080 . 5000)))))
	302
	303	(define test
	304	(with-imported-modules '((gnu build marionette))
	305	#~(begin
	306	(use-modules (srfi srfi-11) (srfi srfi-64)
	307	(gnu build marionette)
	308	(web uri)
	309	(web client)
	310	(web response))
	311
	312	(define marionette
	313	(make-marionette (list #$vm)))
	314
	315	(mkdir #$output)
	316	(chdir #$output)
	317
	318	(test-begin #$name)
	319
	320	(test-assert "hpcguix-web running"
	321	(marionette-eval
	322	'(begin
	323	(use-modules (gnu services herd))
	324	(match (start-service 'hpcguix-web)
	325	(#f #f)
	326	(('service response-parts ...)
	327	(match (assq-ref response-parts 'running)
	328	((pid) (number? pid))))))
	329	marionette))
	330
	331	(test-equal "http-get"
	332	200
	333	(begin
	334	(wait-for-tcp-port 5000 marionette)
	335	(let-values (((response text)
	336	(http-get "http://localhost:8080")))
	337	(response-code response))))
	338
	339	(test-end)
	340	(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
	341
	342	(gexp->derivation (string-append name "-test") test))
	343
	344	(define %hpcguix-web-specs
	345	;; Server config gexp.
	346	#~(define site-config
	347	(hpcweb-configuration
348	(title-prefix "[TEST] HPCGUIX-WEB"))))
349
350	(define %hpcguix-web-os
351	(simple-operating-system
352	(dhcp-client-service)
353	(service hpcguix-web-service-type
354	(hpcguix-web-configuration
355	(specs %hpcguix-web-specs)))))
356
357	(define %test-hpcguix-web
358	(system-test
359	(name "hpcguix-web")
360	(description "Connect to a running hpcguix-web server.")
361	(value (run-hpcguix-web-server-test name %hpcguix-web-os))))