Adding (naive) email templating to my servant-powered haskell web application

An in-depth look at adding naive email templating to my Haskell web application.


14 minute read

It’s pretty common for applications to have to send out emails, and applications in Haskell are no different. In most large applications I’ve worked on, this often means taking a template (with copy approved by management/UX designers/whatever), injecting it with data, and sending it to the user. In this post I’ll go into how I navigated extended bare SMTP functionality in an application I’ve been writing with template rendering/sending.

Note that since I’m going to be adding this functionality, I’m at a point in the application development where I already have a functioning Mailer component. At present all it’s doing is sending log messages (jury-rigged pagerduty), along with a message when the server starts up. While I won’t go into how the Mailer was made (maybe in a future blog post?), the API to the component is pretty straight forward and expressive so it should be obvious what’s happening.

Without much further ado, let’s get on to how I extended my Mailercomponent to handle reading, rendering, and and sending templates for emails from disk. The feature I’ll be adding that will be using this functionality will be password resetting.

Step 0: RTFM

As usual, the first step is to read whatever manuals/information I can find to get myself more familiar with the task I”m about to try and undertake. This time, that means spending a little time looking for templating packages for Haskell. I came across a few things:

I chose to go with HStringTemplate mostly for it’s simplicity and generality – it’s just going to template some text for me and spit it out. I spent some time reading the HStringTemplate documentation, in particular the text section.

For building this functionality, I’m going to do a front-to-back approach, meaning that I’m going to:

  1. Write the frontend endpoints
  2. Augment the mailer component
  3. Modify/migrate the database

Step 1: Write the routes that will do email things

I start by adding the routes that will do the email things:

--- ... other code ...
     :<|> "password-reset" :> "initiate" :> QueryParam "email" Email :> Post '[JSON] (EnvelopedResponse ())
     :<|> "password-reset" :> "complete" :> QueryParam "token" PasswordResetToken :> QueryParam "password" Password :> Post '[JSON] (EnvelopedResponse ())
--- ... other code ...

If you’re not familiar with Haskell’s Servant library, check it out, it’s pretty amazing and lets you build expressive routing trees like this – since it supports expressing your API as a type.

Then some initial handlers that are somewhat mocked out at this stage:

--- ... other code ...
     passwordResetInitiate :: Maybe Email -> WithApplicationGlobals Handler (EnvelopedResponse ())
     passwordResetInitiate Nothing        = throwError Err.genericBadRequest
     passwordResetInitiate (Just address) = getDBBackendAndMailer -- gets the components
                                            >>= \(backend, mailer) -> liftIO (createPasswordResetTokenForUser backend address) -- uses the DBBackend component component
                                            >>= ifNothingThrowError Err.failedToFindEntity
                                            >>= \((user,token)) -> liftIO (sendPasswordResetEmail mailer user token) -- uses the mailer component
                                            >> return $ EnvelopedResponse "success" "Password reset email sent" ()

     passwordResetComplete :: Maybe PasswordResetToken -> Maybe Password -> WithApplicationGlobals Handler (EnvelopedResponse ())
     passwordResetComplete Nothing      _              = throwError Err.genericBadRequest
     passwordResetComplete _            Nothing        = throwError Err.genericBadRequest
     passwordResetComplete (Just token) (Just newPass) = getDBBackendOrFail
                                                         >>= \backend -> liftIO (completePasswordReset backend token newPass)
                                                         >>= ifNothingThrowError (Err.enveloped (Err.makeGenericError "Failed to complete password request"))
                                                         >> return $ EnvelopedResponse "success" "Password reset completed" ()
--- ... other code ...

Note that functionslike createPasswordResetTokenForUser, completePasswordReset and sendPasswordResetEmail don’t exist yet on the components they’re being called on – I’m going to be adding them shortly. I’ve also noted this before but I prefer to bind (>>=) functionality together in a chain rather than with Haskell’s normal do notation. I find that it helps me to modularize the code, and think more modularly about what is happening to inputs/outputs.

Step 2: Extend the various components of the application

With the routes and handlers written it’s time to extend the various components that the app uses with some of the imaginary methods I was calling. This is the part where I write the code for methods like createPasswordResetTokenForUser and completePasswordReset, in their respective components.

Step 2.1: Extending the Mailer component

First thing I did was add a few of types as I was thinking about the problem very early on:

type TemplateName = String                                       -- newtype might be better here, but at the very least it's a little self-describing
data TemplateData = PasswordReset User Token deriving (Eq, Show) -- various TemplateData data types will contain the different data needed, here's an example of the data password reset template might need
type TemplateRegistry = HMS.HashMap String (TemplateData, ???)   -- note: HMS ==> Data.HashMap.Strict

