services: Add home-goimapnotify-service-type.

* doc/guix.texi (Mail Home Services): Document
'home-goimapnotify-service-type' and 'home-goimapnotify-configuration'.
* gnu/home/services/mail.scm (camelize-field-name)
(goimapnotify-serialize-field, goimapnotify-serialize-boolean): New procedure.
(field-name-mapping): New parameter.
(goimapnotify-tls-options-configuration): New configuration.
(goimapnotify-serialize-string, goimapnotify-serialize-maybe-string)
(goimapnotify-serialize-string-or-gexp): New procedure.
(goimapnotify-serialize-maybe-string-or-gexp): New maybe type.
* gnu/home/services/mail.scm (goimapnotify-box-configuration): New
configuration.
(serialize-goimapnotify-tls-options-configuration): New maybe type.
(goimapnotify-tls-options-configuration): New configuration.:(list-of-goimapnotify-boxes-configurations?):
New procedure.
(serialize-list-of-goimapnotify-boxes-configurations): New configuration.
(goimapnotify-configuration): New configuration.
(serialize-goimapnotify-configuration)::(list-of-goimapnotify-configurations?)
(serialize-list-of-goimapnotify-configurations): New procedure.
(home-goimapnotify-configuration): New configuration.
(home-goimapnotify-shepherd-service): New service.
(home-goimapnotify-service-type): New service type.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Merges: #10104

2 files changed, 423 insertions, 1 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index f19cb4f1ee6..555fd082471 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -55455,7 +55455,10 @@ Extra content to add to the end of @file{~/.config/alsa/asoundrc}.
 The @code{(gnu home services mail)} module provides services that help
 you set up the tools to work with emails in your home environment.
 
+@subsubheading MSMTP Service
 @cindex msmtp
+@cindex mail configuration, for outgoing mail
+
 @uref{https://marlam.de/msmtp, MSMTP} is a @acronym{SMTP, Simple Mail
 Transfer Protocol} client.  It sends mail to a predefined SMTP server
 that takes care of proper delivery.
@@ -55584,6 +55587,172 @@ format.
 
 @c %end of fragment
 
