Fix openid.hs

This commit is contained in:
Michael Snoyman 2015-10-13 07:41:49 +00:00
parent cf46d5e519
commit e2e2edf270

View File

@ -27,7 +27,7 @@ getRootR = getAfterLoginR
getAfterLoginR :: Handler RepHtml getAfterLoginR :: Handler RepHtml
getAfterLoginR = do getAfterLoginR = do
mauth <- maybeAuthId mauth <- maybeAuthId
defaultLayout $ addHamlet [hamlet| defaultLayout [whamlet|
<p>Auth: #{show mauth} <p>Auth: #{show mauth}
$maybe _ <- mauth $maybe _ <- mauth
<p> <p>
@ -45,14 +45,15 @@ instance YesodAuth BID where
loginDest _ = AfterLoginR loginDest _ = AfterLoginR
logoutDest _ = AuthR LoginR logoutDest _ = AuthR LoginR
getAuthId = return . Just . credsIdentClaimed getAuthId = return . Just . credsIdentClaimed
authPlugins _ = [authOpenId] authPlugins _ = [authOpenId Claimed []]
authHttpManager = httpManager authHttpManager = httpManager
maybeAuthId = lookupSession credsKey
instance RenderMessage BID FormMessage where instance RenderMessage BID FormMessage where
renderMessage _ _ = defaultFormMessage renderMessage _ _ = defaultFormMessage
main :: IO () main :: IO ()
main = do main = do
m <- newManager def m <- newManager tlsManagerSettings
toWaiApp (BID m) >>= run 3000 toWaiApp (BID m) >>= run 3000