;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
;;; Copyright © 2017 Christopher Baines <mail@cbaines.net>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Julien Lepiller <julien@lepiller.eu>
;;; Copyright © 2019 Robert Vollmert <rob@vllmrt.net>
;;; Copyright © 2020 Marius Bakke <marius@gnu.org>
;;; Copyright © 2021 David Larsson <david.larsson@selfhosted.xyz>
;;;
;;; 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 databases)
  #:use-module (gnu services)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system shadow)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages databases)
  #:use-module (guix build-system trivial)
  #:use-module (guix build union)
  #:use-module (guix deprecation)
  #:use-module (guix modules)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 match)
  #:export (postgresql-config-file
            postgresql-config-file?
            postgresql-config-file-log-destination
            postgresql-config-file-hba-file
            <pre>
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020-2024 Ludovic Courtès &lt;ludo@gnu.org&gt;
;;; Copyright © 2020, 2023, 2024 Janneke Nieuwenhuizen &lt;janneke@gnu.org&gt;
;;;
;;; 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 &lt;http://www.gnu.org/licenses/&gt;.

(define-module (gnu system hurd)
  #:use-module (ice-9 match)
  #:use-module (guix gexp)
  #:use-module (guix profiles)
  #:use-module (guix utils)
  #:use-module (gnu bootloader)
  #:use-module (gnu bootloader grub)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages base)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages certs)
  #:use-module (gnu packages compression)
  #:use-module (gnu packages cross-base)
  #:use-module (gnu packages file)
  #:use-module (gnu packages gawk)
  #:use-module (gnu packages guile)
  #:use-module (gnu packages guile-xyz)
  #:use-module (gnu packages hurd)
  #:use-module (gnu packages less)
  #:use-module (gnu packages linux)
  #:use-module (gnu packages texinfo)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services hurd)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system)
  #:use-module (gnu system setuid)
  #:use-module (gnu system shadow)
  #:use-module (gnu system vm)
  #:export (%base-packages/hurd
            %base-services/hurd
            %base-services+qemu-networking/hurd
            %desktop-services/hurd
            %hurd-default-operating-system
            %hurd-default-operating-system-kernel
            %hurd64-default-operating-system
            %hurd64-default-operating-system-kernel
            %setuid-programs/hurd))

;;; Commentary:
;;;
;;; This module provides system-specifics for the GNU/Hurd operating system
;;; and virtual machine.
;;;
;;; Code:

