instance YesodAuth App wheretype AuthId App = Either UserId Text
-- Where to send a user after successful login
loginDest :: App -> Route App
loginDest _ = HomeR
-- Where to send a user after logoutlogoutDest :: App -> Route App
logoutDest _ = HomeR
-- Override the above two destinations when a Referer: header is present
redirectToReferer :: App -> Bool
redirectToReferer _ = True
authPlugins _ = [authHardcoded]
authenticate Creds{..} =
return
(case credsPlugin of
"hardcoded" ->
case lookupUser credsIdent of
Nothing -> UserError InvalidLogin
Just m -> Authenticated (Right (manUserName m)))
-- | Access function to determine if a user is logged in.
isAuthenticated :: Handler AuthResult
isAuthenticated = do
muid <- maybeAuthId
return $ case muid of
Nothing -> Unauthorized "You must login to access this page"
Just _ -> Authorized
...
instance YesodAuthPersist App wheretype AuthEntity App = Either User SiteManager
getAuthEntity (Left uid) =
do x <- liftHandler $ runDB (get uid)
return (fmap Left x)
getAuthEntity (Right username) = return (fmap Right (lookupUser username))
...
instance PathPiece (Either UserId Text) where
fromPathPiece = readMaybe . unpack
toPathPiece = pack . show
lookupUser :: Text -> Maybe SiteManager
lookupUser username = find (\m -> manUserName m == username) siteManagers
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