;;; This module is licensed under the same terms, those of the GNU GPL
;;; version 3 or (at your option) any later version.
;;;
;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>

(define-module (email)
  #:use-module ((guix build utils) #:select (dump-port))
  #:use-module (guix base64)
  #:use-module (rnrs io ports)
  #:use-module (rnrs bytevectors)
  #:use-module (mailutils mailutils)
  #:export (compose-message
            send-message))

;; This variable is looked up by 'mu-message-send', uh!
(define-public mu-debug 0)

(define* (insert-newlines str #:optional (line-length 76))
  "Insert newlines in STR every LINE-LENGTH characters."
  (let loop ((result '())
             (str str))
    (if (string-null? str)
        (string-concatenate-reverse result)
        (let* ((length (min (string-length str) line-length))
               (prefix (string-take str length))
               (suffix (string-drop str length)))
          (loop (cons (string-append prefix "\n") result)
                suffix)))))

(define* (compose-message from to
                          #:key text subject file)
  "Compose a message, and return a message object."
  (let* ((mime    (mu-mime-create))
         (message (mu-message-create))
         (body    (mu-message-get-port message "w")))
    (mu-message-set-header message
                           "Content-Type"
                           "text/plain; charset=utf-8")

    (put-bytevector body (string->utf8 text))
    (close-port body)
    (mu-mime-add-part mime message)

    (when file
      (let* ((attach (mu-message-create))
             (port   (mu-message-get-port attach "w")))
        (display (insert-newlines
                  (base64-encode (call-with-input-file file
                                   get-bytevector-all)))
                 port)
        (close-port port)
        (mu-message-set-header attach
                               "Content-Transfer-Encoding"
                               "base64")
        (mu-message-set-header attach
                               "Content-Type" "image/jpeg")
        (mu-message-set-header attach
                               "Content-Disposition" "inline")
        (mu-mime-add-part mime attach)))

    (let ((result (mu-mime-get-message mime)))
      (mu-message-set-header result "From" from)
      (mu-message-set-header result "To" to)
      (when subject
        (mu-message-set-header result "Subject" subject))
      result)))

(define (display-body message)                    ;debug
  (let ((port (mu-message-get-port message "r")))
    (dump-port port (current-error-port))
    (close-port port)))

(define (send-message message)
  "Send MESSAGE, a message returned by 'compose-message', using the SMTP
parameters found in ~/.config/smtp."
  (define uri
    ;; Something like "smtp://USER:SECRET@SERVER:PORT" (info "(mailutils)
    ;; SMTP Mailboxes").
    (call-with-input-file (string-append (getenv "HOME") "/.config/smtp")
      read))

  (mu-register-format "smtp")
  (mu-message-send message uri))