;;; GNU Guix --- Functional package management for GNU
;;; 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.
;;;
;;; 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 (gnu services audio)
  #:use-module (guix gexp)
  #:use-module (gnu services)
  #:use-module (gnu services admin)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages mpd)
  #:use-module (guix records)
  #:use-module (ice-9 match)
  #:use-module (ice-9 format)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:export (mpd-output
            mpd-output?
            mpd-configuration
            mpd-configuration?
            mpd-service-type

            mympd-service-type
            mympd-configuration
            mympd-configuration?
            mympd-configuration-package
            mympd-configuration-shepherd-requirement
            mympd-configuration-user
            mympd-configuration-group
            mympd-configuration-work-directory
            mympd-configuration-cache-directory
            mympd-configuration-acl
            mympd-configuration-covercache-ttl
            mympd-configuration-http?
            mympd-configuration-host
            mympd-configuration-port
            mympd-configuration-log-level
            mympd-configuration-log-to
            mympd-configuration-lualibs
            mympd-configuration-script-acl
            mympd-configuration-ssl?
            mympd-configuration-ssl-port
            mympd-configuration-ssl-cert
            mympd-configuration-ssl-key
            mympd-configuration-pin-hash
            ip-acl
            ip-acl?
            ip-acl-allow
            ip-acl-deny))

;;; Commentary:
;;;
;;; Audio related services
;;;
;;; Code:

