;;; 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 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)
  #:export (mpd-output
            mpd-output?
            mpd-configuration
            mpd-configuration?
            mpd-service-type

            mympd-service-type
            mympd-configuration))

;;; 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))))


(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))))