Overview

The yesod-auth package provides a unified interface for a number of different authentication plugins. The only real requirement for these backends is that they identify a user based on some unique string. In OpenID, for instance, this would be the actual OpenID value. In BrowserID, it’s the email address. For HashDB (which uses a database of hashed passwords), it’s the username.

Each authentication plugin provides its own system for logging in, whether it be via passing tokens with an external site or an email/password form. After a successful login, the plugin sets a value in the user’s session to indicate his/her AuthId. This AuthId is usually a Persistent ID from a table used for keeping track of users.

There are a few functions available for querying a user’s AuthId, most commonly maybeAuthId, requireAuthId, maybeAuth and requireAuth. The “require” versions will redirect to a login page if the user is not logged in, while the second set of functions (the ones not ending in Id) give both the table ID and entity value.

Since all of the storage of AuthId is built on top of sessions, all of the rules from there apply. In particular, the data is stored in an encrypted, HMACed client cookie, which automatically times out after a certain configurable period of inactivity. Additionally, since there is no server-side component to sessions, logging out simply deletes the data from the session cookie; if a user reuses an older cookie value, the session will still be valid.

On the flip side, authorization is handled by a few methods inside the Yesod typeclass. For every request, these methods are run to determine if access should be allowed, denied, or if the user needs to be authenticated. By default, these methods allow access for every request. Alternatively, you can implement authorization in a more ad-hoc way by adding calls to requireAuth and the like within individual handler functions, though this undermines many of the benefits of a declarative authorization system.

Authenticate Me

Let’s jump right in with an example of authentication. For the Google OAuth authentication to work you should follow these steps:

1. Read on Google Developers Help how to obtain OAuth 2.0 credentials such as a client ID and client secret that are known to both Google and your application.

2. Set Authorized redirect URIs to http://localhost:3000/auth/page/googleemail2/complete.

3. Enable Google+ API and Contacts API.

4. Once you have the clientId and secretId, replace them in the code below.

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
import           Data.Default                (def)
import           Data.Text                   (Text)
import           Network.HTTP.Client.Conduit (Manager, newManager)
import           Yesod
import           Yesod.Auth
import           Yesod.Auth.GoogleEmail2


-- Replace with Google client ID.
clientId :: Text
clientId = ""

-- Replace with Google secret ID.
clientSecret :: Text
clientSecret = ""

data App = App
    { httpManager :: Manager
    }

mkYesod "App" [parseRoutes|
/ HomeR GET
/auth AuthR Auth getAuth
|]

instance Yesod App where
    -- Note: In order to log in with BrowserID, you must correctly
    -- set your hostname here.
    approot = ApprootStatic "http://localhost:3000"

instance YesodAuth App where
    type AuthId App = Text
    authenticate = return . Authenticated . credsIdent

    loginDest _ = HomeR
    logoutDest _ = HomeR

    authPlugins _ = [ authGoogleEmail clientId clientSecret ]

    -- The default maybeAuthId assumes a Persistent database. We're going for a
    -- simpler AuthId, so we'll just do a direct lookup in the session.
    maybeAuthId = lookupSession "_ID"

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage

getHomeR :: Handler Html
getHomeR = do
    maid <- maybeAuthId
    defaultLayout
        [whamlet|
            <p>Your current auth ID: #{show maid}
            $maybe _ <- maid
                <p>
                    <a href=@{AuthR LogoutR}>Logout
            $nothing
                <p>
                    <a href=@{AuthR LoginR}>Go to the login page
        |]

main :: IO ()
main = do
    man <- newManager
    warp 3000 $ App man

We’ll start with the route declarations. First, we declare our standard HomeR route, and then we set up the authentication subsite. Remember that a subsite needs four parameters: the path to the subsite, the route name, the subsite name, and a function to get the subsite value. In other words, based on the line:

/auth AuthR Auth getAuth

We need to have getAuth :: MyAuthSite → Auth. While we haven’t written that function ourselves, yesod-auth provides it automatically. With other subsites (like static files), we provide configuration settings in the subsite value, and therefore need to specify the get function. In the auth subsite, we specify these settings in a separate typeclass, YesodAuth.

So what exactly goes in this YesodAuth instance? There are five required declarations:

• AuthId is an associated type. This is the value yesod-auth will give you when you ask if a user is logged in (via maybeAuthId or requireAuthId). In our case, we’re simply using Text, to store the raw identifier- email address in our case, as we’ll soon see.

• authenticate gets the actual AuthId from the Creds (credentials) data type. This type has three pieces of information: the authentication backend used (googleemail in our case), the actual identifier, and an associated list of arbitrary extra information. Each backend provides different extra information; see their docs for more information.

• loginDest gives the route to redirect to after a successful login.

• Likewise, logoutDest gives the route to redirect to after a logout.

• authPlugins is a list of individual authentication backends to use. In our example, we’re using Google OAuth, which authenticates a user using their Google account.