The ??? type I use there has more to do with what HStringTemplate produces/works with so I just left it unknown for a little bit. Looking at the HStringTemplate Text documentation, I thought that the ??? type should be StringTemplate String, but it ended up being StringTemplate ByteString (which makes sense, given the various ways text can be represented).

Next, the endpoints that would be needed in the Mailer:

class Mailer m where
    -- ... other stuff ...

    --^ Email template related functionality
    getTemplateRegistry :: m -> TemplateRegistry
    hasTemplate :: TemplateName -> m -> Bool
    loadTemplates :: FilePath -> m -> IO ()
    renderTemplate :: TemplateName -> TemplateData -> m -> Maybe Mail
    sendRenderedTemplateEmail :: TemplateName -> TemplateData -> m -> IO ()

It turns out I don’t have to work too hard to load my templates from disk – there’s actually already a way to load templates from disk with HStringTemplate. Doing it the HStringTemplate way changes my expectation of being able to use a HMS.HashMap String (StringTemplate ByteString) – but I do get to some methods they’ve already provided that do what I wanted to do, for example, the implementation of hasTemplate changes from:

hasTemplate name = member name . getTemplateRegistry


hasTemplate name = isJust . getStringTemplate name . getTemplateRegistry

Not a huge deal but thought it was worth mentioning.

Here’s what the code that was added to the mailer component looks like:

instance Mailer MailerBackend where
    -- ... other code ...

    getTemplateRegistry (LocalMailer _ _ r) = r
    getTemplateRegistry (SMTPMailer _ _ r) = r

    hasTemplate name = isJust . getStringTemplate name . getTemplateRegistry
    getTemplate name = getStringTemplate name . getTemplateRegistry
    getTemplates names m = (`getTemplate` m) <$> names

    loadTemplates templateDir m = logMsg m INFO ("Loading templates from " <> show templateDir)
                                  >> try (directoryGroup templateDir)
                                  >>= either (logFailureAndReturn m) (pure . setTemplates m)
          logFailureAndReturn :: MailerBackend -> SomeException -> IO MailerBackend
          logFailureAndReturn s = (>> return s) . logMsg s INFO . ("Failed to load templates. Error: "<>) . show

    renderTemplate name templateData m = if templateMissing then Left (MissingTemplate (show templateNames)) else Right (map fromJust templates)
                                         >>= pure . listToTuple . map (render . setAttribs templateData)
          templateNames = [name <> ".html", name <> ".text"]
          templates = getTemplates templateNames m
          templateMissing = any isNothing templates
          listToTuple [x,y] = (x,y)

    sendRenderedTemplateEmail m sender recipient name templateData = pure (renderTemplate name templateData m)
                                                                     >>= errorIfLeft
                                                                     >>= makeMail
                                                                     >>= sendMail m
          senderAddr = Address Nothing sender
          recipientAddr = Address Nothing recipient
          makeMail (html, text) = let bodyText = DTL.fromStrict (decodeUtf8 text)
                                      bodyHTML = DTL.fromStrict (decodeUtf8 html)
                                      title = emailName templateData
                                  in simpleMail recipientAddr senderAddr title bodyText bodyHTML []

Most of it is pretty straight forward and pretty easy to read as well. Another utility I added was the ability to trigger an email template generation from the command line:

data SubCommand = PrintSwaggerJSON
                | MigrateBackend
                | PrintEmailTemplate String -- <----- new!
                | RunServer deriving (Eq, Show, Read)

instance Runnable SubCommand where
    -- ... other code ...
    run (PrintEmailTemplate name) = getDefaultOrEnvValue "Development" "ENVIRONMENT"
                                    >>= fmap appMailerConfig . getCurrentEnvConfig
                                    >>= startMailerBackend
                                    >>= ifNothingThrowError (MissingTemplate name) . getTemplate name
                                    >>= print . render
                                    >> return ()

A little long winded, but this addition allows me to write something like run PrintEmailTemplate <template name> in GHCi (or on the actual executable) and generate a single email – in the process testing whether email generation works at all. Here’s what one of the runs looked like (in GHCi):

*Main> run (PrintEmailTemplate "password-reset-completed.html")
[2017-11-23 23:49:23 JST : App.Mailer : INFO] Starting Mailer...
[2017-11-23 23:49:23 JST : App.Mailer : INFO] Connected to LocalMailer (No-op)
[2017-11-23 23:49:23 JST : App.Mailer : INFO] Loading templates from "infra/email/templates"
"<h1>Your password reset has been completed</h1>\n<p>If you've received this email in error (and you haven't completed a password reset), please contact immediately</p>\n\nHappy Hunting!\n<br/>\"

The output is kinda boring, but you get the idea – the email template was generated. More importantly, when I try one that doesn’t exist, the error is pretty obvvious:

