diff options
Diffstat (limited to 'gnu/tests')
| -rw-r--r-- | gnu/tests/guix.scm | 81 |
1 files changed, 79 insertions, 2 deletions
diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm index 69cac7c1aa..a4c3e35e5d 100644 --- a/gnu/tests/guix.scm +++ b/gnu/tests/guix.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2019 Christopher Baines <mail@cbaines.net> +;;; Copyright © 2019, 2020, 2021, 2022 Christopher Baines <mail@cbaines.net> ;;; ;;; This file is part of GNU Guix. ;;; @@ -36,7 +36,8 @@ #:use-module (guix utils) #:use-module (ice-9 match) #:export (%test-guix-build-coordinator - %test-guix-data-service)) + %test-guix-data-service + %test-nar-herder)) ;;; ;;; Guix Build Coordinator @@ -239,3 +240,79 @@ host all all ::1/128 trust")))))) (name "guix-data-service") (description "Connect to a running Guix Data Service.") (value (run-guix-data-service-test)))) + + +;;; +;;; 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)))) |