Authentication and authorization in Yesod

Last updated by Garry Cairns on 31 July 2016 12:18


We've been building a blog site with Yesod. If you haven't read parts two and three you should start there. Part one is skipable. In this part we will:

  • add authentication using the Yesod-Hardcoded plugin; and
  • authorize an admin user to create and update pages.

Authentication

We don't want just anyone being able to post on our blog so we'll need a way to authenticate. Yesod offers a number of ways to do this. We're going to use the hardcoded option because this is a personal blog and we only want one user to edit our stuff. The setup we'll be using follows the documentation as closely as I was able. I found a few bits tricky so please tweet me if you have any improvements.

Creating a data type

You'll need something to represent your admin user(s). The docs don't specify where this should live so I threw mine in Model.hs, which seemed appropriate. Add the following lines.

data SiteAdmin = SiteAdmin
  { adminUsername :: Text
  , adminPassword :: Text }
  deriving Show

Foundation changes

Most of the other important stuff goes into Foundation.hs. Add the following imports first:

import System.IO.Unsafe     (unsafePerformIO)
import Text.Read            (readMaybe)
import Yesod.Auth.Hardcoded
import Yesod.Auth.Message   (AuthMessage(InvalidLogin))

Next I'll put the rest of the authentication code in a big blob, then we'll go through it a bit at a time.

-- Authentication related stuff

instance PathPiece (Either UserId Text) where
  fromPathPiece = readMaybe . unpack
  toPathPiece = pack . show

instance YesodAuth App where
    type AuthId App = Either UserId Text

    -- Where to send a user after successful login
    loginDest _ = HomeR
    -- Where to send a user after logout
    logoutDest _ = HomeR
    -- Override the above two destinations when a Referer: header is present
    redirectToReferer _ = True

    -- You can add other plugins like Google Email, email or OAuth here
    authPlugins _ = [ authHardcoded ]

    authenticate Creds{..} =
      return
        (case credsPlugin of
          "hardcoded" ->
            case lookupUser credsIdent of
                Nothing -> UserError InvalidLogin
                Just m  -> Authenticated (Right (adminUsername m)))

    authHttpManager = getHttpManager

getAdminUsername :: Text
getAdminUsername = appAdminName . unsafePerformIO $ loadYamlSettings [configSettingsYml] [] useEnv

getAdminPassword :: Text
getAdminPassword = appAdminPassword . unsafePerformIO $ loadYamlSettings [configSettingsYml] [] useEnv

siteAdmins :: [SiteAdmin]
siteAdmins = [SiteAdmin getAdminUsername getAdminPassword]

lookupUser :: Text -> Maybe SiteAdmin
lookupUser username = find (\m -> adminUsername m == username) siteAdmins

instance YesodAuthPersist App where
  type AuthEntity App = Either User SiteAdmin

  getAuthEntity (Left uid) =
    do x <- runDB (get uid)
       return (Left <$> x)
  getAuthEntity (Right username) = return (Right <$> lookupUser username)

instance YesodAuthHardcoded App where
  validatePassword u = return . validPassword u
  doesUserNameExist  = return . isJust . lookupUser

validPassword :: Text -> Text -> Bool
validPassword u p =
  case find (\m -> adminUsername m == u && adminPassword m == p) siteAdmins of
    Just _ -> True
    _      -> False

-- End of authentication stuff

There's an awful lot going on there so we'll break things down a little. But make sure to delete any instances the scaffold created that we've now provided new definitions for. First we'll look at the instance YesodAuth App, which is a mixture of stuff we've added and lines that were put there as part of the scaffolded site. The bits we've added and will explain, are the typeAuthId App declaration, the return value of authPlugins and the authenticate function. We've also added the PathPiece bit. I'll be honest here and say the docs suggest it, the compiler complains when it's not there, and I have no idea what it's doing.

