On Auth and Tests in Yesod

Unlike Rails, the Yesod ecosystem prefers external authentication mechanisms (BrowserId, OpenId, OAuth) over in-house solutions. One benefit is less risk of unknowingly using poor security practices since a third party is the one actually handling passwords and authentication. One problem is that testing authenticated routes becomes more difficult as you need to avoid interacting with that external service during tests.

In this post, I’ll go through two separate but related concepts around authentication in Yesod. First, I’ll outline adding authentication via GitHub using OAuth2. Then, I’ll show how we get around the issue of testing authenticated routes by conditionally adding a simpler authentication mechanism and using it during tests.

This post assumes a site scaffolded with yesod-bin 1.4.4. I’ll be relying on ClassyPrelude and _env-based AppSettings. If you’d like to see any of the code in its actual context, see our Carnival project.

`Yesod.Auth.OAuth2.Github`

GitHub-based authentication is provided by the yesod-auth-oauth2 package. To perform this authentication, we need to provide a Client ID and Secret. It’s a good practice to read these values from environment variables. Once these values are available, we only need to add oauth2Github to our authPlugins to make “Log in with GitHub” available on our site.

First, add a data type in Settings.hs to represent the keys:

data OAuthKeys = OAuthKeys
    { oauthKeysClientId :: Text
    , oauthKeysClientSecret :: Text
    }

Then, in Foundation.hs, add a new field to App for holding the values read at start-up:

data App = App
    { -- ...
    , -- ...
    , appGithubOAuthKeys :: OAuthKeys
    }

Finally, update Application.hs to read those values from the environment on start-up and set them in App. In Carnival, we also use LoadEnv.loadEnv to read variables out of a .env file and set them in the environment when developing.

import LoadEnv

makeFoundation :: AppSettings -> IO App
makeFoundation appSettings = do
    loadEnv

    -- ...

    appGithubOAuthKeys <- getOAuthKeys

    -- ...

  where
    getOAuthKeys :: IO OAuthKeys
    getOAuthKeys = OAuthKeys
        <$> getEnv "GITHUB_OAUTH_CLIENT_ID"
        <*> getEnv "GITHUB_OAUTH_CLIENT_SECRET"

Note: getEnv will raise an exception when the value is unset. If you’d prefer to handle that case differently, lookupEnv will return Maybe.

With access to the keys now available through App, add the oauth2Github plugin to your YesodAuth instance by updating Foundation.hs:

import Yesod.Auth.OAuth2.Github

instance YesodAuth App where
    -- ...

    authPlugins m =
        [ -- ...
        , -- ...
        , oauth2Github
            (oauthKeysClientId $ appGithubOAuthKeys m)
            (oauthKeysClientSecret $ appGithubOAuthKeys m)
        ]

Things should work at this point, but with the following caveats:

Your users’ GitHub user ids will be their userIdents

This is fine as long as GitHub is the only authentication plugin in use. If you have others, you may see collisions.

The scaffolded getAuthId definition doesn’t do anything with credsExtra.

The GitHub plugin provides some useful profile data (e.g. name, email, etc) in the credsExtra map, it would be good to copy that information onto the user record in your database.

Extra Credit

To address both of the above caveats, we can make two more changes. First, add a plugin field to our User model:

User
    name Text
    email Text
    plugin Text
    ident Text
    UniqueUser plugin ident
    deriving Eq Show Typeable

Then add the following definition for getAuthId:

instance YesodAuth App where
    -- ...

    getAuthId creds@Creds{..} = runDB $ do
        -- Try to find an existing user
        muser <- getBy $ UniqueUser credsPlugin credsIdent

        -- Create or update a user based on the Creds. This will return Nothing
        -- if there was no profile information in creds, or Just the new or
        -- updated user's Id
        muserId <- mapM upsertUser $ credsToUser creds

        -- return the new or existing user's Id. If we didn't find an existing
        -- user and we were unable to create one, return Nothing
        return $ muserId <|> (entityKey <$> muser)

upsertUser :: User -> DB UserId
upsertUser user = entityKey <$> upsert user
    [ UserName =. userName user
    , UserEmail =. userEmail user
    ]

credsToUser :: Creds m -> Maybe User
credsToUser Creds{..} = User
    <$> lookup "name" credsExtra
    <*> lookup "email" credsExtra
    <*> pure credsPlugin
    <*> pure credsIdent

This ensures there are no identifier collisions (users are unique by plugin and identifier) and that users’ names and emails are stored (and updated) in our database whenever they login.

Testing

By adding this form of authentication in our application, we’ve made our lives more difficult in testing. We can’t be going through an OAuth exchange whenever we need to test a route that requires an authenticated user. Currently, there’s no back door to the in-test browser session (where current user information is stored), so my first attempts to artificially set a current user were not successful.

I eventually found this blog post outlining an approach for authenticating though Yesod.Auth.HashDB during tests. Knowing that Yesod.Auth.Dummy is available to make fake logins possible during development, I decided the best approach would be to add that plugin and use a similar process to authenticate through it during tests.

`Yesod.Auth.Dummy`

First add a configuration point to Settings.hs for determining whether or not to add the Dummy plugin in a given environment. We don’t want this available in production!

data AppSettings = AppSettings
    { -- ...
    , -- ...
    , appAllowDummyAuth :: Bool
    }

instance FromJSON AppSettings where
    parseJSON = withObject "AppSettings" $ \o -> do
        let defaultDev =
#if DEVELOPMENT
                True
#else
                False
#endif

        -- ...

        appAllowDummyAuth <- o .:? "allow-dummy-auth" .!= defaultDev

        return AppSettings {..}

With this, appAllowDummyAuth will be True only if DEVELOPMENT is defined (as it is during tests). You could also default this to False and enable it explicitly in config/test-settings.yml.

Now (conditionally) add the plugin in your YesodAuth instance to Foundation.hs:

instance YesodAuth App where
    -- ...

    authPlugins m = addAuthBackDoor m
        [ -- ...
        , -- ...
        , oauth2Github
            (oauthKeysClientId $ appGithubOAuthKeys m)
            (oauthKeysClientSecret $ appGithubOAuthKeys m)
        ]

addAuthBackDoor :: App -> [AuthPlugin App] -> [AuthPlugin App]
addAuthBackDoor app =
    if appAllowDummyAuth (appSettings app) then (authDummy :) else id

Finally, with this in place, add the following helper to test/TestImport.hs:

authenticateAs :: Entity User -> YesodExample App ()
authenticateAs (Entity _ u) = do
    root <- appRoot . appSettings <$> getTestYesod

    request $ do
        setMethod "POST"
        addPostParam "ident" $ userIdent u
        setUrl $ root ++ "/auth/page/dummy"

And use it in your tests, for example in test/Handler/AdminSpec.hs:

spec :: Spec
spec = withApp $ do
    describe "GET AdminR" $ do
        it "does not allow access to non-admins" $ do
            user <- runDB $ createUser { userAdmin = False }
            authenticateAs user

            get AdminR

            statusIs 401

        it "allows access to admins" $ do
            user <- runDB $ createUser { userAdmin = True }
            authenticateAs user

            get AdminR

            statusIs 200

What’s Next

Read about Authentication and Authorization in the Yesod book
Check out Hspec and Yesod Test, the testing frameworks used in the example
See this code “in the wild” by actually authenticating on Carnival

Yesod.Auth.OAuth2.Github

Extra Credit

Testing

Yesod.Auth.Dummy

What’s Next

Sign up to receive a weekly recap from thoughtbot

Empower your teams to work remotely with thoughtbot

`Yesod.Auth.OAuth2.Github`

`Yesod.Auth.Dummy`