services: git-http-nginx-location-configuration: Enable configuration of the root URI path /.

* gnu/services/version-control.scm
  (git-http-nginx-location-configuration): Handle the case
  where uri-path is "/" by not adding an extra slash prefix.
* gnu/tests/version-control.scm (git-nginx-root-configuration):
  Generalize from %git-nginx-root-configuration
  to take uri-path as an argument from...
  (git-http-os): ...this new procedure generalized from %git-http-os
  to take uri-path as an argument from...
  (git-http-test): ...this new procedure generalized
  from run-git-http-test to return a system test
  instead of just its store value.  Additionally
  take name, description, and uri-path arguments.
  (%test-git-http): Adjust accordingly.
  (%test-git-http-root-path): Duplicate %test-git-http
  with "/" instead of "/git/" as uri-path.

Merges: https://codeberg.org/guix/guix/pulls/6140
Co-authored-by: Nguyễn Gia Phong <cnx@loang.net>
Signed-off-by: Nguyễn Gia Phong <cnx@loang.net>

2 files changed, 31 insertions, 14 deletions

diff --git a/gnu/services/version-control.scm b/gnu/services/version-control.scm
index dba38faa460..55af92c9f5a 100644
--- a/gnu/services/version-control.scm
+++ b/gnu/services/version-control.scm
@@ -275,7 +275,12 @@ access to exported repositories under @file{/srv/git}."
     (($ <git-http-configuration> package git-root export-all?
                                  uri-path fcgiwrap-socket)
      (nginx-location-configuration
-      (uri (string-append "~ /" (string-trim-both uri-path #\/) "(/.*)"))
+      (uri (string-append
+            "~ "
+            (if (string=? uri-path "/")
+                ""
+                (string-append "/" (string-trim-both uri-path #\/)))
+            "(/.*)"))
       (body
        (list
         (list "fastcgi_pass " fcgiwrap-socket ";")
diff --git a/gnu/tests/version-control.scm b/gnu/tests/version-control.scm
index 9df3aa9dbd4..2a2cc917781 100644
--- a/gnu/tests/version-control.scm
+++ b/gnu/tests/version-control.scm
@@ -39,6 +39,7 @@
   #:use-module (guix modules)
   #:export (%test-cgit
             %test-git-http
+            %test-git-http-root-path
             %test-gitolite
             %test-gitile
             %test-fossil))
@@ -217,7 +218,7 @@ HTTP-PORT."
 ;;; Git server.
 ;;;
 
-(define %git-nginx-configuration
+(define (git-nginx-configuration uri-path)
   (nginx-configuration
    (server-blocks
     (list
@@ -228,19 +229,20 @@ HTTP-PORT."
       (locations
        (list (git-http-nginx-location-configuration
               (git-http-configuration (export-all? #t)
-                                      (uri-path "/git"))))))))))
+                                      (uri-path uri-path))))))))))
 
-(define %git-http-os
+(define (git-http-os uri-path)
   (simple-operating-system
    (service dhcpcd-service-type)
    (service fcgiwrap-service-type)
-   (service nginx-service-type %git-nginx-configuration)
+   (service nginx-service-type (git-nginx-configuration uri-path))
    %test-repository-service))
 
-(define* (run-git-http-test #:optional (http-port 19418))
+(define* (git-http-test name description uri-path
+          #:optional (http-port 19418))
   (define os
     (marionette-operating-system
-     %git-http-os
+     (git-http-os uri-path)
      #:imported-modules '((gnu services herd)
                           (guix combinators))))
 
@@ -262,7 +264,7 @@ HTTP-PORT."
             (make-marionette (list #$vm)))
 
           (test-runner-current (system-test-runner #$output))
-          (test-begin "git-http")
+          (test-begin #$name)
 
           ;; Wait for nginx to be up and running.
           (test-assert "nginx running"
@@ -283,19 +285,29 @@ HTTP-PORT."
             '#$README-contents
             (begin
               (invoke #$(file-append git "/bin/git") "clone" "-v"
-                      "http://localhost:8080/git/test" "/tmp/clone")
+                      #$(simple-format #f "http://localhost:8080~a/test"
+                          (if (string=? uri-path "/")
+                              ""
+                              (string-append "/" (string-trim-both
+                                                  uri-path #\/))))
+                      "/tmp/clone")
               (call-with-input-file "/tmp/clone/README"
                 get-string-all)))
 
           (test-end))))
 
-  (gexp->derivation "git-http" test))
+  (system-test
+   (name name)
+   (description description)
+   (value (gexp->derivation name test))))
 
 (define %test-git-http
-  (system-test
-   (name "git-http")
-   (description "Connect to a running Git HTTP server.")
-   (value (run-git-http-test))))
+  (git-http-test "git-http" "Connect to a running Git HTTP server." "/git/"))
+
+(define %test-git-http-root-path
+  (git-http-test "git-http-root-path"
+                 "Connect to a running Git HTTP server with root URI path."
+                 "/"))
 
 
 ;;;