(define %hurd-default-operating-system-kernel
  (if (system-hurd?)
      gnumach
      ;; A cross-built GNUmach does not work
      (with-parameters ((%current-system &quot;i686-linux&quot;)
                        (%current-target-system #f))
        gnumach)))

(define %hurd64-default-operating-system-kernel
  (if (system-hurd?)
      gnumach
      ;; A cross-built GNUmach does not work
      (with-parameters ((%current-system &quot;x86_64-linux&quot;)
                        (%current-target-system #f))
        gnumach)))

(define %base-packages/hurd
  ;; Note: the Shepherd comes before the Hurd, not just because its duty is to
  ;; shepherd the herd, but also because we want its &apos;halt&apos; and &apos;reboot&apos;
  ;; commands to take precedence.
  (list shepherd-1.0 hurd netdde bash coreutils file findutils grep sed
        diffutils patch gawk tar gzip bzip2 xz lzip
        guile-3.0-latest guile-colorized guile-readline
        net-base nss-certs inetutils less procps shadow sudo which
        info-reader))

(define %base-services/hurd
  (append (list (service hurd-console-service-type
                         (hurd-console-configuration (hurd hurd)))
                (service guix-service-type
                         (guix-configuration
                          (extra-options &apos;(&quot;--disable-chroot&quot;
                                           &quot;--disable-deduplication&quot;))))
                (service special-files-service-type
                         `((&quot;/bin/sh&quot; ,(file-append bash &quot;/bin/sh&quot;))
                           (&quot;/usr/bin/env&quot; ,(file-append coreutils
                                                         &quot;/bin/env&quot;))))
                (service syslog-service-type))
          (map (lambda (n)
                 (service hurd-getty-service-type
                          (hurd-getty-configuration
                           (tty (string-append &quot;tty&quot; (number-&gt;string n))))))
               (iota 6 1))))

(define %base-services+qemu-networking/hurd
  (cons
   (service static-networking-service-type
            (list %loopback-static-networking

                  ;; QEMU user-mode networking.  To get &quot;eth0&quot;, you need
                  ;; QEMU to emulate a device for which Mach has an
                  ;; in-kernel driver, for instance with:
                  ;; --device rtl8139,netdev=net0 --netdev user,id=net0
                  %qemu-static-networking))
   %base-services/hurd))

(define %desktop-services/hurd %base-services/hurd)

(define %setuid-programs/hurd
  ;; Default set of setuid-root programs.
  (map file-like-&gt;setuid-program
       (list (file-append shadow &quot;/bin/passwd&quot;)
             (file-append shadow &quot;/bin/sg&quot;)
             (file-append shadow &quot;/bin/su&quot;)
             (file-append shadow &quot;/bin/newgrp&quot;)
             (file-append shadow &quot;/bin/newuidmap&quot;)
             (file-append shadow &quot;/bin/newgidmap&quot;)
             (file-append sudo &quot;/bin/sudo&quot;)
             (file-append sudo &quot;/bin/sudoedit&quot;))))

(define %hurd-default-operating-system
  (operating-system
    (kernel %hurd-default-operating-system-kernel)
    (kernel-arguments &apos;())
    (hurd hurd)
    (bootloader (bootloader-configuration
                 (bootloader grub-minimal-bootloader)
                 (targets &apos;(&quot;/dev/vda&quot;))))
    (initrd #f)
    (initrd-modules &apos;())
    (firmware &apos;())
    (host-name &quot;guixygnu&quot;)
    (file-systems &apos;())
    (packages %base-packages/hurd)
    (timezone &quot;GNUrope&quot;)
    (locale-libcs (list glibc/hurd))
    (name-service-switch #f)
    (essential-services (hurd-default-essential-services this-operating-system))
    (privileged-programs &apos;())
    (setuid-programs %setuid-programs/hurd)))

(define %hurd64-default-operating-system
  (operating-system
    (inherit %hurd-default-operating-system)
    (kernel %hurd64-default-operating-system-kernel)))

</pre>
</div></div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
y)
               (mkdir-p socket-directory)
               (chown socket-directory (passwd:uid user) (passwd:gid user))))

           ;; Create the log directory.
           (when (string? #$log-directory)
             (mkdir-p #$log-directory)
             (chown #$log-directory (passwd:uid user) (passwd:gid user)))

           ;; Drop privileges and init state directory in a new
           ;; process.  Wait for it to finish before proceeding.
           (match (primitive-fork)
             (0
              ;; Exit with a non-zero status code if an exception is thrown.
              (dynamic-wind
                (const #t)
                (lambda ()
                  (setgid (passwd:gid user))
                  (setuid (passwd:uid user))
                  (primitive-exit
                   (apply system*
                          initdb
                          "-D"
                          #$data-directory
                          initdb-args)))
                (lambda ()
                  (primitive-exit 1))))
             (pid (waitpid pid))))))))

(define postgresql-shepherd-service
  (match-lambda
    (($ <postgresql-configuration> postgresql port locale config-file
                                   log-directory data-directory
                                   extension-packages)
     (let* ((pg_ctl-wrapper
             ;; Wrapper script that switches to the 'postgres' user before
             ;; launching daemon.
             (program-file
              "pg_ctl-wrapper"
              #~(begin
                  (use-modules (ice-9 match)
                               (ice-9 format))
                  (match (command-line)
                    ((_ mode)
                     (let ((user (getpwnam "postgres"))
                           (pg_ctl #$(file-append
                                      (final-postgresql postgresql
                                                        extension-packages)
                                                  "/bin/pg_ctl"))
                           (options (format #f "--config-file=~a -p ~d"
                                            #$config-file #$port)))
                       (setgid (passwd:gid user))
                       (setuid (passwd:uid user))
                       (execl pg_ctl pg_ctl "-D" #$data-directory
                              #$@(if (string? log-directory)
                                     (list "-l"
                                           (string-append log-directory
                                                          "/pg_ctl.log"))
                                     '())
                              "-o" options
                              mode)))))))
            (pid-file (in-vicinity data-directory "postmaster.pid"))
            (action (lambda args
                      #~(lambda _
                          (invoke #$pg_ctl-wrapper #$@args)
                          (match '#$args
                            (("start")
                             (call-with-input-file #$pid-file read))
                            (_ #t))))))
       (list (shepherd-service
              (provision '(postgres))
              (documentation "Run the PostgreSQL daemon.")
              (requirement '(user-processes loopback syslogd))
              (modules `((ice-9 match)
                         ,@%default-modules))
              (start (action "start"))
              (stop (action "stop"))))))))

(define postgresql-service-type
  (service-type
   (name 'postgresql)
   (extensions
    (list (service-extension shepherd-root-service-type
                             postgresql-shepherd-service)
          (service-extension activation-service-type
                             postgresql-activation)
          (service-extension account-service-type
                             (const %postgresql-accounts))
          (service-extension
           profile-service-type
           (compose list postgresql-configuration-postgresql))))
   (default-value (postgresql-configuration
                   (postgresql postgresql-10)))))

(define-deprecated (postgresql-service #:key (postgresql postgresql)
                                       (port 5432)
                                       (locale "en_US.utf8")
                                       (config-file (postgresql-config-file))
                                       (data-directory
                                        "/var/lib/postgresql/data")
                                       (extension-packages '()))
  postgresql-service-type
  "Return a service that runs @var{postgresql}, the PostgreSQL database
server.

The PostgreSQL daemon loads its runtime configuration from @var{config-file}
and stores the database cluster in @var{data-directory}."
  (service postgresql-service-type
           (postgresql-configuration
            (postgresql postgresql)
            (port port)
            (locale locale)
            (config-file config-file)
            (data-directory data-directory)
            (extension-packages extension-packages))))

(define-record-type* <postgresql-role>
  postgresql-role make-postgresql-role
  postgresql-role?
  (name             postgresql-role-name) ;string
  (permissions      postgresql-role-permissions
                    (default '(createdb login))) ;list
  (create-database? postgresql-role-create-database?  ;boolean
                    (default #f)))

(define-record-type* <postgresql-role-configuration>
  postgresql-role-configuration make-postgresql-role-configuration
  postgresql-role-configuration?
  (host             postgresql-role-configuration-host ;string
                    (default "/var/run/postgresql"))
  (log              postgresql-role-configuration-log ;string
                    (default "/var/log/postgresql_roles.log"))
  (roles            postgresql-role-configuration-roles
                    (default '()))) ;list

(define (postgresql-create-roles config)
  ;; See: https://www.postgresql.org/docs/current/sql-createrole.html for the
  ;; complete permissions list.
  (define (format-permissions permissions)
    (let ((dict '(bypassrls createdb createrole login replication superuser)))
      (string-join (filter-map (lambda (permission)
                                 (and (member permission dict)
                                      (string-upcase
                                       (symbol->string permission))))
                               permissions)
                   " ")))

  (define (roles->queries roles)
    (apply mixed-text-file "queries"
           (append-map
            (lambda (role)
              (match-record role <postgresql-role>
                (name permissions create-database?)
                `("SELECT NOT(EXISTS(SELECT 1 FROM pg_catalog.pg_roles WHERE \
rolname = '" ,name "')) as not_exists;\n"
"\\gset\n"
"\\if :not_exists\n"
"CREATE ROLE \"" ,name "\""
" WITH " ,(format-permissions permissions)
";\n"
,@(if create-database?
      `("CREATE DATABASE \"" ,name "\""
        " OWNER \"" ,name "\";\n")
      '())
"\\endif\n")))
            roles)))

  (let ((host (postgresql-role-configuration-host config))
        (roles (postgresql-role-configuration-roles config)))
    #~(let ((psql #$(file-append postgresql "/bin/psql")))
        (list psql "-a" "-h" #$host "-f" #$(roles->queries roles)))))

(define (postgresql-role-shepherd-service config)
  (match-record config <postgresql-role-configuration>
    (log)
    (list (shepherd-service
           (requirement '(postgres))
           (provision '(postgres-roles))
           (one-shot? #t)
           (start
            #~(lambda args
                (let ((pid (fork+exec-command
                            #$(postgresql-create-roles config)
                            #:user "postgres"
                            #:group "postgres"
                            #:log-file #$log)))
                  (zero? (cdr (waitpid pid))))))
           (documentation "Create PostgreSQL roles.")))))

(define postgresql-role-service-type
  (service-type (name 'postgresql-role)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          postgresql-role-shepherd-service)))
                (compose concatenate)
                (extend (lambda (config extended-roles)
                          (match-record config <postgresql-role-configuration>
                            (host roles)
                            (postgresql-role-configuration
                             (host host)
                             (roles (append roles extended-roles))))))
                (default-value (postgresql-role-configuration))
                (description "Ensure the specified PostgreSQL roles are
created after the PostgreSQL database is started.")))


;;;
;;; Memcached
;;;

(define-record-type* <memcached-configuration>
  memcached-configuration make-memcached-configuration
  memcached-configuration?
  (memcached          memcached-configuration-memcached ;file-like
                      (default memcached))
  (interfaces         memcached-configuration-interfaces
                      (default '("0.0.0.0")))
  (tcp-port           memcached-configuration-tcp-port
                      (default 11211))
  (udp-port           memcached-configuration-udp-port
                      (default 11211))
  (additional-options memcached-configuration-additional-options
                      (default '())))

(define %memcached-accounts
  (list (user-group (name "memcached") (system? #t))
        (user-account
         (name "memcached")
         (group "memcached")
         (system? #t)
         (comment "Memcached server user")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define memcached-activation
  #~(begin
      (use-modules (guix build utils))
      (let ((user (getpwnam "memcached")))
        (mkdir-p "/var/run/memcached")
        (chown "/var/run/memcached"
               (passwd:uid user) (passwd:gid user)))))

(define memcached-shepherd-service
  (match-lambda
    (($ <memcached-configuration> memcached interfaces tcp-port udp-port
                                  additional-options)
     (with-imported-modules (source-module-closure
                             '((gnu build shepherd)))
       (list (shepherd-service
              (provision '(memcached))
              (documentation "Run the Memcached daemon.")
              (requirement '(user-processes loopback))
              (modules '((gnu build shepherd)))
              (start #~(make-forkexec-constructor
                        `(#$(file-append memcached "/bin/memcached")
                          "-l" #$(string-join interfaces ",")
                          "-p" #$(number->string tcp-port)
                          "-U" #$(number->string udp-port)
                          "--daemon"
                          ;; Memcached changes to the memcached user prior to
                          ;; writing the pid file, so write it to a directory
                          ;; that memcached owns.
                          "-P" "/var/run/memcached/pid"
                          "-u" "memcached"
                          ,#$@additional-options)
                        #:log-file "/var/log/memcached"
                        #:pid-file "/var/run/memcached/pid"))
              (stop #~(make-kill-destructor))))))))

(define memcached-service-type
  (service-type (name 'memcached)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          memcached-shepherd-service)
                       (service-extension activation-service-type
                                          (const memcached-activation))
                       (service-extension account-service-type
                                          (const %memcached-accounts))))
                (default-value (memcached-configuration))))


;;;
;;; MySQL.
;;;

(define-record-type* <mysql-configuration>
  mysql-configuration make-mysql-configuration
  mysql-configuration?
  (mysql mysql-configuration-mysql (default mariadb))
  (bind-address mysql-configuration-bind-address (default "127.0.0.1"))
  (port mysql-configuration-port (default 3306))
  (socket mysql-configuration-socket (default "/run/mysqld/mysqld.sock"))
  (extra-content mysql-configuration-extra-content (default ""))
  (extra-environment mysql-configuration-extra-environment (default #~'()))
  (auto-upgrade? mysql-configuration-auto-upgrade? (default #t)))

(define %mysql-accounts
  (list (user-group
         (name "mysql")
         (system? #t))
        (user-account
         (name "mysql")
         (group "mysql")
         (system? #t)
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define mysql-configuration-file
  (match-lambda
    (($ <mysql-configuration> mysql bind-address port socket extra-content)
     (mixed-text-file "my.cnf" "[mysqld]
datadir=/var/lib/mysql
socket=" socket "
bind-address=" bind-address "
port=" (number->string port) "
" extra-content "
"))))

(define (%mysql-activation config)
  "Return an activation gexp for the MySQL or MariaDB database server."
  (let ((mysql  (mysql-configuration-mysql config))
        (my.cnf (mysql-configuration-file config)))
    #~(begin
        (use-modules (ice-9 popen)
                     (guix build utils))
        (let* ((mysqld  (string-append #$mysql "/bin/mysqld"))
               (user    (getpwnam "mysql"))
               (uid     (passwd:uid user))
               (gid     (passwd:gid user))
               (datadir "/var/lib/mysql")
               (rundir  "/run/mysqld"))
          (mkdir-p datadir)
          (chown datadir uid gid)
          (mkdir-p rundir)
          (chown rundir uid gid)
          ;; Initialize the database when it doesn't exist.
          (when (not (file-exists? (string-append datadir "/mysql")))
            (if (string-prefix? "mysql-" (strip-store-file-name #$mysql))
                ;; For MySQL.
                (system* mysqld
                         (string-append "--defaults-file=" #$my.cnf)
                         "--initialize"
                         "--user=mysql")
                ;; For MariaDB.
                ;; XXX: The 'mysql_install_db' script doesn't work directly
                ;;      due to missing 'mkdir' in PATH.
                (let ((p (open-pipe* OPEN_WRITE mysqld
                                     (string-append
                                      "--defaults-file=" #$my.cnf)
                                     "--bootstrap"
                                     "--user=mysql")))
                  ;; Create the system database, as does by 'mysql_install_db'.
                  (display "create database mysql;\n" p)
                  (display "use mysql;\n" p)
                  (for-each
                   (lambda (sql)
                     (call-with-input-file
                         (string-append #$mysql:lib "/share/mysql/" sql)
                       (lambda (in) (dump-port in p))))
                   '("mysql_system_tables.sql"
                     "mysql_performance_tables.sql"
                     "mysql_system_tables_data.sql"
                     "fill_help_tables.sql"))
                  ;; Remove the anonymous user and disable root access from
                  ;; remote machines, as does by 'mysql_secure_installation'.
                  (display "
DELETE FROM user WHERE User='';
DELETE FROM user WHERE User='root' AND
  Host NOT IN  ('localhost', '127.0.0.1', '::1');
FLUSH PRIVILEGES;
" p)
                  (close-pipe p))))))))

(define (mysql-shepherd-service config)
  (list (shepherd-service
         (provision '(mysql))
         (documentation "Run the MySQL server.")
         (start (let ((mysql  (mysql-configuration-mysql config))
                      (extra-env (mysql-configuration-extra-environment config))
                      (my.cnf (mysql-configuration-file config)))
                  #~(make-forkexec-constructor
                     (list (string-append #$mysql "/bin/mysqld")
                           (string-append "--defaults-file=" #$my.cnf))
                           #:user "mysql" #:group "mysql"
                           #:log-file "/var/log/mysqld.log"
                           #:environment-variables #$extra-env)))
         (stop #~(make-kill-destructor)))))

(define (mysql-upgrade-wrapper mysql socket-file)
  ;; The MySQL socket and PID file may appear before the server is ready to
  ;; accept connections.  Ensure the socket is responsive before attempting
  ;; to run the upgrade script.
  (program-file
   "mysql-upgrade-wrapper"
   #~(begin
       (let ((mysql-upgrade #$(file-append mysql "/bin/mysql_upgrade"))
             (timeout 10))
         (begin
           (let loop ((i 0))
             (catch 'system-error
               (lambda ()
                 (let ((sock (socket PF_UNIX SOCK_STREAM 0)))
                   (connect sock AF_UNIX #$socket-file)
                   (close-port sock)
                   ;; The socket is ready!
                   (execl mysql-upgrade mysql-upgrade
                          (string-append "--socket=" #$socket-file))))
               (lambda args
                 (if (< i timeout)
                     (begin
                       (sleep 1)
                       (loop (+ 1 i)))
                     ;; No luck, give up.
                     (throw 'timeout-error
                            "MySQL server did not appear in time!"))))))))))

(define (mysql-upgrade-shepherd-service config)
  (list (shepherd-service
         (provision '(mysql-upgrade))
         (requirement '(mysql))
         (one-shot? #t)
         (documentation "Upgrade MySQL database schemas.")
         (start (let ((mysql (mysql-configuration-mysql config))
                      (socket (mysql-configuration-socket config)))
                  #~(make-forkexec-constructor
                     (list #$(mysql-upgrade-wrapper mysql socket))
                     #:user "mysql" #:group "mysql"))))))

(define (mysql-shepherd-services config)
  (if (mysql-configuration-auto-upgrade? config)
      (append (mysql-shepherd-service config)
              (mysql-upgrade-shepherd-service config))
      (mysql-shepherd-service config)))

(define mysql-service-type
  (service-type
   (name 'mysql)
   (extensions
    (list (service-extension account-service-type
                             (const %mysql-accounts))
          (service-extension activation-service-type
                             %mysql-activation)
          (service-extension shepherd-root-service-type
                             mysql-shepherd-services)))
   (default-value (mysql-configuration))))

(define-deprecated (mysql-service #:key (config (mysql-configuration)))
  mysql-service-type
  (service mysql-service-type config))


;;;
;;; Redis
;;;

(define-record-type* <redis-configuration>
  redis-configuration make-redis-configuration
  redis-configuration?
  (redis             redis-configuration-redis ;file-like
                     (default redis))
  (bind              redis-configuration-bind
                     (default "127.0.0.1"))
  (port              redis-configuration-port
                     (default 6379))
  (working-directory redis-configuration-working-directory
                     (default "/var/lib/redis"))
  (config-file       redis-configuration-config-file
                     (default #f)))

(define (default-redis.conf bind port working-directory)
  (mixed-text-file "redis.conf"
                   "bind " bind "\n"
                   "port " (number->string port) "\n"
                   "dir " working-directory "\n"
                   "daemonize no\n"))

(define %redis-accounts
  (list (user-group (name "redis") (system? #t))
        (user-account
         (name "redis")
         (group "redis")
         (system? #t)
         (comment "Redis server user")
         (home-directory "/var/empty")
         (shell (file-append shadow "/sbin/nologin")))))

(define redis-activation
  (match-lambda
    (($ <redis-configuration> redis bind port working-directory config-file)
     #~(begin
         (use-modules (guix build utils)
                      (ice-9 match))

         (let ((user (getpwnam "redis")))
           (mkdir-p #$working-directory)
           (chown #$working-directory (passwd:uid user) (passwd:gid user)))))))

(define redis-shepherd-service
  (match-lambda
    (($ <redis-configuration> redis bind port working-directory config-file)
     (let ((config-file
            (or config-file
                (default-redis.conf bind port working-directory))))
       (list (shepherd-service
              (provision '(redis))
              (documentation "Run the Redis daemon.")
              (requirement '(user-processes syslogd))
              (start #~(make-forkexec-constructor
                        '(#$(file-append redis "/bin/redis-server")
                          #$config-file)
                        #:user "redis"
                        #:group "redis"))
              (stop #~(make-kill-destructor))))))))

(define redis-service-type
  (service-type (name 'redis)
                (extensions
                 (list (service-extension shepherd-root-service-type
                                          redis-shepherd-service)
                       (service-extension activation-service-type
                                          redis-activation)
                       (service-extension account-service-type
                                          (const %redis-accounts))))
                (default-value (redis-configuration))))