[bug#67613] [PATCH] tests: Add oci-container-service-type unit tests.

[Giacomo Leidi via Guix-patches via <guix-patches@gnu.org>]

This patch is a followup to issue #66160 and issue #67574. It introduces
unit tests for the oci-container-service-type. 8 out 11 tests depend on
issue #67574 being merged since issue #66160 was merged with a blocking
bug from the beginning.

* gnu/services/docker.scm: Export
oci-container-configuration-container-user and
oci-container-configuration-workdir.
* tests/services/docker.scm: New file.
* Makefile.am (SCM_TESTS): Register it.

Change-Id: I47ed0fe36060ba84dd50b548a66f36e3df8a3710
---
 Makefile.am               |   1 +
 gnu/services/docker.scm   |   2 +
 tests/services/docker.scm | 187 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 190 insertions(+)
 create mode 100644 tests/services/docker.scm

diff --git a/Makefile.am b/Makefile.am
index cbc3191dfc..91f7a77a94 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -564,6 +564,7 @@ SCM_TESTS =					\
   tests/services.scm				\
   tests/services/file-sharing.scm		\
   tests/services/configuration.scm		\
+  tests/services/docker.scm			\
   tests/services/lightdm.scm			\
   tests/services/linux.scm			\
   tests/services/pam-mount.scm			\
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index ebea0a473a..263cb41df3 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -58,6 +58,8 @@ (define-module (gnu services docker)
             oci-container-configuration-network
             oci-container-configuration-ports
             oci-container-configuration-volumes
+            oci-container-configuration-container-user
+            oci-container-configuration-workdir
             oci-container-service-type
             oci-container-shepherd-service))
 
diff --git a/tests/services/docker.scm b/tests/services/docker.scm
new file mode 100644
index 0000000000..fad28a228c
--- /dev/null
+++ b/tests/services/docker.scm
@@ -0,0 +1,187 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (tests services docker)
+  #:use-module (gnu packages docker)
+  #:use-module (gnu services docker)
+  #:use-module (guix derivations)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix store)
+  #:use-module (guix tests)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+
+;;; Commentary:
+;;;
+;;; Unit tests for the (gnu services docker) module.
+;;;
+;;; Code:
+
+
+;;;
+;;; Unit tests for the oci-container-service-type.
+;;;
+
+
+;;; Access some internals for whitebox testing.
+(define %store
+  (open-connection-for-tests))
+(define (gexp->sexp . x)
+  (apply (@@ (guix gexp) gexp->sexp) x))
+(define* (gexp->sexp* exp #:optional target)
+  (run-with-store %store (gexp->sexp exp (%current-system) target)
+                  #:guile-for-build (%guile-for-build)))
+(define (list->sexp-list* lst)
+  (map (lambda (el)
+         (if (gexp? el)
+             (gexp->sexp* el)
+             el))
+       lst))
+(define oci-sanitize-mixed-list
+  (@@ (gnu services docker) oci-sanitize-mixed-list))
+(define (oci-container-configuration->options config)
+  (list->sexp-list*
+   ((@@ (gnu services docker) oci-container-configuration->options) config)))
+
+(test-begin "oci-containers-service")
+
+(test-group "oci-sanitize-mixed-list"
+  (define delimiter "=")
+  (define file-like-key
+    (plain-file "oci-tests-file-like-key" "some-content"))
+  (define mixed-list
+    `("any kind of string"
+      ("KEY" . "VALUE")
+      (,#~(string-append "COMPUTED" "_KEY") . "VALUE")
+      (,file-like-key . "VALUE")))
+
+  (test-assertm "successfully lower mixed values"
+    (mlet* %store-monad ((ml ->             (oci-sanitize-mixed-list "field-name" mixed-list delimiter))
+                         (actual ->         (list->sexp-list* ml))
+                         (file-like-item    (lower-object file-like-key))
+                         (expected ->       `("any kind of string"
+                                              (string-append "KEY" "=" "VALUE")
+                                              (string-append (string-append "COMPUTED" "_KEY") "=" "VALUE")
+                                              (string-append ,file-like-item "=" "VALUE"))))
+      (mbegin %store-monad
+        (return
+         (every (lambda (pair)
+                  (apply (if (string? (first pair))
+                             string=?
+                             equal?)
+                         pair))
+                (zip expected actual))))))
+
+  (test-error
+   "illegal list values" #t
+   (oci-sanitize-mixed-list "field-name" '(("KEY" . "VALUE") #f) delimiter))
+
+  (test-error
+   "illegal pair member values" #t
+   (oci-sanitize-mixed-list "field-name" '(("KEY" . 1)) delimiter)))
+
+(test-group "oci-container-configuration->options"
+  (define config
+    (oci-container-configuration
+     (image "guix/guix:latest")))
+
+  (test-equal "entrypoint"
+    (list "--entrypoint" "entrypoint")
+    (oci-container-configuration->options
+     (oci-container-configuration
+      (inherit config)
+      (entrypoint "entrypoint"))))
+
+  (test-equal "environment"
+    (list "--env" '(string-append "key" "=" "value")
+          "--env" '(string-append "environment" "=" "variable"))
+    (oci-container-configuration->options
+     (oci-container-configuration
+      (inherit config)
+      (environment
+       '(("key" . "value")
+         ("environment" . "variable"))))))
+
+  (test-equal "network"
+    (list "--network" "host")
+    (oci-container-configuration->options
+     (oci-container-configuration
+      (inherit config)
+      (network "host"))))
+
+  (test-equal "container-user"
+    (list "--user" "service-account")
+    (oci-container-configuration->options
+     (oci-container-configuration
+      (inherit config)
+      (container-user "service-account"))))
+
+  (test-equal "workdir"
+    (list "--workdir" "/srv/http")
+    (oci-container-configuration->options
+     (oci-container-configuration
+      (inherit config)
+      (workdir "/srv/http"))))
+
+  (test-equal "ports"
+    (list "-p" '(string-append "10443" ":" "443")
+          "-p" '(string-append "9022" ":" "22"))
+    (oci-container-configuration->options
+     (oci-container-configuration
+      (inherit config)
+      (ports
+       '(("10443" . "443")
+         ("9022" . "22"))))))
+
+  (test-equal "volumes"
+    (list "-v" '(string-append "/gnu/store" ":" "/gnu/store")
+          "-v" '(string-append "/var/lib/guix" ":" "/var/lib/guix"))
+    (oci-container-configuration->options
+     (oci-container-configuration
+      (inherit config)
+      (volumes
+       '(("/gnu/store" . "/gnu/store")
+         ("/var/lib/guix" . "/var/lib/guix"))))))
+
+  (test-equal "complete configuration"
+    (list "--entrypoint" "entrypoint"
+          "--env" '(string-append "key" "=" "value")
+          "--network" "host"
+          "--user" "service-account"
+          "--workdir" "/srv/http"
+          "-p" '(string-append "10443" ":" "443")
+          "-v" '(string-append "/gnu/store" ":" "/gnu/store"))
+    (oci-container-configuration->options
+     (oci-container-configuration
+      (inherit config)
+      (entrypoint "entrypoint")
+      (environment
+       '(("key" . "value")))
+      (network "host")
+      (container-user "service-account")
+      (workdir "/srv/http")
+      (ports
+       '(("10443" . "443")))
+      (volumes
+       '(("/gnu/store" . "/gnu/store")))))))
+
+(test-end "oci-containers-service")

base-commit: 2c9ac9ab20c76abe570ff83f8746fa089fea3047
-- 
2.41.0