From edb1d29cf5b344f2edf268b482861310580d12be Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 25 Oct 2025 10:52:29 +0100
Subject: [PATCH] tests: nar-herder: Test the control port.

* gnu/services/guix.scm (nar-herder-shepherd-services): Add missing variables.
* gnu/tests/guix.scm (%nar-herder-os): Have the control server listen on all
interfaces.
(run-nar-herder-test): Test connecting to the control server.

Change-Id: I40949e8adaf0c6491ee56c59d611395a639d497b
---
 gnu/services/guix.scm |  1 +
 gnu/tests/guix.scm    | 27 +++++++++++++++++++++++----
 2 files changed, 24 insertions(+), 4 deletions(-)

diff --git a/gnu/services/guix.scm b/gnu/services/guix.scm
index 5b811491f66..51aaf550bf0 100644
--- a/gnu/services/guix.scm
+++ b/gnu/services/guix.scm
@@ -961,6 +961,7 @@ ca-certificates.crt file in the system profile."
              mirror
              database database-dump
              host port
+             control-host control-port
              storage storage-limit storage-minimum-free-space
              storage-nar-removal-criteria
              ttl new-ttl negative-ttl log-level
diff --git a/gnu/tests/guix.scm b/gnu/tests/guix.scm
index 14982cf1b5c..8b692f28760 100644
--- a/gnu/tests/guix.scm
+++ b/gnu/tests/guix.scm
@@ -334,9 +334,10 @@ host	all	all	::1/128 	trust"))))))
    (service dhcpcd-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")))))
+              (host "0.0.0.0")
+              (control-host "0.0.0.0")
+              ;; Not a realistic value, but works for the test
+              (storage "/tmp")))))
 
 (define (run-nar-herder-test)
   (define os
@@ -349,11 +350,17 @@ host	all	all	::1/128 	trust"))))))
     (nar-herder-configuration-port
      (nar-herder-configuration)))
 
+  (define control-forwarded-port
+    (nar-herder-configuration-control-port
+     (nar-herder-configuration)))
+
   (define vm
     (virtual-machine
      (operating-system os)
      (memory-size 1024)
-     (port-forwardings `((,forwarded-port . ,forwarded-port)))))
+     (port-forwardings `((,forwarded-port . ,forwarded-port)
+                         (,control-forwarded-port
+                          . ,control-forwarded-port)))))
 
   (define test
     (with-imported-modules '((gnu build marionette))
@@ -390,6 +397,16 @@ host	all	all	::1/128 	trust"))))))
                             #:decode-body? #t)))
               (response-code response)))
 
+          (test-equal "control http-get"
+            404
+            (let-values
+                (((response text)
+                  (http-get #$(simple-format
+                               #f "http://localhost:~A/"
+                               control-forwarded-port)
+                            #:decode-body? #t)))
+              (response-code response)))
+
           (test-end))))
 
   (gexp->derivation "nar-herder-test" test))
@@ -477,3 +494,5 @@ host	all	all	::1/128 	trust"))))))
    (name "bffe")
    (description "Connect to a running Build Farm Front-end.")
    (value (run-bffe-test))))
+
+%nar-herder-os