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 defaultMaybeAuthId 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.