*Main> run (PrintEmailTemplate "nope.html")
[2017-11-23 23:53:29 JST : App.Mailer : INFO] Starting Mailer...
[2017-11-23 23:53:29 JST : App.Mailer : INFO] Connected to LocalMailer (No-op)
[2017-11-23 23:53:29 JST : App.Mailer : INFO] Loading templates from "infra/email/templates"
*** Exception: The html and/or text templates are missing for the following templates: nope.html

Step 2.2: Extending the DBBackend (DAO) component

I have a component in my application that basically acts as a DAO and gives me a nicer interface to looking for things in the database – it’s a DatabaseBackend which I often shorten to DBBackend, and the only current implmenetation is SqliteBackend, for now.

I’ve added two new imaginary methods to that component, namely createPasswordResetTokenForUser and completePasswordReset. The underlying SQLite database also needs to be migrated to support the functionality that I’m adding to the DBBackend – this means creating a migration that will be run when the app starts up to move the database into the state it expects.

Before I got started writing the migration, I did need to spend a little time thinking about how I wanted to store the “tokens”. There are at least two options:

  • Randomly generated alphanumeric strings (ex. 303832c5ff5c4e92b3843f1d24537889)
  • JWTs (using the Web.JWT package)

JWTs seem like overkill, and I’m pretty lazy so I went with just creating a tokens table that holds a bunch of randomly generated alphanumeric strings (actually, UUIDs, because I’m lazy).

The table looks like:

