haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

update browserid check

Browse Source
This commit is contained in:
Michael Snoyman 2012-03-25 18:54:25 +02:00
parent d464f85f9d
commit edc2d49b9b
1 changed files with 13 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
yesod-auth/browserid.hs
View File

@ -11,8 +11,10 @@ import Text.Hamlet (hamlet)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Yesod.Form import Yesod.Form
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import Network.HTTP.Conduit
import Network.TLS
data BID = BID data BID = BID { httpManager :: Manager }
mkYesod "BID" [parseRoutes| mkYesod "BID" [parseRoutes|
/ RootR GET / RootR GET
@ -21,27 +23,32 @@ mkYesod "BID" [parseRoutes|
|] |]
getRootR :: Handler () getRootR :: Handler ()
getRootR = redirect RedirectTemporary $ AuthR LoginR getRootR = redirect $ AuthR LoginR
getAfterLoginR :: Handler RepHtml getAfterLoginR :: Handler RepHtml
getAfterLoginR = do getAfterLoginR = do
mauth <- maybeAuthId mauth <- maybeAuthId
defaultLayout $ addHamlet [hamlet| defaultLayout $ toWidget [hamlet|
<p>Auth: #{show mauth} <p>Auth: #{show mauth}
|] |]
instance Yesod BID where instance Yesod BID where
approot _ = "http://localhost:3000" approot = ApprootStatic "http://localhost:3000"
instance YesodAuth BID where instance YesodAuth BID where
type AuthId BID = Text type AuthId BID = Text
loginDest _ = AfterLoginR loginDest _ = AfterLoginR
logoutDest _ = AuthR LoginR logoutDest _ = AuthR LoginR
getAuthId = return . Just . credsIdent getAuthId = return . Just . credsIdent
authPlugins = [authBrowserId'] authPlugins _ = [authBrowserId]
authHttpManager = httpManager
instance RenderMessage BID FormMessage where instance RenderMessage BID FormMessage where
renderMessage _ _ = defaultFormMessage renderMessage _ _ = defaultFormMessage
main :: IO () main :: IO ()
main = toWaiApp BID >>= run 3000 main = do
m <- newManager def
{ managerCheckCerts = \_ _ -> return CertificateUsageAccept
}
toWaiApp (BID m) >>= run 3000