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

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019, 2020, 2021, 2022 Christopher Baines <mail@cbaines.net>
;;;
;;; 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 guix)
  #: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 guix)
  #:use-module (gnu services databases)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services networking)
  #:use-module (gnu packages databases)
  #: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-guix-build-coordinator
            %test-guix-data-service
            %test-nar-herder))

;;;
;;; Guix Build Coordinator
;;;

(define %guix-build-coordinator-os
  (simple-operating-system
   (service dhcp-client-service-type)
   (service guix-build-coordinator-service-type)))

(define (run-guix-build-coordinator-test)
  (define os
    (marionette-operating-system
     %guix-build-coordinator-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define forwarded-port 8745)

  (define vm
    (virtual-machine
     (operating-system os)
     (memory-size 1024)
     (port-forwardings `((,forwarded-port . 8745)))))

  (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)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "guix-build-coordinator")

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

          (test-equal "http-get"
            200
            (let-values
                (((response text)
                  (http-get #$(simple-format
                               #f "http://localhost:~A/metrics" forwarded-port)
                            #:decode-body? #t)))
              (response-code response)))

          (test-end))))

  (gexp->derivation "guix-build-coordinator-test" test))

(define %test-guix-build-coordinator
  (system-test
   (name "guix-build-coordinator")
   (description "Connect to a running Guix Build Coordinator.")
   (value (run-guix-build-coordinator-test))))

\f
;;;
;;; Guix Data Service
;;;

(define guix-data-service-initial-database-setup-service
  (let ((user "guix_data_service")
        (name "guix_data_service"))
    (define start-gexp
      #~(lambda ()
          (let ((pid (primitive-fork))
                (postgres (getpwnam "postgres")))
            (if (eq? pid 0)
                (dynamic-wind
                  (const #t)
                  (lambda ()
                    (setgid (passwd:gid postgres))
                    (setuid (passwd:uid postgres))
                    (primitive-exit
                     (if (and
                          (zero?
                           (system* #$(file-append postgresql "/bin/createuser")
                                    #$user))
                          (zero?
                           (system* #$(file-append postgresql "/bin/createdb")
                                    "-O" #$user #$name)))
                         0
                         1)))
                  (lambda ()
                    (primitive-exit 1)))
                (zero? (cdr (waitpid pid)))))))

    (shepherd-service
     (requirement '(postgres))
     (provision '(guix-data-service-initial-database-setup))
     (start start-gexp)
     (stop #~(const #f))
     (respawn? #f)
     (one-shot? #t)
     (documentation "Setup Guix Data Service database."))))

(define %guix-data-service-os
  (simple-operating-system
   (service dhcp-client-service-type)
   (service postgresql-service-type
            (postgresql-configuration
             (postgresql postgresql-10)
             (config-file
              (postgresql-config-file
               (hba-file
                (plain-file "pg_hba.conf"
                            "
local	all	all			trust
host	all	all	127.0.0.1/32 	trust
host	all	all	::1/128 	trust"))))))
   (service guix-data-service-type
            (guix-data-service-configuration
             (host "0.0.0.0")))
   (simple-service 'guix-data-service-database-setup
                   shepherd-root-service-type
                   (list guix-data-service-initial-database-setup-service))))

(define (run-guix-data-service-test)
  (define os
    (marionette-operating-system
     %guix-data-service-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define forwarded-port 8080)

  (define vm
    (virtual-machine
     (operating-system os)
     (memory-size 1024)
     (port-forwardings `((,forwarded-port . 8765)))))

  (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)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "guix-data-service")

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

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

          ;; The service starts immediately but replies with status 500 until
          ;; initialization is complete, so keep trying for a while.
          (define (try-http-get attempts)
            (let ((status
                   (let-values (((response text)
                                 (http-get #$(simple-format
                                              #f "http://localhost:~A/healthcheck"
                                              forwarded-port))))
                     (response-code response))))
              (if (or (= status 200) (<= attempts 1))
                  status
                  (begin (sleep 5)
                         (try-http-get (- attempts 1))))))

          (test-equal "http-get"
            200
            (try-http-get 12))

          (test-end))))

  (gexp->derivation "guix-data-service-test" test))

