Sending invitations by email (18)

Now I want to invite people by email: when a person is added to the database, they should be sent an email with a link to complete their registration details (some of which - name - will have been filled in as part of entering the invitation information).

I'd like a function quite like sendTestEmail from the previous post, but to which I can pass a registration identifier. Once that works, it can be called from the end of the invitation form submission code, and potentially from other places (for example, in the real life version of this crap web form, there is an administrator link to re-send an invitation).

The bit that actually does the delivery, sendEmail, won't change. But we'll need to generate a Mail based on the selected Registration rather than using a fairly constant value.

First, here are a load of new imports to add to src/InvitationEmail.hs: we're going to be accessing the database and generating HTML emails with blaze, plus bits to stick them together. blaze-html also needs to be added in the library dependencies in package.yaml - it's only in the main executable dependencies at the moment.

+import Control.Exception (bracket)
import Control.Monad.IO.Class (liftIO)
import Data.Maybe (fromMaybe)
import Data.Monoid ( (<>) )
import Data.String (fromString)
import qualified Data.Text.Lazy as TL
import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.SOP as PGS
import qualified Text.Blaze.Html5 as B
import Text.Blaze.Html5 ( (!) )
import qualified Text.Blaze.Html5.Attributes as BA
import qualified Text.Blaze.Html.Renderer.Text as BT

import Registration

First let's get the configuration, and the relevant registration record:

sendInvitationEmail identifier = do
  c <- getConfig

  [r] <- liftIO $ bracket
    (PG.connectPostgreSQL "user='postgres'")
    PG.close
    $ \conn -> PGS.gselectFrom conn "registration where nonce = ?" [identifier]

... and now prepare some of the components we'll need to generate a Mail:

  let ub = urlbase c
  let url = ub <> "/registration/" <> identifier

  let fullname = T.pack $ firstname r ++ " " ++ lastname r
  let targetEmail = T.pack $
        fromMaybe
          (error $ "No email supplied for " ++ identifier)
          (email r)
  let subject = "Registration form for " <> fullname

I'd like to produce two forms of body text: a plain text version, and an HTML version with a clickable link. The plaintext version comes from simple string concatenation; the HTML version comes from rendering some blaze-html to a text value:

  let plaintext =
          "Hello.\n"
       <> "Please complete this registration form.\n"
       <> TL.pack url

  let htmltext = BT.renderHtml $ do
        B.p "Hello"
        B.p "Please complete this registration form.\n"
        B.p $ (B.a ! BA.href (fromString url)) (fromString url)

It would be nice if this text wasn't written out twice, and if there was more text in here I'd probably make more effort to abstract away the content (with yet another markup language or perhaps just a single paragraph read from elsewhere).

Now we can prepare a Mail to send - similar to the last post's Mail construction, but plugging in the appropriate values.

  let mail = M.Mail {
      M.mailFrom = M.Address { M.addressName = Just "Registration System"
                             , M.addressEmail = T.pack $ smtpFrom c
                             }
    , M.mailTo = [M.Address { M.addressName = Just fullname
                            , M.addressEmail = targetEmail
                            }
             ]
    , M.mailCc = []
    , M.mailBcc = []
    , M.mailHeaders = [("Subject", subject)]
    , M.mailParts = [[M.plainPart plaintext, M.htmlPart htmltext]]
    }

and finally we can send it:

  sendEmail mail

With that done, find doInvitation in app/Main.hs and right before the final return, add:

  sendInvitationEmail newNonce

Now try inviting yourself. Or your friends.

I'm frustrated in this post that there are so many kinds of string-like types used: General string types include String, Text, Text.Lazy, ByteString.Lazy; and there's a specialised AttributeValue used as the parameter of !. ++ works to concatenate String, and <> works to concatenate all of them, so I've used the latter for all of the types.

url is the only place where two different types are needed from the same value: so I form it as a String and use the polymorphic fromString to turn it into whatever is needed at the point of use.

Here's the commit for this post.

Next, I've noticed that there are quite a few places where the same bracket and connectPostgreSQL code is being used to open the database; so I'll pull that out so it is only written once; and maybe also tidy up a bit of database related error handling.