我正在尝试向Yesod添加硬编码身份验证。我只是简单地修改了Yesod脚手架,并通过遵循文档(http://hackage.haskell.org/package/yesod-auth-1.6.3/docs/Yesod-Auth-Hardcoded.html)添加了一个硬编码用户。所以我有以下代码:
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
所以看来getAuthEntity已经正确实现了。现在,当我尝试使用getAuthEntity获取用户时,如下所示:
getProfileR :: Handler Html
getProfileR = do
uid <- getAuthEntity
defaultLayout $ do
setTitle . toHtml $ ("hola" :: Text )
$(widgetFile "profile")
它只是失败并出现错误:
• Couldn't match expected type ‘HandlerFor App a0’
with actual type ‘AuthId (HandlerSite m0)
-> m0 (Maybe (AuthEntity (HandlerSite m0)))’
|
12 | uid <- getAuthEntity
| ^^^^^^^^^^^^^
我完全迷失了可能出错的地方。提前感谢您的帮助。
答案 0 :(得分:2)
好的,所以我设法解决了这个问题,正如评论所指出的那样,您只需拨打getAuthEntity
,但您也需要用户。所以我将代码更改为以下
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")
然后它有效,但使用maybeAuthId
代替requireAuthId
会产生错误。至于为什么我还不确定。