Fix openid.hs
This commit is contained in:
parent
cf46d5e519
commit
e2e2edf270
@ -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
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user