[PATCH 1/1] gnu: audio: Add mympd-service-type.

[mirai]

From: Bruno Victal <mirai@makinata.eu>

---
Potential issues:
  * The use 'define-maybe' [string | comma-separated-string] might interfere 
with other
  service definitions that are added over time.
  * Should 'log-file' used in 'shepherd-service' be a configuration parameter?
  * Service configuration is not in the 'store'. To understand this, myMPD uses 
a directory
  it calls 'working-directory' to store/read both the configuration and mutable 
data. So if it uses
  '/var/lib/mympd' as its "working-directory", it must read the configuration 
from a 'config'
  subdirectory ('/var/lib/mympd/config/'). When it comes to configuration, each 
directive corresponds to
  a file under this '/config' directory. How it sets/reads the values, myMPD 
provides two ways to do so:
       1. It can read from the environment-variables iff the "config" directory 
within its
       'working-directory' is empty. In this case, they are read and written to 
the corresponding file.
       Subsequent runs will ignore the environment variable values, even if 
they differ (with the exception of
       'MYMPD_LOGLEVEL' which is always used).
       2. Read directly from the files present within 'config' subdirectory. 
This is essentially what happens
       after the first launch described above.
    The current approach used erases this 'config' directory on every 'guix 
system reconfigure'. Downsides is that
    it is prone to overdelete things depending on further upstream developments 
and the expectation that every
    parameter is adjustable via environment variables (at the moment, there's 
one that can't be set but its of
    a peculiar nature that I'm not sure if it should be added to the store. 
It's an optional sha256 password hash.
    (https://jcorporation.github.io/myMPD/configuration/)
  * A warning that the default group used (nogroup) is duplicated. I reasoned 
that there's little point in
  creating a specific group that might end up unused yet allow for a custom 
group to be used if necessary.
  * 'comma-separated-string-list' code duplication. This function was lifted 
from 'gnu/services/mail.scm' but
  its already duplicated at 'gnu/services/cups.scm'. It doesn't seem to be an 
uncommon pattern used in configuration,
  maybe this could be added to 'gnu/services/configuration.scm' as a 
readily-available type for convenience?

 doc/guix.texi          |  79 +++++++++++++++++++
 gnu/services/audio.scm | 174 ++++++++++++++++++++++++++++++++++++++++-
 gnu/tests/audio.scm    |  54 ++++++++++++-
 3 files changed, 305 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index eaecfd0daa..10727d5196 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -109,6 +109,7 @@ Copyright @copyright{} 2022 Reily Siegel@*
 Copyright @copyright{} 2022 Simon Streit@*
 Copyright @copyright{} 2022 (@*
 Copyright @copyright{} 2022 John Kehayias@*
+Copyright @copyright{} 2022 Bruno Victal@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -32889,6 +32890,84 @@ an HTTP audio streaming output.
                         (port    . "8080"))))))))
 @end lisp
 
+@subsubheading myMPD
+
+@cindex MPD, web interface
+@cindex myMPD service
+
+@uref{https://jcorporation.github.io/myMPD/, myMPD} is a service that provides 
a
+mobile friendly web client for MPD.
+
+The following example shows a myMPD instance listening on port 80, with album 
cover caching disabled.
+
+@lisp
+(service mympd-service-configuration
+         (mympd-configuration
+          (port 80)
+          (covercache-ttl 0)))
+@end lisp
+
+@c auto-generated with (configuration->documentation)
+@deftp {Data Type} mympd-configuration
+Available @code{mympd-configuration} fields are:
+
+@table @asis
+@item @code{package} (default: @code{mympd}) (type: file-like)
+The package object of the myMPD server.
+
+@item @code{user} (default: @code{"mympd"}) (type: string)
+Owner of the @code{mympd} process.
+
+@item @code{group} (default: @code{"nogroup"}) (type: string)
+Owner's group of the @code{mympd} process.
+
+@item @code{work-directory} (default: @code{"/var/lib/mympd"}) (type: string)
+Where myMPD will store its data.
+
+@item @code{cache-directory} (default: @code{"/var/cache/mympd"}) (type: 
string)
+Where myMPD will store its cache.
+
+@item @code{acl} (type: maybe-comma-separated-string-list)
+ACL to access the myMPD webserver.  See
+@uref{https://jcorporation.github.io/myMPD/configuration/acl,myMPD ACL}
+for syntax.
+
+@item @code{covercache-ttl} (default: @code{31}) (type: number)
+How long to keep cached covers.  Setting to @code{0} disables caching.
+
+@item @code{host} (default: @code{"[::]"}) (type: string)
+Host name to listen on.
+
+@item @code{port} (default: @code{80}) (type: number)
+Port to listen on.
+
+@item @code{loglevel} (default: @code{5}) (type: number)
+Log level to output logs, possible values: @code{0} to @code{7}.
+
+@item @code{lualibs} (default: @code{"all"}) (type: string)
+See
+@uref{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.
+
+@item @code{script-acl} (default: @code{("+127.0.0.1")}) (type: 
comma-separated-string-list)
+ACL to access the myMPD script backend.
+
+@item @code{ssl?} (default: @code{#f}) (type: boolean)
+SSL/TLS support
+
+@item @code{ssl-port} (default: @code{443}) (type: number)
+Port to listen for HTTPS.
+
+@item @code{ssl-cert} (type: maybe-string)
+Path to PEM encoded X.509 SSL/TLS certificate (public key).
+
+@item @code{ssl-key} (type: maybe-string)
+Path to PEM encoded SSL/TLS private key.
+
+@end table
+
+@end deftp
+@c end auto-generated
+
 
 @node Virtualization Services
 @subsection Virtualization Services
diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
index c60053f33c..a793bf253a 100644
--- a/gnu/services/audio.scm
+++ b/gnu/services/audio.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Bruno Victal <mirai@makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,6 +22,7 @@
 (define-module (gnu services audio)
   #:use-module (guix gexp)
   #:use-module (gnu services)
+  #:use-module (gnu services configuration)
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages admin)
@@ -28,11 +30,15 @@ (define-module (gnu services audio)
   #:use-module (guix records)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
   #:export (mpd-output
             mpd-output?
             mpd-configuration
             mpd-configuration?
-            mpd-service-type))
+            mpd-service-type
+
+            mympd-service-type
+            mympd-configuration))
 
 ;;; Commentary:
 ;;;
@@ -197,3 +203,169 @@ (define mpd-service-type
           (service-extension activation-service-type
                              mpd-service-activation)))
    (default-value (mpd-configuration))))