instance YesodAuth App where
    type AuthId App = Either UserId Text

    -- Where to send a user after successful login
    loginDest _ = HomeR
    -- Where to send a user after logout
    logoutDest _ = HomeR
    -- Override the above two destinations when a Referer: header is present
    redirectToReferer _ = True

    -- You can add other plugins like Google Email, email or OAuth here
    authPlugins _ = [ authHardcoded ]

    authenticate Creds{..} =
      return
        (case credsPlugin of
          "hardcoded" ->
            case lookupUser credsIdent of
                Nothing -> UserError InvalidLogin
                Just m  -> Authenticated (Right (adminUsername m)))

    authHttpManager = getHttpManager

Here the type AuthId App = Either UserId Text will represent either a user ID from the database (we won't actually be needing any of these) or one of our hardcoded usernames as Text. In authPlugins we're simply declaring the authHardcoded is the only plugin our site will use. The authenticate function takes the supplied credentials and calls the lookupUser function we're about to define, returning either an error indicating the user login supplied was invalid or an authenticated user.

lookupUser :: Text -> Maybe SiteAdmin
lookupUser username = find (\m -> adminUsername m == username) siteAdmins

As with many things Haskell, the type signature contains the most pertinent information for lookupUser. It will take the supplied credentials and will either return a SiteAdmin or it won't. It uses the find function and the predicate inside the lambda expression, which you can read as "tell me if the adminUsername (as we defined it in Model.hs) supplied is in the siteAdmins list. The site admins list comes from the following three functions, which are so important we're going to give them a subheading of their own.

Defining your admin user in environment variables

You might want to host your site's code on the internet, so keeping the username and password in code isn't a good idea. The three functions that set up our site admins list therefore use environment variables, which you can define in your laptop and server separately.

getAdminUsername :: Text
getAdminUsername = appAdminName . unsafePerformIO $ loadYamlSettings [configSettingsYml] [] useEnv

getAdminPassword :: Text
getAdminPassword = appAdminPassword . unsafePerformIO $ loadYamlSettings [configSettingsYml] [] useEnv

siteAdmins :: [SiteAdmin]
siteAdmins = [SiteAdmin getAdminUsername getAdminPassword]

Imagine for a moment that siteAdmins function just returned [SiteAdmin "yourName" "password"]. That's more or less how the documented example looks and will work perfectly. We want to mimic that behaviour by pulling strings from the environment in which our site is running. Open your site's config/settings.yml file and add

admin-name: "_env:ADMIN_NAME:your_user"
admin-password: "_env:ADMIN_PASSWORD:your_password"

That will default the admin username and password to your_user and your_password respectively. There's a potential security risk here of forgetting to set the environment variables in production. We'll mitigate that risk in the deployment tutorial (coming soon!). To use those values you also need to edit Settings.hs. In the data AppSettings = AppSettings section add the following

, appAdminName              :: Text
-- ^ Hardcoded admin user name
, appAdminPassword          :: Text
-- ^ Hardcoded admin user password

then add these associated lines in the instance FromJSON AppSettings section

appAdminName              <- o .: "admin-name"
appAdminPassword          <- o .: "admin-password"

By adding these settings you enable the getAdminUsername and getAdminPassword functions we've defined to work their magic. They pull our values out of the environment using the yaml settings, then lift those out of a monad and into a text value using unsafePerformIO.

You should now be able to log in to your site by visiting localhost:3000/auth/login. Next, we'll restrict certain actions on the site to our new authenticated administrator.

Authorization

We're only a few steps away from a pretty finished site now. Look for some lines in the instance Yesod App part of your Foundation.hs file that call isAuthorized. Add the following to them above the existing lines defaulting routes to return as authorized. The new lines go above that one so Haskell will match their patterns before hitting the default.

isAuthorized BlogR True = isAdmin
isAuthorized (ArticleR _) True = isAdmin

The isAuthorized function takes a route and a Boolean value representing whether the associated request will write to the database. We're specifiying True here so the return value will only impact on post requests. We define isAdmin as a top level function (so not indented inside the Yesod App instance) like so

isAdmin :: (YesodAuth master, AuthId master ~ Either t t1) => HandlerT master IO AuthResult
isAdmin = do
  uid <- requireAuthId
  return $ case uid of
    Left _ -> Unauthorized "You must be an administrator"
    Right _ -> Authorized

This uses requireAuthId to ensure our post requests to the article and blog handlers are logged in, and only authorizes those users defined in our hardcoded site admins to use them. Users from the database, should your site have any, aren't allowed. It would be a good idea to make sure users that can't perform writes also couldn't see our forms so we should also change our handlers and templates.

Handler and template changes

Open your Blog.hs handler and add the line uid <- maybeAuthId at the top of your do notation in each handler. A full example should now look something like this

getArticleR :: BlogId -> Handler Html
getArticleR blogId = do
    uid <- maybeAuthId
    blog <- runDB $ get404 blogId
    (widget, enctype) <- generateFormPost . renderBootstrap3 BootstrapBasicForm $ blogForm (Just blog)
    defaultLayout $ do
        setTitle $ toHtml $ blogTitle blog
        addScriptRemote "https://ajax.googleapis.com/ajax/libs/jquery/1.11.2/jquery.min.js"
        addScriptRemote "https://cdnjs.cloudflare.com/ajax/libs/twitter-bootstrap/3.2.0/js/collapse.js"
        $(widgetFile "article")

As when setting up the site, I'll show you what the blog template might look like and let you design an article one for yourself. Since we're using maybeAuthId, so unauthenticated users can still use the site, we need to account for the case that there is no uid as well as checking what kind of user we have if there is one. Change your blog.hamlet template to look like this

$maybe user <- uid
    $case user
        $of Left _
        $of Right username
            <div class="col-md-12">
                <a class="btn btn-primary" role="button" data-toggle="collapse" href="#blogform" aria-expanded="false" aria-controls="collapseExample">Show form</a> 
            <div class="col-md-12 collapse" id="blogform">
                <h3>Add an article
                <form method=post action=@{BlogR} enctype=#{enctype}>
                    ^{widget}
                    <button class="btn btn-success">Create post
$nothing

<div class="row">

    <div class="col-md-8">
        $maybe article <- map entityVal currentPost
            <h2>#{blogTitle article}
            <p>
                <small>Last updated by Garry Cairns on #{formatDateStr $ blogPosted article}
            <hr />
            #{blogArticle article}
        $nothing
            <h2>No articles yet.
        <hr />

    <div class="col-md-4">
        $if null allPosts
            <h3>No posts yet.
        $else
            <h3>Previous posts
            $forall Entity id article <- allPosts
                <dl>
                    <dt>
                        <a href=@{ArticleR id}>#{blogTitle article}
                    <dd>
                        <small>Posted on #{formatDateStr $ blogPosted article}

The $maybe block right at the top ensures the form will not display if we have an un-authenticated visitor. The $case block inside it checks whether we have a user from the Left return in the either monad we used to check users, which means a user from the database, or a Right user from our admin list. In the latter case we display our form.

Tidying up

You'll run into some problems if you try to compile now because the scaffolded Comment.hs handler won't like our new authentication methods. Additionally, the scaffolded Home.hs handler won't like removing the comment one. The solution here is up to you. I'll show you how to delete those and get your site compiling and leave the rest for you to explore.

First delete the Comment.hs and Home.hs handler files. Then remove the references to them in your cabal file and in Application.hs and config/routes. Finally, change the login destination in your Foundation.hs to your blog handler instead. Remember you won't have a home page anymore doing things this way. But you do have a working site, with authentication and authorization set up and ready to go. The next part, which should be available within a week, will show you how to deploy to EC2. Use the time to get that home page doing whatever you'd like!