(define-record-type* <mpd-output>
  mpd-output make-mpd-output
  mpd-output?
  (type          mpd-output-type
                 (default "pulse"))
  (name          mpd-output-name
                 (default "MPD"))
  (enabled?      mpd-output-enabled?
                 (default #t))
  (tags?         mpd-output-tags?
                 (default #t))
  (always-on?    mpd-output-always-on?
                 (default #f))
  (mixer-type    mpd-output-mixer-type
                 ;; valid: hardware, software, null, none
                 (default #f))
  (extra-options mpd-output-extra-options
                 (default '())))

(define-record-type* <mpd-configuration>
  mpd-configuration make-mpd-configuration
  mpd-configuration?
  (user         mpd-configuration-user
                (default "mpd"))
  (music-dir    mpd-configuration-music-dir
                (default "~/Music"))
  (playlist-dir mpd-configuration-playlist-dir
                (default "~/.mpd/playlists"))
  (db-file      mpd-configuration-db-file
                (default "~/.mpd/tag_cache"))
  (state-file   mpd-configuration-state-file
                (default "~/.mpd/state"))
  (sticker-file mpd-configuration-sticker-file
                (default "~/.mpd/sticker.sql"))
  (port         mpd-configuration-port
                (default "6600"))
  (address      mpd-configuration-address
                (default "any"))
  (outputs      mpd-configuration-outputs
                (default (list (mpd-output)))))

(define (mpd-output->string output)
  "Convert the OUTPUT of type <mpd-output> to a configuration file snippet."
  (let ((extra (string-join
                (map (match-lambda
                       ((key . value)
                        (format #f "  ~a \"~a\""
                                (string-map
                                 (lambda (c) (if (char=? c #\-) #\_ c))
                                 (symbol->string key))
                                value)))
                     (mpd-output-extra-options output))
                "\n")))
    (format #f "\
audio_output {
  type \"~a\"
  name \"~a\"
~:[  enabled \"no\"~%~;~]\
~:[  tags \"no\"~%~;~]\
~:[~;  always_on \"yes\"~%~]\
~@[  mixer_type \"~a\"~%~]\
~a~%}~%"
            (mpd-output-type output)
            (mpd-output-name output)
            (mpd-output-enabled? output)
            (mpd-output-tags? output)
            (mpd-output-always-on? output)
            (mpd-output-mixer-type output)
            extra)))

(define (mpd-config->file config)
  (apply
   mixed-text-file "mpd.conf"
   "pid_file \"" (mpd-file-name config "pid") "\"\n"
   (append (map mpd-output->string
                (mpd-configuration-outputs config))
           (map (match-lambda
                  ((config-name config-val)
                   (string-append config-name " \"" (config-val config) "\"\n")))
                `(("user" ,mpd-configuration-user)
                  ("music_directory" ,mpd-configuration-music-dir)
                  ("playlist_directory" ,mpd-configuration-playlist-dir)
                  ("db_file" ,mpd-configuration-db-file)
                  ("state_file" ,mpd-configuration-state-file)
                  ("sticker_file" ,mpd-configuration-sticker-file)
                  ("port" ,mpd-configuration-port)
                  ("bind_to_address" ,mpd-configuration-address))))))

(define (mpd-file-name config file)
  "Return a path in /var/run/mpd/ that is writable
   by @code{user} from @code{config}."
  (string-append "/var/run/mpd/"
                 (mpd-configuration-user config)
                 "/" file))

(define (mpd-shepherd-service config)
  (shepherd-service
   (documentation "Run the MPD (Music Player Daemon)")
   (requirement '(user-processes))
   (provision '(mpd))
   (start #~(make-forkexec-constructor
             (list #$(file-append mpd "/bin/mpd")
                   "--no-daemon"
                   #$(mpd-config->file config))
             #:environment-variables
             ;; Required to detect PulseAudio when run under a user account.
             (list (string-append
                    "XDG_RUNTIME_DIR=/run/user/"
                    (number->string
                     (passwd:uid
                      (getpwnam #$(mpd-configuration-user config))))))
             #:log-file #$(mpd-file-name config "log")))
   (stop  #~(make-kill-destructor))))

(define (mpd-service-activation config)
  (with-imported-modules '((guix build utils))
    #~(begin
        (use-modules (guix build utils))
        (define %user
          (getpw #$(mpd-configuration-user config)))

        (let ((directory #$(mpd-file-name config ".mpd")))
          (mkdir-p directory)
          (chown directory (passwd:uid %user) (passwd:gid %user))

          ;; Make /var/run/mpd/USER user-owned as well.
          (chown (dirname directory)
                 (passwd:uid %user) (passwd:gid %user))))))


(define %mpd-accounts
  ;; Default account and group for MPD.
  (list (user-group (name "mpd") (system? #t))
        (user-account
         (name "mpd")
         (group "mpd")
         (system? #t)
         (comment "Music Player Daemon (MPD) user")

         ;; Note: /var/run/mpd hosts one sub-directory per user, of which
         ;; /var/run/mpd/mpd corresponds to the "mpd" user.
         (home-directory "/var/run/mpd/mpd")

         (shell (file-append shadow "/sbin/nologin")))))

(define mpd-service-type
  (service-type
   (name 'mpd)
   (description "Run the Music Player Daemon (MPD).")
   (extensions
    (list (service-extension shepherd-root-service-type
                             (compose list mpd-shepherd-service))
          (service-extension account-service-type
                             (const %mpd-accounts))
          (service-extension activation-service-type
                             mpd-service-activation)))
   (default-value (mpd-configuration))))

\f
;;;
;;; myMPD
;;;

(define list-of-symbol?
  (list-of symbol?))

(define list-of-string?
  (list-of string?))

(define (port? n)
  (and (integer? n)
       (<= 0 n 65535)))

(define (string-or-symbol? x)
  (or (symbol? x) (string? x)))

(define-configuration/no-serialization ip-acl
  (allow
   (list-of-string '())
   "Allowed IP addresses.")

  (deny
   (list-of-string '())
   "Disallowed IP addresses."))

(define-maybe/no-serialization port)
(define-maybe/no-serialization integer)
(define-maybe/no-serialization string)
(define-maybe/no-serialization ip-acl)

;; XXX: The serialization procedures are insufficient since we require
;; access to multiple fields at once.
;; Fields marked with empty-serializer are never serialized and are
;; used for command-line arguments or by the service definition.
(define-configuration/no-serialization mympd-configuration
  (package
    (file-like mympd)
    "The package object of the myMPD server."
    empty-serializer)

  (shepherd-requirement
   (list-of-symbol '())
   "This is a list of symbols naming Shepherd services that this service
will depend on."
   empty-serializer)

  (user
   (string "mympd")
   "Owner of the @command{mympd} process."
   empty-serializer)

  (group
   (string "nogroup")
   "Owner group of the @command{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-ip-acl
   "ACL to access the myMPD webserver. See
@uref{https://jcorporation.github.io/myMPD/configuration/acl,myMPD ACL}
for syntax.")

  (covercache-ttl
   (maybe-integer 31)
   "How long to keep cached covers, @code{0} disables cover caching.")

  (http?
   (boolean #t)
   "HTTP support.")

  (host
   (string "[::]")
   "Host name to listen on.")

  (port
   (maybe-port 80)
   "HTTP port to listen on.")

  (log-level
   (integer 5)
   "How much detail to include in logs, possible values: @code{0} to @code{7}.")

  (log-to
   (string-or-symbol "/var/log/mympd/log")
   "Where to send logs. By default, the service logs to
@file{/var/log/mympd.log}. The alternative is @code{'syslog}, which
sends output to the running syslog service under the @samp{daemon} facility."
   empty-serializer)

  (lualibs
   (maybe-string "all")
   "See
@url{https://jcorporation.github.io/myMPD/scripting/#lua-standard-libraries}.")

  (script-acl
   (maybe-ip-acl (ip-acl
                  (allow '("127.0.0.1"))))
   "ACL to access the myMPD script backend.")

  (ssl?
   (boolean #f)
   "SSL/TLS support.")

  (ssl-port
   (maybe-port 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.")

  (pin-hash
   maybe-string
   "SHA-256 hashed pin used by myMPD to control settings access by
prompting a pin from the user."))

(define (mympd-serialize-configuration config)
  (define serialize-value
    (match-lambda
      ((? boolean? val) (if val "true" "false"))
      ((or (? port? val) (? integer? val)) (number->string val))
      ((? ip-acl? val) (ip-acl-serialize-configuration val))
      ((? string? val) val)))

  (define (ip-acl-serialize-configuration config)
    (define (serialize-list-of-string prefix lst)
      (map (cut format #f "~a~a" prefix <>) lst))
    (string-join
     (append
      (serialize-list-of-string "+" (ip-acl-allow config))
      (serialize-list-of-string "-" (ip-acl-deny config))) ","))

  ;; myMPD configuration fields are serialized as individual files under
  ;; <work-directory>/config/.
  (match-record config <mympd-configuration> (work-directory acl
                                              covercache-ttl http? host port
                                              log-level lualibs script-acl
                                              ssl? ssl-port ssl-cert ssl-key
                                              pin-hash)
    (define (serialize-field filename value)
      (when (maybe-value-set? value)
        (list (format #f "~a/config/~a" work-directory filename)
              (mixed-text-file filename (serialize-value value)))))

    (let ((filename-to-field `(("acl" . ,acl)
                               ("covercache_keep_days" . ,covercache-ttl)
                               ("http"                 . ,http?)
                               ("http_host"            . ,host)
                               ("http_port"            . ,port)
                               ("loglevel"             . ,log-level)
                               ("lualibs"              . ,lualibs)
                               ("scriptacl"            . ,script-acl)
                               ("ssl"                  . ,ssl?)
                               ("ssl_port"             . ,ssl-port)
                               ("ssl_cert"             . ,ssl-cert)
                               ("ssl_key"              . ,ssl-key)
                               ("pin_hash"             . ,pin-hash))))
      (filter list?
              (generic-serialize-alist list serialize-field
                                       filename-to-field)))))

(define (mympd-shepherd-service config)
  (match-record config <mympd-configuration> (package shepherd-requirement
                                              user work-directory
                                              cache-directory log-level log-to)
    (let ((log-level* (format #f "MYMPD_LOGLEVEL=~a" log-level)))
      (shepherd-service
       (documentation "Run the myMPD daemon.")
       (requirement `(loopback user-processes ,@shepherd-requirement))
       (provision '(mympd))
       (start #~(begin
                  (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)))

                  (make-forkexec-constructor
                   `(#$(file-append package "/bin/mympd")
                     "--user" #$user
                     #$@(if (eqv? log-to 'syslog) '("--syslog") '())
                     "--workdir" #$work-directory
                     "--cachedir" #$cache-directory)
                   #:environment-variables (list #$log-level*)
                   #:log-file #$(if (string? log-to) log-to #f))))
       (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-log-rotation config)
  (match-record config <mympd-configuration> (log-to)
    (if (string? log-to)
        (list (log-rotation
               (files (list log-to))))
        '())))

(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 special-files-service-type
                              mympd-serialize-configuration)
           (service-extension rottlog-service-type
                              mympd-log-rotation)))
   (description "Run myMPD, a frontend for MPD. (Music Player Daemon)")
   (default-value (mympd-configuration))))