In addition to these five methods, there are other methods available to control other behavior of the authentication system, such as what the login page looks like. For more information, please see the API documentation.

In our HomeR handler, we have some simple links to the login and logout pages, depending on whether or not the user is logged in. Notice how we construct these subsite links: first we give the subsite route name (AuthR), followed by the route within the subsite (LoginR and LogoutR).

Email

For many use cases, third-party authentication of email will be sufficient. Occasionally, you’ll want users to create passwords on your site. The scaffolded site does not include this setup, because:

• In order to securely accept passwords, you need to be running over SSL. Many users are not serving their sites over SSL.

• While the email backend properly salts and hashes passwords, a compromised database could still be problematic. Again, we make no assumptions that Yesod users are following secure deployment practices.

• You need to have a working system for sending email. Many web servers these days are not equipped to deal with all of the spam protection measures used by mail servers.

But assuming you are able to meet these demands, and you want to have a separate password login specifically for your site, Yesod offers a built-in backend. It requires quite a bit of code to set up, since it needs to store passwords securely in the database and send a number of different emails to users (verify account, password retrieval, etc.).

Let’s have a look at a site that provides email authentication, storing passwords in a Persistent SQLite database.

{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE QuasiQuotes                #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}
import           Control.Monad            (join)
import           Control.Monad.Logger     (runNoLoggingT)
import           Data.Maybe               (isJust)
import           Data.Text                (Text, unpack)
import qualified Data.Text.Lazy.Encoding
import           Data.Typeable            (Typeable)
import           Database.Persist.Sqlite
import           Database.Persist.TH
import           Network.Mail.Mime
import           Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import           Text.Hamlet                   (shamlet)
import           Text.Shakespeare.Text         (stext)
import           Yesod
import           Yesod.Auth
import           Yesod.Auth.Email

share [mkPersist sqlSettings { mpsGeneric = False }, mkMigrate "migrateAll"] [persistLowerCase|
User
    email Text
    password Text Maybe -- Password may not be set yet
    verkey Text Maybe -- Used for resetting passwords
    verified Bool
    UniqueUser email
    deriving Typeable
|]

data App = App SqlBackend

mkYesod "App" [parseRoutes|
/ HomeR GET
/auth AuthR Auth getAuth
|]

instance Yesod App where
    -- Emails will include links, so be sure to include an approot so that
    -- the links are valid!
    approot = ApprootStatic "http://localhost:3000"
    yesodMiddleware = defaultCsrfMiddleware . defaultYesodMiddleware

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage

-- Set up Persistent
instance YesodPersist App where
    type YesodPersistBackend App = SqlBackend
    runDB f = do
        App conn <- getYesod
        runSqlConn f conn

instance YesodAuth App where
    type AuthId App = UserId

    loginDest _ = HomeR
    logoutDest _ = HomeR
    authPlugins _ = [authEmail]

    -- Need to find the UserId for the given email address.
    authenticate creds = liftHandler $ runDB $ do
        x <- insertBy $ User (credsIdent creds) Nothing Nothing False
        return $ Authenticated $
            case x of
                Left (Entity userid _) -> userid -- existing user
                Right userid -> userid -- newly added user

instance YesodAuthPersist App

-- Here's all of the email-specific code
instance YesodAuthEmail App where
    type AuthEmailId App = UserId

    afterPasswordRoute _ = HomeR

    addUnverified email verkey =
        liftHandler $ runDB $ insert $ User email Nothing (Just verkey) False

    sendVerifyEmail email _ verurl = do
        -- Print out to the console the verification email, for easier
        -- debugging.
        liftIO $ putStrLn $ "Copy/ Paste this URL in your browser:" ++ unpack verurl

        -- Send email.
        liftIO $ renderSendMail (emptyMail $ Address Nothing "noreply")
            { mailTo = [Address Nothing email]
            , mailHeaders =
                [ ("Subject", "Verify your email address")
                ]
            , mailParts = [[textPart, htmlPart]]
            }
      where
        textPart = Part
            { partType = "text/plain; charset=utf-8"
            , partEncoding = None
            , partDisposition = DefaultDisposition
            , partContent = PartContent $ Data.Text.Lazy.Encoding.encodeUtf8
                [stext|
                    Please confirm your email address by clicking on the link below.

                    #{verurl}

                    Thank you
                |]
            , partHeaders = []
            }
        htmlPart = Part
            { partType = "text/html; charset=utf-8"
            , partEncoding = None
            , partDisposition = DefaultDisposition
            , partContent = PartContent $ renderHtml
                [shamlet|
                    <p>Please confirm your email address by clicking on the link below.
                    <p>
                        <a href=#{verurl}>#{verurl}
                    <p>Thank you
                |]
            , partHeaders = []
            }
    getVerifyKey = liftHandler . runDB . fmap (join . fmap userVerkey) . get
    setVerifyKey uid key = liftHandler $ runDB $ update uid [UserVerkey =. Just key]
    verifyAccount uid = liftHandler $ runDB $ do
        mu <- get uid
        case mu of
            Nothing -> return Nothing
            Just u -> do
                update uid [UserVerified =. True, UserVerkey =. Nothing]
                return $ Just uid
    getPassword = liftHandler . runDB . fmap (join . fmap userPassword) . get
    setPassword uid pass = liftHandler . runDB $ update uid [UserPassword =. Just pass]
    getEmailCreds email = liftHandler $ runDB $ do
        mu <- getBy $ UniqueUser email
        case mu of
            Nothing -> return Nothing
            Just (Entity uid u) -> return $ Just EmailCreds
                { emailCredsId = uid
                , emailCredsAuthId = Just uid
                , emailCredsStatus = isJust $ userPassword u
                , emailCredsVerkey = userVerkey u
                , emailCredsEmail = email
                }
    getEmail = liftHandler . runDB . fmap (fmap userEmail) . get

getHomeR :: Handler Html
getHomeR = do
    maid <- maybeAuthId
    defaultLayout
        [whamlet|
            <p>Your current auth ID: #{show maid}
            $maybe _ <- maid
                <p>
                    <a href=@{AuthR LogoutR}>Logout
            $nothing
                <p>
                    <a href=@{AuthR LoginR}>Go to the login page
        |]

main :: IO ()
main = runNoLoggingT $ withSqliteConn "email.db3" $ \conn -> liftIO $ do
    runSqlConn (runMigration migrateAll) conn
    warp 3000 $ App conn

Authorization

Once you can authenticate your users, you can use their credentials to authorize requests. Authorization in Yesod is simple and declarative: most of the time, you just need to add the authRoute and isAuthorized methods to your Yesod typeclass instance. Let’s see an example.

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
import           Data.Default         (def)
import           Data.Text            (Text)
import           Network.HTTP.Conduit (Manager, newManager, tlsManagerSettings)
import           Yesod
import           Yesod.Auth
import           Yesod.Auth.Dummy -- just for testing, don't use in real life!!!

data App = App
    { httpManager :: Manager
    }

mkYesod "App" [parseRoutes|
/      HomeR  GET POST
/admin AdminR GET
/auth  AuthR  Auth getAuth
|]

instance Yesod App where
    authRoute _ = Just $ AuthR LoginR

    -- route name, then a boolean indicating if it's a write request
    isAuthorized HomeR True = isAdmin
    isAuthorized AdminR _ = isAdmin

    -- anyone can access other pages
    isAuthorized _ _ = return Authorized

isAdmin = do
    mu <- maybeAuthId
    return $ case mu of
        Nothing -> AuthenticationRequired
        Just "admin" -> Authorized
        Just _ -> Unauthorized "You must be an admin"

instance YesodAuth App where
    type AuthId App = Text
    authenticate = return . Authenticated . credsIdent

    loginDest _ = HomeR
    logoutDest _ = HomeR

    authPlugins _ = [authDummy]

    maybeAuthId = lookupSession "_ID"

instance RenderMessage App FormMessage where
    renderMessage _ _ = defaultFormMessage

getHomeR :: Handler Html
getHomeR = do
    maid <- maybeAuthId
    defaultLayout
        [whamlet|
            <p>Note: Log in as "admin" to be an administrator.
            <p>Your current auth ID: #{show maid}
            $maybe _ <- maid
                <p>
                    <a href=@{AuthR LogoutR}>Logout
            <p>
                <a href=@{AdminR}>Go to admin page
            <form method=post>
                Make a change (admins only)
                \ #
                <input type=submit>
        |]

postHomeR :: Handler ()
postHomeR = do
    setMessage "You made some change to the page"
    redirect HomeR

getAdminR :: Handler Html
getAdminR = defaultLayout
    [whamlet|
        <p>I guess you're an admin!
        <p>
            <a href=@{HomeR}>Return to homepage
    |]

main :: IO ()
main = do
    manager <- newManager tlsManagerSettings
    warp 3000 $ App manager

authRoute should be your login page, almost always AuthR LoginR. isAuthorized is a function that takes two parameters: the requested route, and whether or not the request was a "write" request. You can actually change the meaning of what a write request is using the isWriteRequest method, but the out-of-the-box version follows RESTful principles: anything but a GET, HEAD, OPTIONS or TRACE request is a write request.

What’s convenient about the body of isAuthorized is that you can run any Handler code you want. This means you can:

• Access the filesystem (normal IO)

• Lookup values in the database

• Pull any session or request values you want

Using these techniques, you can develop as sophisticated an authorization system as you like, or even tie into existing systems used by your organization.

Conclusion

This chapter covered the basics of setting up user authentication, as well as how the built-in authorization functions provide a simple, declarative approach for users. While these are complicated concepts, with many approaches, Yesod should provide you with the building blocks you need to create your own customized auth solution.