(define %test-guix-data-service
  (system-test
   (name "guix-data-service")
   (description "Connect to a running Guix Data Service.")
   (value (run-guix-data-service-test))))

\f
;;;
;;; Nar Herder
;;;

(define %nar-herder-os
  (simple-operating-system
   (service dhcp-client-service-type)
   (service nar-herder-service-type
            (nar-herder-configuration
             (host "0.0.0.0")
             ;; Not a realistic value, but works for the test
             (storage "/tmp")))))

(define (run-nar-herder-test)
  (define os
    (marionette-operating-system
     %nar-herder-os
     #:imported-modules '((gnu services herd)
                          (guix combinators))))

  (define forwarded-port
    (nar-herder-configuration-port
     (nar-herder-configuration)))

  (define vm
    (virtual-machine
     (operating-system os)
     (memory-size 1024)
     (port-forwardings `((,forwarded-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)))

          (test-runner-current (system-test-runner #$output))
          (test-begin "nar-herder")

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

          (test-equal "http-get"
            404
            (let-values
                (((response text)
                  (http-get #$(simple-format
                               #f "http://localhost:~A/" forwarded-port)
                            #:decode-body? #t)))
              (response-code response)))

          (test-end))))

  (gexp->derivation "nar-herder-test" test))

(define %test-nar-herder
  (system-test
   (name "nar-herder")
   (description "Connect to a running Nar Herder server.")
   (value (run-nar-herder-test))))
Commit	Line	Data
dd2a8327	1	;;; GNU Guix --- Functional package management for GNU
087cdafc	2	;;; Copyright © 2019, 2020, 2021, 2022 Christopher Baines <mail@cbaines.net>
dd2a8327 CB	3	;;;
	4	;;; This file is part of GNU Guix.
	5	;;;
	6	;;; GNU Guix is free software; you can redistribute it and/or modify it
	7	;;; under the terms of the GNU General Public License as published by
	8	;;; the Free Software Foundation; either version 3 of the License, or (at
	9	;;; your option) any later version.
	10	;;;
	11	;;; GNU Guix is distributed in the hope that it will be useful, but
	12	;;; WITHOUT ANY WARRANTY; without even the implied warranty of
	13	;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	14	;;; GNU General Public License for more details.
	15	;;;
	16	;;; You should have received a copy of the GNU General Public License
	17	;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
	18
	19	(define-module (gnu tests guix)
	20	#:use-module (gnu tests)
	21	#:use-module (gnu system)
	22	#:use-module (gnu system file-systems)
	23	#:use-module (gnu system shadow)
	24	#:use-module (gnu system vm)
	25	#:use-module (gnu services)
	26	#:use-module (gnu services guix)
	27	#:use-module (gnu services databases)
	28	#:use-module (gnu services shepherd)
	29	#:use-module (gnu services networking)
	30	#:use-module (gnu packages databases)
	31	#:use-module (guix packages)
	32	#:use-module (guix modules)
	33	#:use-module (guix records)
	34	#:use-module (guix gexp)
	35	#:use-module (guix store)
	36	#:use-module (guix utils)
	37	#:use-module (ice-9 match)
15955e9b	38	#:export (%test-guix-build-coordinator
087cdafc CB	39	%test-guix-data-service
087cdafc CB	40	%test-nar-herder))
15955e9b CB	41
	42	;;;
	43	;;; Guix Build Coordinator
	44	;;;
	45
	46	(define %guix-build-coordinator-os
	47	(simple-operating-system
	48	(service dhcp-client-service-type)
	49	(service guix-build-coordinator-service-type)))
	50
	51	(define (run-guix-build-coordinator-test)
	52	(define os
	53	(marionette-operating-system
	54	%guix-build-coordinator-os
	55	#:imported-modules '((gnu services herd)
	56	(guix combinators))))
	57
	58	(define forwarded-port 8745)
	59
	60	(define vm
	61	(virtual-machine
	62	(operating-system os)
	63	(memory-size 1024)
	64	(port-forwardings `((,forwarded-port . 8745)))))
	65
	66	(define test
	67	(with-imported-modules '((gnu build marionette))
	68	#~(begin
	69	(use-modules (srfi srfi-11) (srfi srfi-64)
	70	(gnu build marionette)
	71	(web uri)
	72	(web client)
	73	(web response))
	74
	75	(define marionette
	76	(make-marionette (list #$vm)))
	77
89b05442	78	(test-runner-current (system-test-runner #$output))
15955e9b CB	79	(test-begin "guix-build-coordinator")
	80
	81	(test-assert "service running"
	82	(marionette-eval
	83	'(begin
	84	(use-modules (gnu services herd))
	85	(match (start-service 'guix-build-coordinator)
	86	(#f #f)
	87	(('service response-parts ...)
	88	(match (assq-ref response-parts 'running)
	89	((pid) (number? pid))))))
	90	marionette))
	91
	92	(test-equal "http-get"
	93	200
	94	(let-values
	95	(((response text)
	96	(http-get #$(simple-format
	97	#f "http://localhost:~A/metrics" forwarded-port)
	98	#:decode-body? #t)))
	99	(response-code response)))
	100
1fb75128	101	(test-end))))
15955e9b CB	102
	103	(gexp->derivation "guix-build-coordinator-test" test))
	104
	105	(define %test-guix-build-coordinator
	106	(system-test
	107	(name "guix-build-coordinator")
	108	(description "Connect to a running Guix Build Coordinator.")
	109	(value (run-guix-build-coordinator-test))))
dd2a8327 CB	110
	111	\f
	112	;;;
	113	;;; Guix Data Service
	114	;;;
	115
	116	(define guix-data-service-initial-database-setup-service
	117	(let ((user "guix_data_service")
	118	(name "guix_data_service"))
	119	(define start-gexp
	120	#~(lambda ()
	121	(let ((pid (primitive-fork))
	122	(postgres (getpwnam "postgres")))
	123	(if (eq? pid 0)
	124	(dynamic-wind
	125	(const #t)
	126	(lambda ()
	127	(setgid (passwd:gid postgres))
	128	(setuid (passwd:uid postgres))
	129	(primitive-exit
	130	(if (and
	131	(zero?
	132	(system* #$(file-append postgresql "/bin/createuser")
	133	#$user))
	134	(zero?
	135	(system* #$(file-append postgresql "/bin/createdb")
	136	"-O" #$user #$name)))
	137	0
	138	1)))
	139	(lambda ()
	140	(primitive-exit 1)))
	141	(zero? (cdr (waitpid pid)))))))
	142
	143	(shepherd-service
	144	(requirement '(postgres))
	145	(provision '(guix-data-service-initial-database-setup))
	146	(start start-gexp)
	147	(stop #~(const #f))
	148	(respawn? #f)
	149	(one-shot? #t)
	150	(documentation "Setup Guix Data Service database."))))
	151
	152	(define %guix-data-service-os
	153	(simple-operating-system
	154	(service dhcp-client-service-type)
	155	(service postgresql-service-type
	156	(postgresql-configuration
bdcf4d88	157	(postgresql postgresql-10)
dd2a8327 CB	158	(config-file
	159	(postgresql-config-file
	160	(hba-file
	161	(plain-file "pg_hba.conf"
	162	"
	163	local all all trust
	164	host all all 127.0.0.1/32 trust
c311147b	165	host all all ::1/128 trust"))))))
dd2a8327 CB	166	(service guix-data-service-type
	167	(guix-data-service-configuration
	168	(host "0.0.0.0")))
	169	(simple-service 'guix-data-service-database-setup
	170	shepherd-root-service-type
	171	(list guix-data-service-initial-database-setup-service))))
	172
	173	(define (run-guix-data-service-test)
	174	(define os
	175	(marionette-operating-system
	176	%guix-data-service-os
	177	#:imported-modules '((gnu services herd)
	178	(guix combinators))))
	179
	180	(define forwarded-port 8080)
	181
	182	(define vm
	183	(virtual-machine
	184	(operating-system os)
	185	(memory-size 1024)
	186	(port-forwardings `((,forwarded-port . 8765)))))
	187
	188	(define test
	189	(with-imported-modules '((gnu build marionette))
	190	#~(begin
	191	(use-modules (srfi srfi-11) (srfi srfi-64)
	192	(gnu build marionette)
	193	(web uri)
	194	(web client)
	195	(web response))
	196
	197	(define marionette
	198	(make-marionette (list #$vm)))
	199
89b05442	200	(test-runner-current (system-test-runner #$output))
dd2a8327 CB	201	(test-begin "guix-data-service")
	202
	203	(test-assert "service running"
	204	(marionette-eval
	205	'(begin
	206	(use-modules (gnu services herd))
	207	(match (start-service 'guix-data-service)
	208	(#f #f)
	209	(('service response-parts ...)
	210	(match (assq-ref response-parts 'running)
	211	((pid) (number? pid))))))
	212	marionette))
	213
	214	(test-assert "process jobs service running"
	215	(marionette-eval
	216	'(begin
	217	(use-modules (gnu services herd))
	218	(match (start-service 'guix-data-service-process-jobs)
	219	(#f #f)
	220	(('service response-parts ...)
	221	(match (assq-ref response-parts 'running)
	222	((pid) (number? pid))))))
	223	marionette))
	224
6a2a8ca1 TL	225	;; The service starts immediately but replies with status 500 until
	226	;; initialization is complete, so keep trying for a while.
	227	(define (try-http-get attempts)
	228	(let ((status
	229	(let-values (((response text)
	230	(http-get #$(simple-format
	231	#f "http://localhost:~A/healthcheck"
	232	forwarded-port))))
	233	(response-code response))))
	234	(if (or (= status 200) (<= attempts 1))
	235	status
	236	(begin (sleep 5)
	237	(try-http-get (- attempts 1))))))
	238
dd2a8327 CB	239	(test-equal "http-get"
dd2a8327 CB	240	200
6a2a8ca1	241	(try-http-get 12))
dd2a8327	242
1fb75128	243	(test-end))))
dd2a8327 CB	244
	245	(gexp->derivation "guix-data-service-test" test))
	246
	247	(define %test-guix-data-service
	248	(system-test
	249	(name "guix-data-service")
	250	(description "Connect to a running Guix Data Service.")
	251	(value (run-guix-data-service-test))))
087cdafc CB	252
	253	\f
	254	;;;
	255	;;; Nar Herder
	256	;;;
	257
	258	(define %nar-herder-os
	259	(simple-operating-system
	260	(service dhcp-client-service-type)
	261	(service nar-herder-service-type
	262	(nar-herder-configuration
	263	(host "0.0.0.0")
	264	;; Not a realistic value, but works for the test
	265	(storage "/tmp")))))
	266
	267	(define (run-nar-herder-test)
	268	(define os
	269	(marionette-operating-system
	270	%nar-herder-os
	271	#:imported-modules '((gnu services herd)
	272	(guix combinators))))
	273
	274	(define forwarded-port
	275	(nar-herder-configuration-port
	276	(nar-herder-configuration)))
	277
	278	(define vm
	279	(virtual-machine
	280	(operating-system os)
	281	(memory-size 1024)
	282	(port-forwardings `((,forwarded-port . ,forwarded-port)))))
	283
	284	(define test
	285	(with-imported-modules '((gnu build marionette))
	286	#~(begin
	287	(use-modules (srfi srfi-11) (srfi srfi-64)
	288	(gnu build marionette)
	289	(web uri)
	290	(web client)
	291	(web response))
	292
	293	(define marionette
	294	(make-marionette (list #$vm)))
	295
	296	(test-runner-current (system-test-runner #$output))
	297	(test-begin "nar-herder")
	298
	299	(test-assert "service running"
	300	(marionette-eval
	301	'(begin
	302	(use-modules (gnu services herd))
	303	(match (start-service 'nar-herder)
	304	(#f #f)
	305	(('service response-parts ...)
	306	(match (assq-ref response-parts 'running)
	307	((pid) (number? pid))))))
	308	marionette))
	309
	310	(test-equal "http-get"
	311	404
	312	(let-values
	313	(((response text)
	314	(http-get #$(simple-format
	315	#f "http://localhost:~A/" forwarded-port)
316	#:decode-body? #t)))
317	(response-code response)))
318
319	(test-end))))
320
321	(gexp->derivation "nar-herder-test" test))
322
323	(define %test-nar-herder
324	(system-test
325	(name "nar-herder")
326	(description "Connect to a running Nar Herder server.")
327	(value (run-nar-herder-test))))