Yesod.Auth.Hardcoded

yesod-auth-1.4.13.5: Authentication for Yesod.

Copyright | (c) Arthur Fayzrakhmanov, 2015
License | MIT
Maintainer | heraldhoi@gmail.com
Stability | experimental
Safe Haskell | None
Language | Haskell98

Yesod.Auth.Hardcoded

Description

Sometimes you may want to have some hardcoded set of users (e.g. site managers) that allowed to log in and visit some specific sections of your website without ability to register new managers. This simple plugin is designed exactly for this purpose.

Here is a quick usage example.

## Define hardcoded users representation

Let's assume, that we want to have some hardcoded managers with normal site users. Let's define hardcoded user representation:

    data SiteManager = SiteManager
      { manUserName :: Text
      , manPassWord :: Text }
      deriving Show

    siteManagers :: [SiteManager]
    siteManagers = [SiteManager "content editor" "top secret"]

## Describe `YesodAuth` instance

Now we need to have some convenient `AuthId` type representing both cases:

    instance YesodAuth App where
      type AuthId App = Either UserId Text

Here, right `Text` value will present hardcoded user name (which obviously must be unique).

`AuthId` must have an instance of `PathPiece` class, this is needed to store user identifier in session (this happens in `setCreds` and `setCredsRedirect` actions) and to read that identifier from session (this happens in `dafaultMaybeAuthId` action). So we have to define it:

    import Text.Read (readMaybe)

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

Quiet simple so far. Now let's add plugin to `authPlugins` list, and define `authenticate` method, it should return user identifier for given credentials, for normal users it is usually persistent key, for hardcoded users we will return user name again.

    instance YesodAuth App where
      -- ..
      authPlugins _ = [authHardcoded]

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

Here `lookupUser` is just a helper function to lookup hardcoded users by name:

    lookupUser :: Text -> Maybe SiteManager
    lookupUser username = find (m -> manUserName m == username) siteManagers

## Describe an `YesodAuthPersist` instance

Now we need to manually define `YesodAuthPersist` instance.

    instance YesodAuthPersist App where
      type AuthEntity App = Either User SiteManager

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

## Define `YesodAuthHardcoded` instance

Finally, let's define an plugin instance

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

    validPassword :: Text -> Text -> Bool
    validPassword u p =
      case find (m -> manUserName m == u && manPassWord m == p) siteManagers of
        Just _ -> True
        _      -> False

## Conclusion

Now we can use `maybeAuthId`, `maybeAuthPair`, `requireAuthId`, and `requireAuthPair`, moreover, the returned value makes possible to distinguish normal users and site managers.

# Documentation

class YesodAuth site => YesodAuthHardcoded site where #

Minimal complete definition

doesUserNameExist, validatePassword

Methods

doesUserNameExist :: Text -> HandlerT site IO Bool #

Check whether given user name exists among hardcoded names.

validatePassword :: Text -> Text -> HandlerT site IO Bool #

Validate given user name with given password.

authHardcoded :: YesodAuthHardcoded m => AuthPlugin m #

loginR :: AuthRoute #