services: configuration: Add user-defined sanitizer support.

This changes the 'custom-serializer' field into a generic
'extra-args' field that can be extended to support new literals.
Within extra-args, the literals 'sanitizer' and 'serializer' allow
for user-defined sanitization and serialization procedures respectively.
The 'empty-serializer' was also added as a literal to be used as before.

To prevent confusion between the new “explicit” style of specifying
a sanitizer, and the old “implicit” style, the latter has been
deprecated, and a warning is issued if it is encountered.

* gnu/services/configuration.scm (define-configuration-helper):
Rename 'custom-serializer' to 'extra-args'.  Add support for literals
'sanitizer', 'serializer' and 'empty-serializer'.  Rename procedure
'field-sanitizer' to 'default-field-sanitizer' to avoid syntax clash.
Only define default field sanitizers if user-defined ones are absent.
(normalize-extra-args): New variable.
(<configuration-field>)[sanitizer]: New field.
* doc/guix.texi (Complex Configurations): Document the newly added
literals.
* tests/services/configuration.scm: Add tests for the new literals.

Signed-off-by: Liliana Marie Prikler <liliana.prikler@gmail.com>

1 files changed, 181 insertions, 2 deletions

diff --git a/tests/services/configuration.scm b/tests/services/configuration.scm
index 4f8a74dc8ac..0392cce927a 100644
--- a/tests/services/configuration.scm
+++ b/tests/services/configuration.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,6 +23,7 @@
   #:use-module (gnu services configuration)
   #:use-module (guix diagnostics)
   #:use-module (guix gexp)
+  #:autoload (guix i18n) (G_)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64))
 
@@ -46,14 +48,14 @@
   (port-configuration-port (port-configuration)))
 
 (test-equal "wrong type for a field"
-  '("configuration.scm" 57 11)                    ;error location
+  '("configuration.scm" 59 11)                    ;error location
   (guard (c ((configuration-error? c)
              (let ((loc (error-location c)))
                (list (basename (location-file loc))
                      (location-line loc)
                      (location-column loc)))))
     (port-configuration
-     ;; This is line 56; the test relies on line/column numbers!
+     ;; This is line 58; the test relies on line/column numbers!
      (port "This is not a number!"))))
 
 (define-configuration port-configuration-cs
@@ -111,6 +113,183 @@
 
 
 ;;;
+;;; define-configuration macro, extra-args literals
+;;;
+
+(define (eval-gexp x)
+  "Get serialized config as string."
+  (eval (gexp->approximate-sexp x)
+        (current-module)))
+
+(define (port? value)
+  (or (string? value) (number? value)))
+
+(define (sanitize-port value)
+  (cond ((number? value) value)
+        ((string? value) (string->number value))
+        (else (raise (formatted-message (G_ "Bad value: ~a") value)))))
+
+(test-group "Basic sanitizer literal tests"
+  (define serialize-port serialize-number)
+
+  (define-configuration config-with-sanitizer
+    (port
+     (port 80)
+     "Lorem Ipsum."
+     (sanitizer sanitize-port)))
+
+  (test-equal "default value, sanitizer"
+    80
+    (config-with-sanitizer-port (config-with-sanitizer)))
+
+  (test-equal "string value, sanitized to number"
+    56
+    (config-with-sanitizer-port (config-with-sanitizer
+                                 (port "56"))))
+
+  (define (custom-serialize-port field-name value)
+    (number->string value))
+
+  (define-configuration config-serializer
+    (port
+     (port 80)
+     "Lorem Ipsum."
+     (serializer custom-serialize-port)))
+
+  (test-equal "default value, serializer literal"
+    "80"
+    (eval-gexp
+     (serialize-configuration (config-serializer)
+                              config-serializer-fields))))
+
+(test-group "empty-serializer as literal/procedure tests"
+  (define-configuration config-with-literal
+    (port
+     (port 80)
+     "Lorem Ipsum."
+     empty-serializer))
+
+  (define-configuration config-with-proc
+    (port
+     (port 80)
+     "Lorem Ipsum."
+     (serializer empty-serializer)))
+
+  (test-equal "empty-serializer as literal"
+    ""
+    (eval-gexp
+     (serialize-configuration (config-with-literal)
+                              config-with-literal-fields)))
+
+  (test-equal "empty-serializer as procedure"
+    ""
+    (eval-gexp
+     (serialize-configuration (config-with-proc)
+                              config-with-proc-fields))))
+
+(test-group "permutation tests"
+  (define-configuration config-san+empty-ser
+    (port
+     (port 80)
+     "Lorem Ipsum."
+     (sanitizer sanitize-port)
+     empty-serializer))
+
+  (define-configuration config-san+ser
+    (port
+     (port 80)
+     "Lorem Ipsum."
+     (sanitizer sanitize-port)
+     (serializer (lambda _ "foo"))))
+
+  (test-equal "default value, sanitizer, permutation"
+    80
+    (config-san+empty-ser-port (config-san+empty-ser)))
+
+  (test-equal "default value, serializer, permutation"
+    "foo"
+    (eval-gexp
+     (serialize-configuration (config-san+ser) config-san+ser-fields)))
+
+  (test-equal "string value sanitized to number, permutation"
+    56
+    (config-san+ser-port (config-san+ser
+                          (port "56"))))
+
+  ;; Ordering tests.
+  (define-configuration config-ser+san
+    (port
+     (port 80)
+     "Lorem Ipsum."
+     (sanitizer sanitize-port)
+     (serializer (lambda _ "foo"))))
+
+  (define-configuration config-empty-ser+san
+    (port
+     (port 80)
+     "Lorem Ipsum."
+     empty-serializer
+     (sanitizer sanitize-port)))
+
+  (test-equal "default value, sanitizer, permutation 2"
+    56
+    (config-empty-ser+san-port (config-empty-ser+san
+                                (port "56"))))
+
+  (test-equal "default value, serializer, permutation 2"
+    "foo"
+    (eval-gexp
+     (serialize-configuration (config-ser+san) config-ser+san-fields))))
+
+(test-group "duplicated/conflicting entries"
+  (test-error
+   "duplicate sanitizer" #t
+   (macroexpand '(define-configuration dupe-san
+                   (foo
+                    (list '())
+                    "Lorem Ipsum."
+                    (sanitizer (lambda () #t))
+                    (sanitizer (lambda () #t))))))
+
+  (test-error
+   "duplicate serializer" #t
+   (macroexpand '(define-configuration dupe-ser
+                   (foo
+                    (list '())
+                    "Lorem Ipsum."
+                    (serializer (lambda _ ""))
+                    (serializer (lambda _ ""))))))
+
+  (test-error
+   "conflicting use of serializer + empty-serializer" #t
+   (macroexpand '(define-configuration ser+empty-ser
+                   (foo
+                    (list '())
+                    "Lorem Ipsum."
+                    (serializer (lambda _ "lorem"))
+                    empty-serializer)))))
+
+(test-group "Mix of deprecated and new syntax"
+  (test-error
+   "Mix of bare serializer and new syntax" #t
+   (macroexpand '(define-configuration mixed
+                   (foo
+                    (list '())
+                    "Lorem Ipsum."
+                    (sanitizer (lambda () #t))
+                    (lambda _ "lorem")))))
+
+  (test-error
+   "Mix of bare serializer and new syntax, permutation)" #t
+   (macroexpand '(define-configuration mixed
+                   (foo
+                    (list '())
+                    "Lorem Ipsum."
+                    (lambda _ "lorem")
+                    (sanitizer (lambda () #t)))))))
+
+
+;;;
 ;;; define-maybe macro.
 ;;;
 (define-maybe number)