tests/internet/tests.scm: Add working git-service-type test

1 files changed, 72 insertions, 0 deletions

diff --git a/tests/internet/tests.scm b/tests/internet/tests.scm
new file mode 100644
index 0000000..2fca30f
--- /dev/null
+++ b/tests/internet/tests.scm
@@ -0,0 +1,72 @@
+(use-modules
+  ((org euandre packages) #:prefix pkg:)
+  (gnu)
+  (gnu tests)
+  (gnu system vm)
+  (guix profiles))
+(use-service-modules
+  networking)
+
+
+
+(define test-git-os
+  (simple-operating-system
+    (service dhcp-client-service-type)
+    (service pkg:git-service-type
+      (pkg:git-configuration
+        (run-server? #t)))
+    (simple-service 'mkdir-srv-dir activation-service-type
+      #~(mkdir-p "/srv/git"))))
+
+(define (test-git-fn)
+  (let* ((os (marionette-operating-system
+              test-git-os
+              #:imported-modules
+              '((gnu services herd))))
+         (vm (virtual-machine
+               (operating-system os)
+               (port-forwardings
+                '()))))
+    (define test
+      (with-imported-modules '((gnu build marionette))
+        #~(begin
+            (use-modules
+              ((srfi srfi-64) #:prefix t:)
+              ((gnu build marionette) #:prefix mrntt:))
+            (define manette
+              (mrntt:make-marionette (list #$vm)))
+            (t:test-runner-current (mrntt:system-test-runner #$output))
+            (t:test-begin "git-daemon-server")
+            (t:test-assert "Git daemon service running"
+              (mrntt:marionette-eval
+               '(begin
+                  (use-modules
+                    ((gnu services herd) #:prefix herd:))
+                  (herd:start-service 'git))
+               manette))
+            (t:test-assert "Git daemon TCP port ready"
+              (mrntt:wait-for-tcp-port 9418 manette))
+            (t:test-end))))
+    (gexp->derivation "git-service-type-test" test)))
+
+(define test-git
+  (system-test
+    (name "git")
+    (description "Test custom Git service")
+    (value (test-git-fn))))
+
+(define tests
+  (list
+   test-git))
+
+(define (system-test->manifest-entry test)
+  (manifest-entry
+    (name
+      (pkg:str "test."
+               (system-test-name test)))
+    (version "0")
+    (item test)))
+
+(manifest
+ (map system-test->manifest-entry
+      tests))