CREATE TABLE IF NOT EXISTS tokens ( -- Holds tokens for any use
  type TEXT, -- Token type (haskell types: AuthToken, PasswordResetToken, etc)
  token TEXT, -- The token itself
  creatorId INTEGER REFERENCES users(id), -- creator of the token's user ID
  createdAt TEXT, -- creation time of the token
  expiresAt TEXT -- expiry time of the token

After creating the migration needed to get the actual database into the state I wanted, it was time to extend the SqliteBackend (DBBackend) component with some functions to make accessing and manipulating that data much easier:

instance DatabaseBackend SqliteBackend where
    -- ... other code ...

    createTokenForUser b uid tType = makeToken uid tType
                                     >>= \token -> maybe (return Nothing) (insertEntityAndGet_ token) (backendConn b)

    getTokenByContent b token = maybe (return Nothing) handle (backendConn b)
          handle = getRowBySimpleField_ DBQ.tokensTableName DBQ.tokensTokenFieldName token

    removeTokenByID b tokenId = maybe (return False) handle (backendConn b)
          handle = deleteRowBySimpleField_  DBQ.tokensTableName DBQ.genericIDField tokenId

    removeTokensByTypeForCreatorWithID b tokenType creatorId = maybe (return False) handle (backendConn b)
          deleteTokens c = S.withTransaction c (S.executeNamed c DBQ.deleteTokensOfTypeForCreator ["creatorId" S.:= creatorId, "tokenType" S.:= tokenType] >> S.changes c)
          handle = fmap (>0) . deleteTokens

    completePasswordReset b token newPass = maybe (return Nothing) handle (backendConn b)
          handle c = rightToMaybe <$> (try (updatePassword c) :: IO (Either DBBackendError (ModelWithID User)))
          updatePassword c = getTokenByContent b token
                             >>= ifNothingThrowError MissingEntity
                             -- Get the user associated to the token
                             >>= \token -> (getUserByID b . tCreatorId . model) token
                             >>= ifNothingThrowError MissingEntity
                             -- Update the password for the user
                             >>= \user -> updatePasswordForUser_ newPass c (Just user)
                             >> logMsg b INFO ("Successfully reset password for user with email "<> (show . mId) user)
                             -- Remove the token
                             >> removeTokensByTypeForCreatorWithID b PasswordResetToken (mId user)
                             >> pure user

The function names have changed a little bit, but the most important methods are still there – createTokenForUser and completePasswordReset – they’ll be the driving force behind most of the work that the handlers are trying to do.

You’ll note that in a bunch of these functions, I’m actually throwing Exceptions, and returning Maybe as. This is a pretty bad approach (maybe even an anti-pattern?) – rather than throwing exceptions, I should be returning an Either SomeException a, but for some twisted sense of consistency with the rest of the previous code, I haven’t completely switched to that better approach.

Step 2.3: The finished handlers

After adding the functionality to the DBBackend component, since some of the naming and functionality shifted from my initial vision, I needed to go back to the handlers and makes ome changes:

passwordResetInitiate :: Maybe Email -> WithApplicationGlobals Handler (EnvelopedResponse ())
passwordResetInitiate Nothing        = throwError Err.genericBadRequest
passwordResetInitiate (Just address) = getDBBackendAndMailer
                                       >>= \(backend, mailer) -> liftIO (getUserByEmail backend address)
                                       >>= ifNothingThrowIOError (Err.makeGenericError "failed to find user with given email address")
                                       >>= \(ModelWithID uid user) -> liftIO (createTokenForUser backend uid PasswordResetToken)
                                       >>= ifNothingThrowIOError (Err.makeGenericError "failed to create token")
                                       >>= liftIO . sendPasswordResetInitiatedEmail mailer user .  tToken . model
                                       >>= ifLeftConvertAndThrow
                                       >> return (EnvelopedResponse "success" "Password reset email sent" ())

passwordResetComplete :: Maybe PasswordResetToken -> Maybe Password -> WithApplicationGlobals Handler (EnvelopedResponse ())
passwordResetComplete Nothing      _              = throwError Err.genericBadRequest
passwordResetComplete _            Nothing        = throwError Err.genericBadRequest
passwordResetComplete (Just token) (Just newPass) = getDBBackendAndMailer
                                                    >>= \(backend, mailer) -> liftIO (completePasswordReset backend token newPass)
                                                    >>= ifNothingThrowIOError (Err.enveloped (Err.make404 "Failed to find reset password request"))
                                                    >>= liftIO . sendPasswordResetCompletedEmail mailer . model
                                                    >>= ifLeftConvertAndThrow
                                                    >> return (EnvelopedResponse "success" "Password reset completed" ())

The logic is a more involved (and likely could be much cleaner), but you still only need to hold about one line in your head at a time due to the modular nature of using >>= in this manner.

Step 3: Add some tests to make sure it all works

OK at this point, I’ve:

  1. Added the new endpoints ✔
  2. Modified/updated the Mailer component to do email template things (loading templates from disk, rendering a template) ✔
  3. Augmented the DBBackend component with some methods for dealing with tokens ✔

Now it’s time to add some basic tests to keep my paranoia in check. In particular, I’m going adding some integration tests on the DBBackend that make sure the added functionality works as I expect, in the “happy” path.

Step 3.1: Addding some basic integration tests

Here’s an excerpt from integration tests for the DBBackend component:

-- ... other tests/code ...

      describe "users" $ do
           -- ... other tests ...
           it "can create password reset tokens" $ \b -> addUser b testUser testUserPassword
                                                         >>= shouldBeSomething
                                                         >>= \(ModelWithID uid u) -> createTokenForUser b uid PasswordResetToken
                                                         >>= \token -> token `shouldNotBe` Nothing

           it "can retrieve tokens by the token value" $ \b -> addUser b testUser testUserPassword
                                                               >>= shouldBeSomething
                                                               >>= \(ModelWithID uid u) -> createTokenForUser b uid PasswordResetToken
                                                               >>= shouldBeSomething
                                                               >>= \(ModelWithID tid t) -> getTokenByContent b (tToken t)
                                                               >>= containsSomething

           it "can remove tokens by id" $ \b -> addUser b testUser testUserPassword
                                                >>= shouldBeSomething
                                                >>= \(ModelWithID uid u) -> createTokenForUser b uid PasswordResetToken
                                                >>= shouldBeSomething
                                                >>= \(ModelWithID tid t) -> getTokenByContent b (tToken t)
                                                >>= containsSomething
                                                >>  removeTokenByID b tid
                                                >>= \result -> result `shouldBe` True

The E2E tests for the Mailer component are actually kind of out of scope/lengthy to add here – I do my E2E testing from javascript (using tools like WebDriverIO) , so these tests basically involve running an API executable, doing email things, and watching the output, and waiting for the LocalMailer (implementation of the Mailer) to spit things out.

Wrapping up

Though the functionality added is pretty bare, it was fun to work through this problem in Haskell and see how it’s handled. I had the usual warm fuzzies working within the constraints of Haskell’s typesystem while writing the functionality, and am pretty happy with how the code turned out. Most importantly, it didn’t take me much time to write this implementation (since I was able to use HStringTemplate off the shelf, hats off to Sterling Clover, the maintainer of HStringTemplate).

In this day and age, it’s pretty common that apps be able to handle communicating with their users – I’ve seen functionality like this re-written many times (and at larger companies, tickets to improve the codebase that existed with things like batch sendingr). In the future, I’m absolutely going to make a easily deployable, self-hostable, standalone service that handles this for engineers so that they don’t have to rebuild this functionality every time they want more configurability/API access/control. While I don’t know if that service will be written in Haskell (why not?), exploring the problem as I have today will help if I do decide to write it in haskell.

Did you find this read beneficial? Send me questions/comments/clarifciations.
Want my expertise on your team/project? Send me interesting opportunities!