;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Simon Streit <simon@netpanic.org>
;;;
;;; This file is NOT 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 (services wsdd)

  #:use-module (gnu packages)
  #:use-module (gnu packages base)
  #:use-module (gnu packages admin)

  #:use-module (gnu services)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu services base)
  #:use-module (gnu system shadow)

  #:use-module (guix gexp)
  #:use-module (guix packages)
  #:use-module (guix modules)
  #:use-module (guix records)

  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:use-module (ice-9 textual-ports)
  #:use-module (srfi srfi-1)

  #:use-module (siguix packages wsdd)   ;temp!

  #:export (wsdd-service
            wsdd-service-type
            wsdd-configuration
            wsdd-configuration?
            wsdd-configuration-package
            wsdd-configuration-ipv4only?
            wsdd-configuration-ipv6only?
            wsdd-configuration-chroot
            wsdd-configuration-hoplimit
            wsdd-configuration-interface
            wsdd-configuration-uuid-device
            wsdd-configuration-domain
            wsdd-configuration-hostname
            wsdd-configuration-preserve-case?
            wsdd-configuration-workgroup))

;;;
;;; WSDD
;;;

(define-record-type* <wsdd-configuration>
  wsdd-configuration
  make-wsdd-configuration
  wsdd-configuration?
  (package               wsdd-configuration-package
                         (default wsdd))
  (ipv4only?             wsdd-configuration-ipv4only?
                         (default #f))
  (ipv6only?             wsdd-configuration-ipv6only?
                         (default #f))
  (chroot                wsdd-configuration-chroot
                         (default #f))
  (hoplimit              wsdd-configuration-hoplimit
                         (default 1))
  (interface             wsdd-configuration-interface
                         (default #f))
  (uuid-device           wsdd-configuration-uuid-device
                         (default #f))
  (domain                wsdd-configuration-domain
                         (default #f))
  (hostname              wsdd-configuration-hostname
                         (default #f))
  (preserve-case?        wsdd-configuration-preserve-case?
                         (default #f))
  (workgroup             wsdd-configuration-workgroup
                         (default "WORKGROUP")))

(define wsdd-accounts
  (list
   (user-group (name "wsdd"))
   (user-account (name "wsdd")
                 (group "wsdd")
                 (comment "Web Service Discovery user")
                 (home-directory "/var/empty")
                 (shell (file-append shadow "/sbin/nologin")))))

(define wsdd-shepherd-service
  (match-lambda
    (($ <wsdd-configuration> package
                             ipv4only?
                             ipv6only?
                             chroot
                             hoplimit
                             interface
                             uuid-device
                             domain
                             hostname
                             preserve-case?
                             workgroup
                             )
     (list (shepherd-service
            (documentation "Run a Web Service Discovery service")
            (provision '(wsdd))
            (requirement '(networking))
            (start #~(make-forkexec-constructor
                      (list #$(file-append package "/bin/wsdd")
                            #$@(if ipv4only?
                                   #~("--ipv4only")
                                   '())
                            #$@(if ipv6only?
                                   #~("--ipv6only")
                                   '())
                            #$@(if chroot
                                   #~("--chroot" #$chroot)
                                   '())
                            #$@(if hoplimit
                                   #~("--hoplimit" #$(number->string hoplimit))
                                   '())

                            ;; FIXME, this results into wrong type applied.
                            ;; #$(if interface
                            ;;       #~(for-each (lambda (arg)
                            ;;                     (display (string-append "--interface" arg))
                            ;;                     ;; (format #t "--interface ~a " (list->string arg))
                            ;;                     )
                            ;;                   #$(interface))
                            ;;       '())

                            #$@(if interface ;to be replaced by procedure above
                                   #~("--interface" #$interface)
                                   '())

                            #$@(if uuid-device
                                   #~("--uuid" #$uuid-device)
                                   '())
                            #$@(if domain
                                   #~("--domain" #$domain)
                                   '())
                            #$@(if hostname
                                   #~("--hostname" #$hostname)
                                   '())
                            #$@(if preserve-case?
                                   #~("--preserve-case")
                                   '())
                            #$@(if workgroup
                                   #~("--workgroup" #$workgroup)
                                   '()))
                      #:user "wsdd"
                      #:group "wsdd"
                      #:log-file "/var/log/wsdd.log"))
            (stop #~(make-kill-destructor)))))))

(define wsdd-service-type
  (service-type
   (name 'wsdd)
   (description "Web Service Discovery Daemon")
   (extensions
    (list (service-extension shepherd-root-service-type
                             wsdd-shepherd-service)
          (service-extension account-service-type
                             (const wsdd-accounts))))
   (default-value (wsdd-configuration))))