+
+
+(define (comma-separated-string-list? value)
+  (and (list? value)
+       (and-map (lambda (x)
+                  (and (string? x) (not (string-index x #\,))))
+                value)))
+
+(define mympd-field-to-env
+  (match-lambda
+    ('acl "MYMPD_ACL")
+    ('covercache-ttl "MYMPD_COVERCACHE_KEEP_DAYS")
+    ('host "MYMPD_HTTP_HOST")
+    ('port "MYMPD_HTTP_PORT")
+    ('loglevel "MYMPD_LOGLEVEL")
+    ('lualibs "MYMPD_LUALIBS")
+    ('script-acl "MYMPD_SCRIPTACL")
+    ('ssl? "MYMPD_SSL")
+    ('ssl-port "MYMPD_SSL_PORT")
+    ('ssl-cert "MYMPD_SSL_CERT")
+    ('ssl-key "MYMPD_SSL_KEY")))
+
+(define (mympd-serialize-string field-name value)
+  (string-join (list (mympd-field-to-env field-name) value) "="))
+
+(define (mympd-serialize-number field-name value)
+  (mympd-serialize-string field-name (number->string value)))
+
+(define (mympd-serialize-boolean field-name value)
+  (mympd-serialize-string field-name (if value "true" "false")))
+
+(define (mympd-serialize-comma-separated-string-list field-name value)
+  (mympd-serialize-string field-name (string-join value ",")))
+
+(define (mympd-serialize-configuration config fields)
+  (remove string-null?
+          (map (lambda (field)
+                ((configuration-field-serializer field)
+                 (configuration-field-name field)
+                 ((configuration-field-getter field) config)))
+               (filter-configuration-fields fields
+                                            '(package user group 
work-directory cache-directory)
+                                            #t))))
+
+(define-maybe string (prefix mympd-))
+(define-maybe comma-separated-string-list
+  (prefix mympd-))
+
+(define-configuration mympd-configuration
+  (package
+    (file-like mympd)
+    "The package object of the myMPD server."
+    empty-serializer)
+  (user
+   (string "mympd")
+   "Owner of the @code{mympd} process."
+   empty-serializer)
+  (group
+   (string "nogroup")
+   "Owner's group of the @code{mympd} process."
+   empty-serializer)
+  (work-directory
+   (string "/var/lib/mympd")
+   "Where myMPD will store its data."
+   empty-serializer)
+  (cache-directory
+   (string "/var/cache/mympd")
+   "Where myMPD will store its cache."
+   empty-serializer)
+  (acl
+   maybe-comma-separated-string-list
+   "ACL to access the myMPD webserver. See 
@uref{https://jcorporation.github.io/myMPD/configuration/acl,myMPD ACL} for 
syntax.")
+  (covercache-ttl
+   (number 31)
+   "How long to keep cached covers. Setting to @code{0} disables caching.")
+  (host
+   (string "[::]")
+   "Host name to listen on.")
+  (port
+   (number 80)
+   "Port to listen on.")
+  (loglevel
+   (number 5)
+   "Log level to output logs, possible values: @code{0} to @code{7}.")
+  (lualibs
+   (string "all")
+   "See 
@url{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.";)
+  (script-acl
+   (comma-separated-string-list '("+127.0.0.1"))
+   "ACL to access the myMPD script backend.")
+  (ssl?
+   (boolean #f)
+   "SSL/TLS support")
+  (ssl-port
+   (number 443)
+   "Port to listen for HTTPS.")
+  (ssl-cert
+   maybe-string
+   "Path to PEM encoded X.509 SSL/TLS certificate (public key).")
+  (ssl-key
+   maybe-string
+   "Path to PEM encoded SSL/TLS private key.")
+  (prefix mympd-))
+
+
+(define (mympd-activation config)
+  (match-record config <mympd-configuration> (user work-directory 
cache-directory)
+   #~(begin
+       (use-modules (guix build utils))
+
+       (let* ((pw (getpwnam #$user))
+              (uid (passwd:uid pw))
+              (gid (passwd:gid pw)))
+         (for-each (lambda (dir)
+                     (mkdir-p dir)
+                     (chown dir uid gid))
+                   (list #$work-directory #$cache-directory)))
+
+       ;; remove stale config
+       (let ((config-directory #$(string-append work-directory "/config")))
+         (when (file-exists? config-directory)
+          (delete-file-recursively config-directory))))))
+
+
+(define (mympd-shepherd-service config)
+  (match-record config <mympd-configuration>
+               (user
+                work-directory
+                cache-directory)
+   (shepherd-service
+    (documentation "Run the myMPD daemon.")
+    (requirement '(loopback user-processes))
+    (provision '(mympd))
+    (start #~(make-forkexec-constructor
+             (list #$(file-append mympd "/bin/mympd")
+                   "--user" #$user
+                   "--workdir" #$work-directory
+                   "--cachedir" #$cache-directory)
+             #:environment-variables '#$(mympd-serialize-configuration config
+                                                                       
mympd-configuration-fields)
+              #:log-file "/var/log/mympd.log"))
+    (stop #~(make-kill-destructor)))))
+
+(define (mympd-accounts config)
+  (match-record config <mympd-configuration> (user group)
+                (list (user-group (name group)
+                                  (system? #t))
+                      (user-account (name user)
+                                    (group group)
+                                    (system? #t)
+                                    (comment "myMPD user")
+                                    (home-directory "/var/empty")
+                                    (shell (file-append shadow 
"/sbin/nologin"))))))
+
+(define mympd-service-type
+  (service-type
+   (name 'mympd)
+   (extensions
+    (list  (service-extension shepherd-root-service-type
+                             (compose list mympd-shepherd-service))
+           (service-extension account-service-type
+                              mympd-accounts)
+           (service-extension activation-service-type
+                              mympd-activation)))
+   (description "Run myMPD, a frontend for MPD. (Music Player Daemon)")
+   (default-value (mympd-configuration))))
diff --git a/gnu/tests/audio.scm b/gnu/tests/audio.scm
index 8aa6d1e818..701496ee23 100644
--- a/gnu/tests/audio.scm
+++ b/gnu/tests/audio.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Peter Mikkelsen <petermikkelsen10@gmail.com>
+;;; Copyright © 2022 Bruno Victal <mirai@makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,9 +23,11 @@ (define-module (gnu tests audio)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services audio)
+  #:use-module (gnu services networking)
   #:use-module (gnu packages mpd)
   #:use-module (guix gexp)
-  #:export (%test-mpd))
+  #:export (%test-mpd
+            %test-mympd))
 
 (define %mpd-os
   (simple-operating-system
@@ -76,3 +79,52 @@ (define %test-mpd
    (name "mpd")
    (description "Test that the mpd can run and be connected to.")
    (value (run-mpd-test))))
+
+
+(define (run-mympd-test)
+  (define os (marionette-operating-system
+              (simple-operating-system (service dhcp-client-service-type)
+                                       (service mympd-service-type))
+              #:imported-modules '((gnu services herd))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '((8080 . 80)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-64)
+                       (srfi srfi-8)
+                       (web client)
+                       (web response)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "mympd")
+          (test-assert "service is running"
+            (marionette-eval '(begin
+                                (use-modules (gnu services herd))
+
+                                (start-service 'mympd))
+                             marionette))
+
+          (test-assert "HTTP port ready"
+            (wait-for-tcp-port 80 marionette))
+
+          (test-equal "http-head"
+            200
+            (receive (x _) (http-head "http://localhost:8080";) (response-code 
x)))
+
+          (test-end))))
+  (gexp->derivation "mympd-test" test))
+
+(define %test-mympd
+  (system-test
+   (name "mympd")
+   (description "Connect to a running myMPD service.")
+   (value (run-mympd-test))))
-- 
2.38.1