Tuesday, February 20, 2018

Sending an email (17)

There doesn't seem to be a clear answer about the best way to send email in Haskell in the way that there are (several) web frameworks around. But a bit of digging in Stack Overflow suggests HaskellNet-SSL and mime-mail can be put to good use.

For this post, you're going to need an outbound mail server, which I'm expecting to need to authenticate to in order to send emails. I have my own outbound server, but I think you can probably use gmail. The details for this will be specified using the configuration mechanism implemented in the last past.

In the config file config.yaml, add your own version of this with your own email address, and mail server details.

smtpFrom: "reg@cwfh28.example.com"
smtpServer: "smtp.example.com"
smtpPort: "587"
smtpUser: "your_user_id"
smtpPassword: "yourpass"

... and add the corresponding fields in src/Config.hs:

import qualified Network.Socket as N

data Config = Config {

...

  , smtpServer :: String
  , smtpPort :: N.PortNumber
  , smtpUser :: String
  , smtpPassword :: String

...

}

You'll need to add in some dependencies to package.yaml:

    - HaskellNet
    - HaskellNet-SSL
    - bytestring
    - mime-mail
    - network
    - text

... and if you try to compile now, you'll find that there is no FromJSON instance for port number, so smtpPort can't be deserialised from YAML.

Luckily we have src/Orphans.hs as a dumping ground for orphan instances, and so we can add (with suitable imports):

instance Y.FromJSON N.PortNumber
  where parseJSON v = read <$> Y.parseJSON v

... which combines the PortNumber Read instance with the String FromJSON instance. That's why the example smtpPort configuration snippet above uses double-quotes around 587.

With this configuration in place, we can now write some code to send an email. To begin with, it will just be a test sender, rather than anything directly related to registrations.

Add an API endpoint to trigger the sending of this test mail:

type MailTestAPI = "admin" :> "mailtest" :> S.Get '[SB.HTML] B.Html

type API = 
...
      :<|> MailTestAPI


server = ... :<|> handleMailTest

handleMailTest = 

handleMailTest :: Handler B.Html
handleMailTest = do
  liftIO $ sendTestMail
  return $ B.p "mail test sent"

All that will do is give us a new API endpoint - so loading http://localhost:8080/admin/mailtest will invoke sendMailTest, which isn't written yet.

So create a new module in src/InvitationEmail.hs and import it into app/Main.hs.

This module will need these prereqs:

{-# Language OverloadedStrings #-}
module InvitationEmail where

import qualified Network.Mail.Mime as M

import Config

sendTop then consists of two parts: first, constructing a Mail containing the email to send:

sendTestMail = do
  c <- getConfig
  sendEmail $
    M.Mail {
      M.mailFrom = M.Address { M.addressName = Just "Registration System"
                             , M.addressEmail = T.pack $ smtpFrom c
                             }
    , M.mailTo = [M.Address { M.addressName = Just "You"
                            , M.addressEmail = T.pack $ smtpFrom c
                            }
             ]
    , M.mailCc = []
    , M.mailBcc = []
    , M.mailHeaders = [("Subject", "Test registration invitation for you")]
    , M.mailParts = [[M.plainPart "HELLO"]]
    }

... and the second part, sendEmail, which knows how to send the supplied email:

import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as T
import qualified Network.HaskellNet.SMTP.SSL as SSL
import qualified Network.Mail.Mime as M

...
sendEmail :: M.Mail -> IO ()
sendEmail msg = do
  config <- getConfig

  rendered <- BSL.toStrict <$> M.renderMail' msg

  let sslSettings = SSL.defaultSettingsSMTPSTARTTLS
       { SSL.sslPort = smtpPort config,
         SSL.sslDisableCertificateValidation = True
       } 

  SSL.doSMTPSTARTTLSWithSettings
    (smtpServer config)
    sslSettings
    $ \connection -> do
      succeeded  <- SSL.authenticate SSL.LOGIN
                                     (smtpUser config)
                                     (smtpPassword config)
                                     connection
      if succeeded
      then
          SSL.sendMail (addressToText (M.mailFrom msg))
                       (map addressToText (M.mailTo msg))
                       rendered connection
      else error "Could not authenticate to SMTP server"

This basically builds a server config, renders the message into a strict bytestring, then runs an SMTP session which first authenticates using your specified username/password and then sends the message (to/from the same addresses as used in the mail body - in internet email, there are at least two different To/From addresses although it's common for them to match up).

Note that SSL turns off all certificate validation, because certificate validation is a ballache to configure, and always has been. Except for when it's hard-coded into your browser. That option is an annoying double negative Disable... = True which always makes me frown.

This code is also reading the configuration file in twice. That's inefficiently but not terribly so for the expected load, and it saves threading the config through the code either explicitly or in a ReaderT.

Anyway, now you should be able to start up the web server, load http://localhost:8080/admin/mailtest, wait a few seconds for stuff to happen, and get an invitation email in your inbox.

If you're trying to use gmail outbound servers, you probably need to Allow Less Secure Apps (such as the crap webform). I had to do that, and also had to use the base of my gmail address (without @gmail.com) as the username.

Next post, I'll make that email be sent as part of creating an invitation, and customise it to have the appropriate link to click on.

No comments:

Post a Comment