projects/guix·blob master · refs

496 lines · 15.1 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2019, 2020, 2021, 2022 Christopher Baines <[email protected]>
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 home)
21 #:use-module (gnu home services)
22 #:use-module (gnu tests)
23 #:use-module (gnu system)
24 #:use-module (gnu system file-systems)
25 #:use-module (gnu system shadow)
26 #:use-module (gnu system vm)
27 #:use-module (gnu services)
28 #:use-module (gnu services guix)
29 #:use-module (gnu services databases)
30 #:use-module (gnu services shepherd)
31 #:use-module (gnu services networking)
32 #:use-module (gnu packages databases)
33 #:use-module (guix packages)
34 #:use-module (guix modules)
35 #:use-module (guix records)
36 #:use-module (guix gexp)
37 #:use-module (guix store)
38 #:use-module (guix utils)
39 #:use-module (ice-9 match)
40 #:export (%test-guix-build-coordinator
41 %test-guix-data-service
42 %test-guix-home-service
43 %test-nar-herder
44 %test-bffe))
45
46;;;
47;;; Guix Build Coordinator
48;;;
49
50(define %guix-build-coordinator-os
51 (simple-operating-system
52 (service dhcpcd-service-type)
53 (service guix-build-coordinator-service-type)))
54
55(define (run-guix-build-coordinator-test)
56 (define os
57 (marionette-operating-system
58 %guix-build-coordinator-os
59 #:imported-modules '((gnu services herd)
60 (guix combinators))))
61
62 (define forwarded-port 8745)
63
64 (define vm
65 (virtual-machine
66 (operating-system os)
67 (memory-size 1024)
68 (port-forwardings `((,forwarded-port . 8745)))))
69
70 (define test
71 (with-imported-modules '((gnu build marionette))
72 #~(begin
73 (use-modules (srfi srfi-11) (srfi srfi-64)
74 (gnu build marionette)
75 (web uri)
76 (web client)
77 (web response))
78
79 (define marionette
80 (make-marionette (list #$vm)))
81
82 (test-runner-current (system-test-runner #$output))
83 (test-begin "guix-build-coordinator")
84
85 (test-assert "service running"
86 (marionette-eval
87 '(begin
88 (use-modules (gnu services herd))
89 (match (start-service 'guix-build-coordinator)
90 (#f #f)
91 (('service response-parts ...)
92 (match (assq-ref response-parts 'running)
93 ((pid) pid)))))
94 marionette))
95
96 (test-equal "http-get"
97 200
98 (let-values
99 (((response text)
100 (http-get #$(simple-format
101 #f "http://localhost:~A/metrics" forwarded-port)
102 #:decode-body? #t)))
103 (response-code response)))
104
105 (test-end))))
106
107 (gexp->derivation "guix-build-coordinator-test" test))
108
109(define %test-guix-build-coordinator
110 (system-test
111 (name "guix-build-coordinator")
112 (description "Connect to a running Guix Build Coordinator.")
113 (value (run-guix-build-coordinator-test))))
114
115
116;;;
117;;; Guix Data Service
118;;;
119
120(define guix-data-service-initial-database-setup-service
121 (let ((user "guix_data_service")
122 (name "guix_data_service"))
123 (define start-gexp
124 #~(lambda ()
125 (let ((pid (primitive-fork))
126 (postgres (getpwnam "postgres")))
127 (if (eq? pid 0)
128 (dynamic-wind
129 (const #t)
130 (lambda ()
131 (setgid (passwd:gid postgres))
132 (setuid (passwd:uid postgres))
133 (primitive-exit
134 (if (and
135 (zero?
136 (system* #$(file-append postgresql "/bin/createuser")
137 #$user))
138 (zero?
139 (system* #$(file-append postgresql "/bin/createdb")
140 "-O" #$user #$name)))
141 0
142 1)))
143 (lambda ()
144 (primitive-exit 1)))
145 (zero? (cdr (waitpid pid)))))))
146
147 (shepherd-service
148 (requirement '(postgres))
149 (provision '(guix-data-service-initial-database-setup))
150 (start start-gexp)
151 (stop #~(const #f))
152 (respawn? #f)
153 (one-shot? #t)
154 (documentation "Setup Guix Data Service database."))))
155
156(define %guix-data-service-os
157 (simple-operating-system
158 (service dhcpcd-service-type)
159 (service postgresql-service-type
160 (postgresql-configuration
161 (postgresql postgresql)
162 (config-file
163 (postgresql-config-file
164 (hba-file
165 (plain-file "pg_hba.conf"
166 "
167local all all trust
168host all all 127.0.0.1/32 trust
169host all all ::1/128 trust"))))))
170 (service guix-data-service-type
171 (guix-data-service-configuration
172 (host "0.0.0.0")))
173 (simple-service 'guix-data-service-database-setup
174 shepherd-root-service-type
175 (list guix-data-service-initial-database-setup-service))))
176
177(define (run-guix-data-service-test)
178 (define os
179 (marionette-operating-system
180 %guix-data-service-os
181 #:imported-modules '((gnu services herd)
182 (guix combinators))))
183
184 (define forwarded-port 8080)
185
186 (define vm
187 (virtual-machine
188 (operating-system os)
189 (memory-size 1024)
190 (port-forwardings `((,forwarded-port . 8765)))))
191
192 (define test
193 (with-imported-modules '((gnu build marionette))
194 #~(begin
195 (use-modules (srfi srfi-11) (srfi srfi-64)
196 (gnu build marionette)
197 (web uri)
198 (web client)
199 (web response))
200
201 (define marionette
202 (make-marionette (list #$vm)))
203
204 (test-runner-current (system-test-runner #$output))
205 (test-begin "guix-data-service")
206
207 (test-assert "service running"
208 (marionette-eval
209 '(begin
210 (use-modules (gnu services herd))
211 (match (start-service 'guix-data-service)
212 (#f #f)
213 (('service response-parts ...)
214 (match (assq-ref response-parts 'running)
215 ((pid) pid)))))
216 marionette))
217
218 (test-assert "process jobs service running"
219 (marionette-eval
220 '(begin
221 (use-modules (gnu services herd))
222 (match (start-service 'guix-data-service-process-jobs)
223 (#f #f)
224 (('service response-parts ...)
225 (match (assq-ref response-parts 'running)
226 ((pid) pid)))))
227 marionette))
228
229 ;; The service starts immediately but replies with status 500 until
230 ;; initialization is complete, so keep trying for a while.
231 (define (try-http-get attempts)
232 (let ((status
233 (let-values (((response text)
234 (http-get #$(simple-format
235 #f "http://localhost:~A/healthcheck"
236 forwarded-port))))
237 (response-code response))))
238 (if (or (= status 200) (<= attempts 1))
239 status
240 (begin (sleep 5)
241 (try-http-get (- attempts 1))))))
242
243 (test-equal "http-get"
244 200
245 (try-http-get 12))
246
247 (test-end))))
248
249 (gexp->derivation "guix-data-service-test" test))
250
251(define %test-guix-data-service
252 (system-test
253 (name "guix-data-service")
254 (description "Connect to a running Guix Data Service.")
255 (value (run-guix-data-service-test))))
256
257
258;;;
259;;; Guix Home
260;;;
261
262(define %guix-home-service-he
263 (home-environment
264 (services
265 (list (simple-service 'guix-home-service-test
266 home-files-service-type
267 `(("guix-home-service-activated"
268 ,(plain-file "guix-home-service-activated"
269 "Guix Home service activated"))))))))
270
271(define %guix-home-service-os
272 (simple-operating-system
273 (service guix-home-service-type
274 `(("alice" ,%guix-home-service-he)))))
275
276(define (run-guix-home-service-test)
277 (define os
278 (marionette-operating-system
279 %guix-home-service-os
280 #:imported-modules '((gnu services herd))))
281
282 (define vm
283 (virtual-machine
284 (operating-system os)
285 (memory-size 1024)))
286
287 (define test
288 (with-imported-modules '((gnu build marionette))
289 #~(begin
290 (use-modules (srfi srfi-64)
291 (gnu build marionette))
292
293 (define marionette
294 (make-marionette (list #$vm)))
295
296 (test-runner-current (system-test-runner #$output))
297 (test-begin "guix-home-service")
298
299 (test-assert "service started"
300 (marionette-eval
301 '(begin
302 (use-modules (gnu services herd))
303 (match (start-service 'guix-home-alice)
304 (#f #f)
305 ;; herd returns (running #f), likely because of one shot,
306 ;; so consider any non-error a success.
307 (('service response-parts ...) #t)))
308 marionette))
309
310 (test-assert "file-exists"
311 (marionette-eval
312 '(begin
313 (sleep 3) ;make sure service has time to symlink files
314 (file-exists? "/home/alice/guix-home-service-activated"))
315 marionette))
316
317 (test-end))))
318
319 (gexp->derivation "guix-home-service-test" test))
320
321(define %test-guix-home-service
322 (system-test
323 (name "guix-home-service")
324 (description "Activate a Guix home environment.")
325 (value (run-guix-home-service-test))))
326
327
328;;;
329;;; Nar Herder
330;;;
331
332(define %nar-herder-os
333 (simple-operating-system
334 (service dhcpcd-service-type)
335 (service nar-herder-service-type
336 (nar-herder-configuration
337 (host "0.0.0.0")
338 (control-host "0.0.0.0")
339 ;; Not a realistic value, but works for the test
340 (storage "/tmp")))))
341
342(define (run-nar-herder-test)
343 (define os
344 (marionette-operating-system
345 %nar-herder-os
346 #:imported-modules '((gnu services herd)
347 (guix combinators))))
348
349 (define forwarded-port
350 (nar-herder-configuration-port
351 (nar-herder-configuration)))
352
353 (define control-forwarded-port
354 (nar-herder-configuration-control-port
355 (nar-herder-configuration)))
356
357 (define vm
358 (virtual-machine
359 (operating-system os)
360 (memory-size 1024)
361 (port-forwardings `((,forwarded-port . ,forwarded-port)
362 (,control-forwarded-port
363 . ,control-forwarded-port)))))
364
365 (define test
366 (with-imported-modules '((gnu build marionette))
367 #~(begin
368 (use-modules (srfi srfi-11) (srfi srfi-64)
369 (gnu build marionette)
370 (web uri)
371 (web client)
372 (web response))
373
374 (define marionette
375 (make-marionette (list #$vm)))
376
377 (test-runner-current (system-test-runner #$output))
378 (test-begin "nar-herder")
379
380 (test-assert "service running"
381 (marionette-eval
382 '(begin
383 (use-modules (gnu services herd))
384 (match (start-service 'nar-herder)
385 (#f #f)
386 (('service response-parts ...)
387 (match (assq-ref response-parts 'running)
388 ((pid) pid)))))
389 marionette))
390
391 (test-equal "http-get"
392 404
393 (let-values
394 (((response text)
395 (http-get #$(simple-format
396 #f "http://localhost:~A/" forwarded-port)
397 #:decode-body? #t)))
398 (response-code response)))
399
400 (test-equal "control http-get"
401 404
402 (let-values
403 (((response text)
404 (http-get #$(simple-format
405 #f "http://localhost:~A/"
406 control-forwarded-port)
407 #:decode-body? #t)))
408 (response-code response)))
409
410 (test-end))))
411
412 (gexp->derivation "nar-herder-test" test))
413
414(define %test-nar-herder
415 (system-test
416 (name "nar-herder")
417 (description "Connect to a running Nar Herder server.")
418 (value (run-nar-herder-test))))
419
420
421;;;
422;;; Build Farm Front-end
423;;;
424
425(define %bffe-os
426 (simple-operating-system
427 (service dhcpcd-service-type)
428 (service guix-build-coordinator-service-type)
429 (service bffe-service-type
430 (bffe-configuration
431 (arguments
432 #~(list
433 #:web-server-args
434 '(#:port 8767
435 #:controller-args
436 (#:title "Test title"))))))))
437
438(define (run-bffe-test)
439 (define os
440 (marionette-operating-system
441 %bffe-os
442 #:imported-modules '((gnu services herd)
443 (guix combinators))))
444
445 (define forwarded-port 8767)
446
447 (define vm
448 (virtual-machine
449 (operating-system os)
450 (memory-size 1024)
451 (port-forwardings `((,forwarded-port . 8767)))))
452
453 (define test
454 (with-imported-modules '((gnu build marionette))
455 #~(begin
456 (use-modules (srfi srfi-11) (srfi srfi-64)
457 (gnu build marionette)
458 (web uri)
459 (web client)
460 (web response))
461
462 (define marionette
463 (make-marionette (list #$vm)))
464
465 (test-runner-current (system-test-runner #$output))
466 (test-begin "bffe")
467
468 (test-assert "service running"
469 (marionette-eval
470 '(begin
471 (use-modules (gnu services herd))
472 (match (start-service 'bffe)
473 (#f #f)
474 (('service response-parts ...)
475 (match (assq-ref response-parts 'running)
476 ((pid) pid)))))
477 marionette))
478
479 (test-equal "http-get"
480 200
481 (let-values
482 (((response text)
483 (http-get #$(simple-format
484 #f "http://localhost:~A/" forwarded-port)
485 #:decode-body? #t)))
486 (response-code response)))
487
488 (test-end))))
489
490 (gexp->derivation "bffe-test" test))
491
492(define %test-bffe
493 (system-test
494 (name "bffe")
495 (description "Connect to a running Build Farm Front-end.")
496 (value (run-bffe-test))))