1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2019, 2020, 2021, 2022 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
43 ;;; Guix Build Coordinator
46 (define %guix-build-coordinator-os
47 (simple-operating-system
48 (service dhcp-client-service-type)
49 (service guix-build-coordinator-service-type)))
51 (define (run-guix-build-coordinator-test)
53 (marionette-operating-system
54 %guix-build-coordinator-os
55 #:imported-modules '((gnu services herd)
58 (define forwarded-port 8745)
64 (port-forwardings `((,forwarded-port . 8745)))))
67 (with-imported-modules '((gnu build marionette))
69 (use-modules (srfi srfi-11) (srfi srfi-64)
70 (gnu build marionette)
76 (make-marionette (list #$vm)))
78 (test-runner-current (system-test-runner #$output))
79 (test-begin "guix-build-coordinator")
81 (test-assert "service running"
84 (use-modules (gnu services herd))
85 (match (start-service 'guix-build-coordinator)
87 (('service response-parts ...)
88 (match (assq-ref response-parts 'running)
89 ((pid) (number? pid))))))
92 (test-equal "http-get"
96 (http-get #$(simple-format
97 #f "http://localhost:~A/metrics" forwarded-port)
99 (response-code response)))
103 (gexp->derivation "guix-build-coordinator-test" test))
105 (define %test-guix-build-coordinator
107 (name "guix-build-coordinator")
108 (description "Connect to a running Guix Build Coordinator.")
109 (value (run-guix-build-coordinator-test))))
113 ;;; Guix Data Service
116 (define guix-data-service-initial-database-setup-service
117 (let ((user "guix_data_service")
118 (name "guix_data_service"))
121 (let ((pid (primitive-fork))
122 (postgres (getpwnam "postgres")))
127 (setgid (passwd:gid postgres))
128 (setuid (passwd:uid postgres))
132 (system* #$(file-append postgresql "/bin/createuser")
135 (system* #$(file-append postgresql "/bin/createdb")
136 "-O" #$user #$name)))
141 (zero? (cdr (waitpid pid)))))))
144 (requirement '(postgres))
145 (provision '(guix-data-service-initial-database-setup))
150 (documentation "Setup Guix Data Service database."))))
152 (define %guix-data-service-os
153 (simple-operating-system
154 (service dhcp-client-service-type)
155 (service postgresql-service-type
156 (postgresql-configuration
157 (postgresql postgresql-10)
159 (postgresql-config-file
161 (plain-file "pg_hba.conf"
164 host all all 127.0.0.1/32 trust
165 host all all ::1/128 trust"))))))
166 (service guix-data-service-type
167 (guix-data-service-configuration
169 (simple-service 'guix-data-service-database-setup
170 shepherd-root-service-type
171 (list guix-data-service-initial-database-setup-service))))
173 (define (run-guix-data-service-test)
175 (marionette-operating-system
176 %guix-data-service-os
177 #:imported-modules '((gnu services herd)
178 (guix combinators))))
180 (define forwarded-port 8080)
184 (operating-system os)
186 (port-forwardings `((,forwarded-port . 8765)))))
189 (with-imported-modules '((gnu build marionette))
191 (use-modules (srfi srfi-11) (srfi srfi-64)
192 (gnu build marionette)
198 (make-marionette (list #$vm)))
200 (test-runner-current (system-test-runner #$output))
201 (test-begin "guix-data-service")
203 (test-assert "service running"
206 (use-modules (gnu services herd))
207 (match (start-service 'guix-data-service)
209 (('service response-parts ...)
210 (match (assq-ref response-parts 'running)
211 ((pid) (number? pid))))))
214 (test-assert "process jobs service running"
217 (use-modules (gnu services herd))
218 (match (start-service 'guix-data-service-process-jobs)
220 (('service response-parts ...)
221 (match (assq-ref response-parts 'running)
222 ((pid) (number? pid))))))
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)
229 (let-values (((response text)
230 (http-get #$(simple-format
231 #f "http://localhost:~A/healthcheck"
233 (response-code response))))
234 (if (or (= status 200) (<= attempts 1))
237 (try-http-get (- attempts 1))))))
239 (test-equal "http-get"
245 (gexp->derivation "guix-data-service-test" test))
247 (define %test-guix-data-service
249 (name "guix-data-service")
250 (description "Connect to a running Guix Data Service.")
251 (value (run-guix-data-service-test))))
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
264 ;; Not a realistic value, but works for the test
267 (define (run-nar-herder-test)
269 (marionette-operating-system
271 #:imported-modules '((gnu services herd)
272 (guix combinators))))
274 (define forwarded-port
275 (nar-herder-configuration-port
276 (nar-herder-configuration)))
280 (operating-system os)
282 (port-forwardings `((,forwarded-port . ,forwarded-port)))))
285 (with-imported-modules '((gnu build marionette))
287 (use-modules (srfi srfi-11) (srfi srfi-64)
288 (gnu build marionette)
294 (make-marionette (list #$vm)))
296 (test-runner-current (system-test-runner #$output))
297 (test-begin "nar-herder")
299 (test-assert "service running"
302 (use-modules (gnu services herd))
303 (match (start-service 'nar-herder)
305 (('service response-parts ...)
306 (match (assq-ref response-parts 'running)
307 ((pid) (number? pid))))))
310 (test-equal "http-get"
314 (http-get #$(simple-format
315 #f "http://localhost:~A/" forwarded-port)
317 (response-code response)))
321 (gexp->derivation "nar-herder-test" test))
323 (define %test-nar-herder
326 (description "Connect to a running Nar Herder server.")
327 (value (run-nar-herder-test))))