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

BrowserID: don't use an exception on failure

Browse Source
This commit is contained in:
Greg Weber 2013-05-09 11:43:45 -05:00
parent 604d93512b
commit 0c9abba5c1
2 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
yesod-auth/Yesod/Auth.hs
View File

@ -397,8 +397,7 @@ redirectLogin = do
instance YesodAuth master => RenderMessage master AuthMessage where instance YesodAuth master => RenderMessage master AuthMessage where
renderMessage = renderAuthMessage renderMessage = renderAuthMessage
data AuthException = InvalidBrowserIDAssertion data AuthException = InvalidFacebookResponse
| InvalidFacebookResponse
deriving (Show, Typeable) deriving (Show, Typeable)
instance Exception AuthException instance Exception AuthException

5
yesod-auth/Yesod/Auth/BrowserId.hs
View File

@ -19,7 +19,6 @@ import Text.Hamlet (hamlet)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Control.Monad (when, unless) import Control.Monad (when, unless)
import Control.Exception (throwIO)
import Text.Julius (julius, rawJS) import Text.Julius (julius, rawJS)
import Network.URI (uriPath, parseURI) import Network.URI (uriPath, parseURI)
import Data.FileEmbed (embedFile) import Data.FileEmbed (embedFile)
@ -74,7 +73,9 @@ authBrowserId bis@BrowserIdSettings {..} = AuthPlugin
return $ T.takeWhile (/= '/') $ stripScheme $ r LoginR return $ T.takeWhile (/= '/') $ stripScheme $ r LoginR
memail <- lift $ checkAssertion audience assertion (authHttpManager master) memail <- lift $ checkAssertion audience assertion (authHttpManager master)
case memail of case memail of
Nothing -> liftIO $ throwIO InvalidBrowserIDAssertion Nothing -> do
$logErrorS "yesod-auth" "BrowserID assertion failure"
loginErrorMessage LoginR "BrowserID login error."
Just email -> lift $ setCreds True Creds Just email -> lift $ setCreds True Creds
{ credsPlugin = pid { credsPlugin = pid
, credsIdent = email , credsIdent = email