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

Fix browserid test

Browse Source
This commit is contained in:
Michael Snoyman 2013-02-13 13:33:46 +02:00
parent d5314feed9
commit 99fa35ed40
1 changed files with 3 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
authenticate/browserid.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
import Yesod import Yesod
import Web.Authenticate.BrowserId import Web.Authenticate.BrowserId
import Data.Object
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Network.HTTP.Conduit import Network.HTTP.Conduit
import Data.Text (Text) import Data.Text (Text)
@ -12,7 +11,7 @@ mkYesod "BID" [parseRoutes|
/complete/#Text CompleteR GET /complete/#Text CompleteR GET
|] |]
instance Yesod BID where approot _ = "http://localhost:3000" instance Yesod BID where approot = ApprootStatic "http://localhost:3000"
getRootR = defaultLayout $ do getRootR = defaultLayout $ do
addScriptRemote browserIdJs addScriptRemote browserIdJs
@ -20,7 +19,7 @@ getRootR = defaultLayout $ do
function bidClick() { function bidClick() {
navigator.id.getVerifiedEmail(function(assertion) { navigator.id.getVerifiedEmail(function(assertion) {
if (assertion) { if (assertion) {
document.location = "@{CompleteR ""}" + assertion; document.location = "/complete/" + assertion;
} else { } else {
alert("Invalid BrowserId login"); alert("Invalid BrowserId login");
} }
@ -34,7 +33,7 @@ function bidClick() {
|] |]
getCompleteR assertion = do getCompleteR assertion = do
memail <- liftIO $ checkAssertion "localhost:3000" assertion memail <- withManager $ checkAssertion "localhost:3000" assertion
defaultLayout $ addHamlet [hamlet| defaultLayout $ addHamlet [hamlet|
<p>You tried to log in, let's see if it worked. <p>You tried to log in, let's see if it worked.
$maybe email <- memail $maybe email <- memail