+@subsubheading Goimapnotify Service
+@cindex IMAP notifications
+
+@defvar home-goimapnotify-service-type
+This is the type of the service that runs
+@uref{https://gitlab.com/shackra/goimapnotify, Goimapnotify}, a
+command-line application to execute scripts on IMAP mailbox changes
+using @uref{https://www.rfc-editor.org/info/rfc2177, IDLE}.  Its value
+is a @code{home-goimapnotify-configuration} object.
+@end defvar
+
+Here is a snippet of the service with an example configuration that you
+could add to the @code{services} field of your @code{home-environment}:
+
+@lisp
+(service home-goimapnotify-service-type
+         (home-goimapnotify-configuration
+          (configurations
+           (list
+            (goimapnotify-configuration
+             (host "imap.example.com")
+             (tls? #t)
+             (tls-options
+              (goimapnotify-tls-options-configuration
+               (reject-unauthorized? #t)))
+             (user-name "alice@@example.com")
+             (password-command
+              #~(string-append #$(file-append libsecret "/bin/secret-tool")
+                               " lookup user alice@@example.com"))
+             (boxes
+              (list
+               (goimapnotify-box-configuration
+                (mailbox "Inbox")
+                (on-new-mail
+                 #~(string-append #$(file-append isync "/bin/mbsync")
+                                  " alice"))
+                (on-new-mail-post
+                 #~(string-append #$(file-append notmuch "/bin/notmuch")
+                                  " new"))))))))))
+@end lisp
+
+@c %start of fragment
+
+@deftp {Data Type} home-goimapnotify-configuration
+Available @code{home-goimapnotify-configuration} fields are:
+
+@table @asis
+@item @code{goimapnotify} (default: @code{goimapnotify}) (type: file-like)
+The @code{goimapnotify} package to use.
+
+@item @code{configurations} (type: list-of-goimapnotify-configurations)
+A list of @code{goimapnotify-configuration} records which contain
+information about all your accounts configurations.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} goimapnotify-configuration
+Available @code{goimapnotify-configuration} fields are:
+
+@table @asis
+@item @code{host} (type: string)
+The IMAP server hostname.
+
+@item @code{host-command} (type: maybe-string-or-gexp)
+Command to retrieve the IMAP server hostname.
+
+@item @code{port} (default: @code{993}) (type: integer)
+The port that the IMAP server listens on.
+
+@item @code{tls?} (default: @code{#f}) (type: boolean)
+Enable or disable TLS.
+
+@item @code{tls-options} (type: maybe-goimapnotify-tls-options-configuration)
+TLS options for the IMAP connection.
+
+@item @code{idle-logout-timeout} (type: maybe-integer)
+The idle logout timeout in minutes.
+
+@item @code{user-name} (type: maybe-string)
+The user-name for authentication.
+
+@item @code{user-name-command} (type: maybe-string-or-gexp)
+Command to retrieve the user-name.
+
+@item @code{alias} (type: maybe-string)
+An alias for the account.
+
+@item @code{password} (type: maybe-string)
+The password for authentication.
+
+@item @code{password-command} (type: maybe-string-or-gexp)
+Command to retrieve the password.
+
+@item @code{xo-auth2?} (default: @code{#f}) (type: boolean)
+Enable or disable XOAUTH2 authentication.
+
+@item @code{boxes} (type: list-of-goimapnotify-boxes-configurations)
+The mailboxes to monitor.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} goimapnotify-box-configuration
+Available @code{goimapnotify-box-configuration} fields are:
+
+@table @asis
+@item @code{mailbox} (type: string)
+The mailbox to monitor.
+
+@item @code{on-new-mail} (type: maybe-string-or-gexp)
+Command to execute when new mail arrives.
+
+@item @code{on-new-mail-post} (type: maybe-string-or-gexp)
+Command to execute after the new-mail command.
+
+@item @code{on-changed-mail} (type: maybe-string-or-gexp)
+Command to execute when mail is changed.
+
+@item @code{on-changed-mail-post} (type: maybe-string-or-gexp)
+Command to execute after the changed-mail command.
+
+@item @code{on-deleted-mail} (type: maybe-string-or-gexp)
+Command to execute when mail is deleted.
+
+@item @code{on-deleted-mail-post} (type: maybe-string-or-gexp)
+Command to execute after the deleted-mail command.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} goimapnotify-tls-options-configuration
+Available @code{goimapnotify-tls-options-configuration} fields are:
+
+@table @asis
+@item @code{reject-unauthorized?} (default: @code{#f}) (type: boolean)
+Whether to reject unauthorized TLS certificates.
+
+@item @code{starttls?} (default: @code{#f}) (type: boolean)
+Whether to use STARTTLS.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
 @node Messaging Home Services
 @subsection Messaging Home Services
 
diff --git a/gnu/home/services/mail.scm b/gnu/home/services/mail.scm
index 78d614dc842..78a2ec3c520 100644
--- a/gnu/home/services/mail.scm
+++ b/gnu/home/services/mail.scm
@@ -17,12 +17,14 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu home services mail)
+  #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
   #:use-module (gnu home services)
   #:use-module (gnu home services shepherd)
   #:use-module (gnu packages mail)
+  #:use-module (ice-9 match)
   #:use-module (ice-9 string-fun)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -47,7 +49,13 @@
             msmtp-configuration-extra-content
             msmtp-account
             msmtp-account-name
-            msmtp-account-configuration))
+            msmtp-account-configuration
+
+            goimapnotify-tls-options-configuration
+            goimapnotify-box-configuration
+            goimapnotify-configuration
+            home-goimapnotify-configuration
+            home-goimapnotify-service-type))
 
 (define (string-or-gexp? obj)
   (or (string? obj)
@@ -228,3 +236,248 @@ format."
                 (description "Configure msmtp, a simple
 @acronym{SMTP, Simple Mail Transfer Protocol} client that can relay email
 to SMTP servers.")))
+
+
+;;; Goimapnotify.
+
+;; Mapping used by 'camelize-field-name' to handle certain symbols specially.
+(define field-name-mapping
+  (make-parameter '()))
+
+(define (camelize-field-name field-name)
+  (let* ((str (symbol->string (or (assq-ref (field-name-mapping) field-name)
+                                  field-name)))
+         (words (string-split (if (string-suffix? "?" str)
+                                  (string-drop-right str 1)
+                                  str)
+                              #\-)))
+    (match words
+      ((head . tail)
+       (string-concatenate (cons* head
+                                  (map string-capitalize tail)))))))
+
+(define (goimapnotify-serialize-field field-name val)
+  (parameterize ((field-name-mapping
+                  '((host-command . hostCmd)
+                    (user-name . username)
+                    (user-name-command . usernameCmd)
+                    (password-command . passwordCmd))))
+    #~(format #f "~a: ~s\n"
+              #$(camelize-field-name field-name)
+              #$val)))
+
+(define (goimapnotify-serialize-boolean field-name val)
+  (goimapnotify-serialize-field field-name (if val ''true ''false)))
+
+(define-configuration goimapnotify-tls-options-configuration
+  (reject-unauthorized?
+   (boolean #f)
+   "Whether to reject unauthorized TLS certificates.")
+
+  (starttls?
+   (boolean #f)
+   "Whether to use STARTTLS.")
+
+  (prefix goimapnotify-))
+
+;; XXX: The 'define-maybe' macros of the MSMTP configuration already define
+;; the maybe types, so we just need to define the extra serializers.
+
+(define (goimapnotify-serialize-string field-name val)
+  (goimapnotify-serialize-field field-name val))
+
+(define (goimapnotify-serialize-maybe-string field-name val)
+  (if (maybe-value-set? val)
+      (goimapnotify-serialize-string field-name val)
+      ""))
+
+(define goimapnotify-serialize-string-or-gexp
+  goimapnotify-serialize-string)
+
+(define (goimapnotify-serialize-maybe-string-or-gexp field-name val)
+  (if (and (maybe-value-set? val)
+           (string-or-gexp? val))
+      (goimapnotify-serialize-string-or-gexp field-name val)
+      ""))
+
+(define-configuration goimapnotify-box-configuration
+  (mailbox
+   string
+   "The mailbox to monitor.")
+
+  (on-new-mail
+   maybe-string-or-gexp
+   "Command to execute when new mail arrives.")
+
+  (on-new-mail-post
+   maybe-string-or-gexp
+   "Command to execute after the new-mail command.")
+
+  (on-changed-mail
+   maybe-string-or-gexp
+   "Command to execute when mail is changed.")
+
+  (on-changed-mail-post
+   maybe-string-or-gexp
+   "Command to execute after the changed-mail command.")
+
+  (on-deleted-mail
+   maybe-string-or-gexp
+   "Command to execute when mail is deleted.")
+
+  (on-deleted-mail-post
+   maybe-string-or-gexp
+   "Command to execute after the deleted-mail command.")
+
+  (prefix goimapnotify-))
+
+(define (goimapnotify-serialize-integer field-name val)
+  (goimapnotify-serialize-field field-name val))
+
+(define (goimapnotify-serialize-maybe-integer field-name val)
+  (if (maybe-value-set? val)
+      (goimapnotify-serialize-integer field-name val)
+      ""))
+
+(define (serialize-goimapnotify-tls-options-configuration field-name val)
+  (serialize-configuration val goimapnotify-tls-options-configuration-fields))
+
+(define-maybe goimapnotify-tls-options-configuration)
+
+(define (list-of-goimapnotify-boxes-configurations? lst)
+  (and (not (null? lst))
+       (every goimapnotify-box-configuration? lst)))
+
+(define (serialize-list-of-goimapnotify-boxes-configurations field-name value)
+  (let ((serializations (cons 'list
+                              (map (cut serialize-configuration <>
+                                        goimapnotify-box-configuration-fields)
+                                   value))))
+    #~(begin
+        (use-modules (ice-9 format) (ice-9 string-fun))
+        (format #f "~a:
+~{  - ~a~%~}"
+                '#$field-name
+                (map (lambda (s)
+                       (string-replace-substring s "\n" "\n    "))
+                     #$serializations)))))
+
+(define-configuration goimapnotify-configuration
+  (host
+   string
+   "The IMAP server hostname.")
+
+  (host-command
+   maybe-string-or-gexp
+   "Command to retrieve the IMAP server hostname.")
+
+  (port
+   (integer 993)
+   "The port that the IMAP server listens on.")
+
+  (tls?
+   (boolean #f)
+   "Enable or disable TLS.")
+
+  (tls-options
+   maybe-goimapnotify-tls-options-configuration
+   "TLS options for the IMAP connection."
+   (serializer serialize-maybe-goimapnotify-tls-options-configuration))
+
+  (idle-logout-timeout
+   maybe-integer
+   "The idle logout timeout in minutes.")
+
+  (user-name
+   maybe-string
+   "The user-name for authentication.")
+
+  (user-name-command
+   maybe-string-or-gexp
+   "Command to retrieve the user-name.")
+
+  (alias
+   maybe-string
+   "An alias for the account.")
+
+  (password
+   maybe-string
+   "The password for authentication.")
+
+  (password-command
+   maybe-string-or-gexp
+   "Command to retrieve the password.")
+
+  (xo-auth2?
+   (boolean #f)
+   "Enable or disable XOAUTH2 authentication.")
+
+  (boxes
+   list-of-goimapnotify-boxes-configurations
+   "The mailboxes to monitor."
+   (serializer serialize-list-of-goimapnotify-boxes-configurations))
+
+  (prefix goimapnotify-))
+
+;; Serialize virtualhosts and components last.
+(define (serialize-goimapnotify-configuration config)
+  (define (boxes? field)
+    (eq? (configuration-field-name field) 'boxes))
+  (let ((rest (filter boxes? goimapnotify-configuration-fields)))
+    #~(string-append #$(serialize-configuration config rest)
+                     #$(serialize-list-of-goimapnotify-boxes-configurations
+                          'boxes
+                          (goimapnotify-configuration-boxes config)))))
+
+(define (list-of-goimapnotify-configurations? lst)
+  (every goimapnotify-configuration? lst))
+
+(define (serialize-list-of-goimapnotify-configurations field-name value)
+  (let ((serializations (cons 'list
+                              (map (cut serialize-configuration <>
+                                        goimapnotify-configuration-fields)
+                                   value))))
+    #~(begin
+        (use-modules (ice-9 format) (ice-9 string-fun))
+        (format #f "~a:
+~{  - ~a~%~}"
+                '#$field-name
+                (map (lambda (s)
+                       (string-replace-substring s "\n" "\n    "))
+                     #$serializations)))))
+
+(define-configuration home-goimapnotify-configuration
+  (goimapnotify
+   (file-like goimapnotify)
+   "The @code{goimapnotify} package to use."
+   empty-serializer)
+  (configurations
+   (list-of-goimapnotify-configurations)
+   "List of @code{goimapnotify-configuration} records which contain
+information about all your accounts configurations."))
+
+(define (home-goimapnotify-shepherd-service config)
+  (let ((log-file #~(string-append %user-log-dir "/goimapnotify.log")))
+    (list
+     (shepherd-service
+       (provision '(goimapnotify))
+       (modules '((shepherd support)))   ;for '%user-log-dir'
+       (documentation "Run a goimapnotify process")
+       (start #~(make-forkexec-constructor
+                 (list
+                  #$(file-append
+                     (home-goimapnotify-configuration-goimapnotify config)
+                     "/bin/goimapnotify")
+                  "-conf" #$(mixed-text-file "goimapnotify.yaml"
+                                             (serialize-configuration config
+                                                                      home-goimapnotify-configuration-fields)))
+                 #:log-file #$log-file))
+       (stop #~(make-kill-destructor))))))
+
+(define home-goimapnotify-service-type
+  (service-type
+    (name 'home-goimapnotify)
+    (extensions
+     (list (service-extension home-shepherd-service-type
+                              home-goimapnotify-shepherd-service)))
+    (description "Configures the @code{goimapnotify} IMAP mailbox notifier.")))