I'm trying to add hardcoded authentication to Yesod. What I've just briefly modified the Yesod scaffold and added a hardcoded user by following the documentation (http://hackage.haskell.org/package/yesod-auth-1.6.3/docs/Yesod-Auth-Hardcoded.html). So I have the following code:
instance YesodAuth App where
type 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 logout
logoutDest :: 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 where
type 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
So it seems that getAuthEntity has been properly implemented. Now however when I try to fetch the user with getAuthEntity like so:
getProfileR :: Handler Html
getProfileR = do
uid <- getAuthEntity
defaultLayout $ do
setTitle . toHtml $ ("hola" :: Text )
$(widgetFile "profile")
It simply fails with the error:
• Couldn't match expected type ‘HandlerFor App a0’
with actual type ‘AuthId (HandlerSite m0)
-> m0 (Maybe (AuthEntity (HandlerSite m0)))’
|
12 | uid <- getAuthEntity
| ^^^^^^^^^^^^^
I'm completely lost as to what could be wrong. Thanks in advance for any help.
Ok so I managed to resolve it, as noted by the comment you can't just call getAuthEntity
but you need the user as well. So I changed the code to the following
getProfileR :: Handler Html
getProfileR = do
uid <- requireAuthId
user <- getAuthEntity uid
defaultLayout $ do
-- setTitle . toHtml $ userIdent user <> "'s User page"
setTitle . toHtml $ ("hola" :: Text )
$(widgetFile "profile")
and then it worked, however using maybeAuthId
instead of requireAuthId
will give an error. As to why I am not sure yet.