Jezen Thomas

Jezen Thomas

CTO & Co-Founder at Supercede. Haskell programmer. Writing about business and software engineering. Working from anywhere.

Stubbing I/O in Yesod

Here’s the scenario.

You’re writing a web application in Yesod. In one of your request handler functions, you need to run some IO action. This might be to make an HTTP request against an online weather service, or this might be to charge someone’s credit card, or even just to generate some random number.

Taking the latter as an example, imagine we want to generate a random number and then respond to the user’s request by reporting whether the randomly generated number is even or odd.

We might write code which looks like this.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Application where

import System.Random
import Yesod

data App = App

mkYesod "App" [parseRoutes|
/random RandomR GET

instance Yesod App

getRandomR :: Handler Value
getRandomR = do
  n <- liftIO randomNumber
  returnJson $ isEven n
    randomNumber :: IO Int
    randomNumber = randomRIO (1, 100)

    isEven :: Int -> String
    isEven n = if even n then "even" else "odd"

main :: IO ()
main = warp 3000 App

This is a complete Yesod application. We can run this locally and it will be listening for requests on port 3000. When we send requests there, we can see our application dutifully responding with whether or not the randomly generated number was even or odd.

$ curl http://localhost:3000/random

$ curl http://localhost:3000/random

This is all well and good, but how do we write an automated test for this? We can’t control the randomness of our pseudo-random number generator. Similarly, if instead of generating a random number this were an HTTP request to attempt to charge someone’s credit card with some payment provider, e.g., Stripe, then we wouldn’t be able to write a reliable automated test for this because we don’t control Stripe’s servers.

What we need to do is to stub out this IO action. This means that instead of running the real implementation during the test, we swap it out for a fake version that we can control.

One simple approach for this is with dependency injection.

Instead of defining our randomNumber function alongside our request handler, we can declare it as part of our application’s foundational data type.

data App = App
  { appRandomNumber :: IO Int

When we initialise our application, we construct our App value with the real implementation of our function.

main :: IO ()
main = warp 3000 $ App randomNumber
    randomNumber = -- real implementation

Since our randomNumber function is no longer defined alongside our request handler, we’ll now need to ask for that function from within the handler instead.

getRandomR :: Handler Value
getRandomR = do
  n <- liftIO =<< getsYesod appRandomNumber
  returnJson $ isEven n
    isEven :: Int -> String
    isEven n = -- …

This behaves exactly as it did before, but now we’re able to swap out our randomNumber function for a fake version in an automated test with testModifySite.

withApp :: SpecWith (TestApp App) -> Spec
withApp = before $ do
  pure (App randomNumber, id)

stub :: YesodDispatch a => (a -> a) -> YesodExample a ()
stub f = testModifySite (\app -> pure (f app, id))

spec :: Spec
spec = withApp $ do

  describe "GET /random" $ do

    it "works with even numbers" $ do
      stub (\a -> a { appRandomNumber = pure 66 })
      get RandomR
      statusIs 200
      bodyEquals "\"even\""

    it "works with odd numbers" $ do
      stub (\a -> a { appRandomNumber = pure 17 })
      get RandomR
      statusIs 200
      bodyEquals "\"odd\""

Of course, the usual warnings apply. There are problems that come along with stubbing out functions — if your stub doesn’t accurately reflect what that function actually does, then your test is only giving you false confidence.

People often say that stubbing is bad and that you shouldn’t do it. I don’t think this advice is useful. Yes, your tests and application logic should be pure as far as you can help it. But sometimes you really do need a stub.

A working example of this approach is available here.

Haskell Pattern: Design for Qualified Imports

When you’re writing library code, design for qualified imports.

Let’s say we’re writing a module which is concerned with parsing email addresses. Inside this Email module, a function named parseEmail would be carrying more context in its name than is necessary. The name parse would be sufficient.

When applying our parsing function in some other module, the name needs to be more descriptive so that it is more obvious what kind of thing the parsing function parses.

We also might need to disambiguate this parsing function from another parsing function that may be in scope.

Email.parseEmail is redundant.

parseEmail makes it hard to know where the function is defined.

Email.parse is easy to read.

Email.parse makes it clear what kind of thing we’re parsing.

Email.parse makes it clear where that function is defined.

import Acme.Email qualified as Email -- exports `parse`, not `parseEmail`

main :: IO ()
main = print $ Email.parse "[email protected]"

The module describes the context we’re in. Sometimes we need to make that context clearer, and sometimes the context is already clear enough.

Yesod Forms, Newtypes, and Smart Constructors

Say we’re writing a web application, and we’re modelling a login form.

If the types in your system are primitive, you don’t need to do much to parse them from values outside your system boundary, i.e., those submitted by a user through a web form.

It’s easy enough to use a textField for each field in our login form.

-- Assume this type synonym exists for all examples in this article
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)

-- A login form with a single field
data LoginForm = LoginForm
  { loginFormEmail :: Text

loginForm :: Form LoginForm
loginForm extra =  do
  email <- mreq textField "" Nothing
  pure (LoginForm <$> fst email, $(widgetFile "login"))

No surprises here.

With Newtypes

What if our types aren’t exactly Text values, but are some kind of equivalent type? For example, what if we’re representing our email value with a newtype which wraps the underlying text value?

In Yesod, a Field cannot be a functor so it’s not obvious how to reuse a textField and make it produce an Email value instead.

Fortunately, Yesod’s form library provides convertField to handle this case. You apply this function to a couple of functions for converting to and from your newtype, and a form field you wish to wrap.

newtype Email = Email { unEmail :: Text }

data LoginForm = LoginForm
  { loginFormEmail :: Email

loginForm :: Form LoginForm
loginForm extra =  do
  email <- mreq (convertField Email unEmail textField) "" Nothing
  pure (LoginForm <$> fst email, $(widgetFile "login"))

With Smart Constructors

Newtype wrappers are better than working directly with primitive types, but by themselves they don’t provide a great deal of type safety because the wrapped data isn’t any more constrained than when it’s unwrapped.

To solve that, we would reach for a smart constructor.

-- Explicitly exclude the value constructor
module Email (Email, unEmail, email) where

-- The newtype wrapper without a record field
newtype Email = Email Text

-- Unwrap the newtype
unEmail :: Email -> Text
unEmail (Email email) = email

-- The smart constructor
email :: Text -> Maybe Email
email t
  | "@" `isInfixOf` t = Just (Email t)
  | otherwise = Nothing

What if we’re using the smart constructor pattern and our newtypes can’t be naïvely constructed? We can’t use convertField because the types won’t line up.

Again, Yesod conveniently provides checkMMap for transforming some existing field into one that both performs validation and converts the datatype. This way we can use our smart constructor in the field directly instead of having to define validation rules in two places.

This function wants to ultimately produce an Either msg b but our smart constructor only produces a Maybe b. We can use the note function to promote it and provide a friendly error message.

module Main where

import Email

data LoginForm = LoginForm
  { loginFormEmail :: Email

loginForm :: Form LoginForm
loginForm extra = do
  email <-
    let msg = asText "Invalid email"
        checkEmail = pure . note msg . email
     in mreq (checkMMap checkEmail unEmail textField) "" Nothing
  pure (LoginForm <$> fst email, $(widgetFile "login"))

Since checkMMap runs in the Handler monad, you can also run IO actions or database transactions as part of the validation step. For example, you could query the database and check that the email address you’re trying to log in with actually exists.

If you want a little more assurance, it might be worth writing a property-based test which asserts that your functions to convert to and from your newtype successfully roundtrip.

Yesod’s form library is actually pretty powerful and satisying. It could perhaps do with more examples of what good looks like, and hopefully this short article helps. I’ve found that my code is generally neater when I’m able to manage parsing/validation together at the web form level.