1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
4 ;;; This file is part of GNU Guix.
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.
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.
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/>.
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)
38 #:export (%test-guix-build-coordinator
39 %test-guix-data-service))
42 ;;; Guix Build Coordinator
45 (define %guix-build-coordinator-os
46 (simple-operating-system
47 (service dhcp-client-service-type)
48 (service guix-build-coordinator-service-type)))
50 (define (run-guix-build-coordinator-test)
52 (marionette-operating-system
53 %guix-build-coordinator-os
54 #:imported-modules '((gnu services herd)
57 (define forwarded-port 8745)
63 (port-forwardings `((,forwarded-port . 8745)))))
66 (with-imported-modules '((gnu build marionette))
68 (use-modules (srfi srfi-11) (srfi srfi-64)
69 (gnu build marionette)
75 (make-marionette (list #$vm)))
80 (test-begin "guix-build-coordinator")
82 (test-assert "service running"
85 (use-modules (gnu services herd))
86 (match (start-service 'guix-build-coordinator)
88 (('service response-parts ...)
89 (match (assq-ref response-parts 'running)
90 ((pid) (number? pid))))))
93 (test-equal "http-get"
97 (http-get #$(simple-format
98 #f "http://localhost:~A/metrics" forwarded-port)
100 (response-code response)))
103 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
105 (gexp->derivation "guix-build-coordinator-test" test))
107 (define %test-guix-build-coordinator
109 (name "guix-build-coordinator")
110 (description "Connect to a running Guix Build Coordinator.")
111 (value (run-guix-build-coordinator-test))))
115 ;;; Guix Data Service
118 (define guix-data-service-initial-database-setup-service
119 (let ((user "guix_data_service")
120 (name "guix_data_service"))
123 (let ((pid (primitive-fork))
124 (postgres (getpwnam "postgres")))
129 (setgid (passwd:gid postgres))
130 (setuid (passwd:uid postgres))
134 (system* #$(file-append postgresql "/bin/createuser")
137 (system* #$(file-append postgresql "/bin/createdb")
138 "-O" #$user #$name)))
143 (zero? (cdr (waitpid pid)))))))
146 (requirement '(postgres))
147 (provision '(guix-data-service-initial-database-setup))
152 (documentation "Setup Guix Data Service database."))))
154 (define %guix-data-service-os
155 (simple-operating-system
156 (service dhcp-client-service-type)
157 (service postgresql-service-type
158 (postgresql-configuration
159 (postgresql postgresql-10)
161 (postgresql-config-file
163 (plain-file "pg_hba.conf"
166 host all all 127.0.0.1/32 trust
167 host all all ::1/128 trust"))
168 ;; XXX: Remove when postgresql default socket directory is
169 ;; changed to /var/run/postgresql.
170 (socket-directory #f)))))
171 (service guix-data-service-type
172 (guix-data-service-configuration
174 (simple-service 'guix-data-service-database-setup
175 shepherd-root-service-type
176 (list guix-data-service-initial-database-setup-service))))
178 (define (run-guix-data-service-test)
180 (marionette-operating-system
181 %guix-data-service-os
182 #:imported-modules '((gnu services herd)
183 (guix combinators))))
185 (define forwarded-port 8080)
189 (operating-system os)
191 (port-forwardings `((,forwarded-port . 8765)))))
194 (with-imported-modules '((gnu build marionette))
196 (use-modules (srfi srfi-11) (srfi srfi-64)
197 (gnu build marionette)
203 (make-marionette (list #$vm)))
208 (test-begin "guix-data-service")
210 (test-assert "service running"
213 (use-modules (gnu services herd))
214 (match (start-service 'guix-data-service)
216 (('service response-parts ...)
217 (match (assq-ref response-parts 'running)
218 ((pid) (number? pid))))))
221 (test-assert "process jobs service running"
224 (use-modules (gnu services herd))
225 (match (start-service 'guix-data-service-process-jobs)
227 (('service response-parts ...)
228 (match (assq-ref response-parts 'running)
229 ((pid) (number? pid))))))
232 (test-equal "http-get"
236 (http-get #$(simple-format
237 #f "http://localhost:~A/healthcheck" forwarded-port)
239 (response-code response)))
242 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
244 (gexp->derivation "guix-data-service-test" test))
246 (define %test-guix-data-service
248 (name "guix-data-service")
249 (description "Connect to a running Guix Data Service.")
250 (value (run-guix-data-service-test))))