From 0ca5e4878edd1dbdccf6d2604520f11fc118074f Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 17 Jan 2012 09:04:41 +0200
Subject: [PATCH] Avoid use of error (#220)

---
 yesod-auth/Yesod/Auth.hs           | 10 ++++++++++
 yesod-auth/Yesod/Auth/BrowserId.hs |  4 +++-
 yesod-auth/Yesod/Auth/Facebook.hs  |  9 ++++++---
 3 files changed, 19 insertions(+), 4 deletions(-)

diff --git a/yesod-auth/Yesod/Auth.hs b/yesod-auth/Yesod/Auth.hs
index 37fb7124..d8b7e115 100644
--- a/yesod-auth/Yesod/Auth.hs
+++ b/yesod-auth/Yesod/Auth.hs
@@ -5,6 +5,7 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveDataTypeable #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Yesod.Auth
     ( -- * Subsite
@@ -22,6 +23,8 @@ module Yesod.Auth
     , maybeAuth
     , requireAuthId
     , requireAuth
+      -- * Exception
+    , AuthException (..)
     ) where
 
 #include "qq.h"
@@ -48,6 +51,8 @@ import Yesod.Json
 import Yesod.Auth.Message (AuthMessage, defaultMessage)
 import qualified Yesod.Auth.Message as Msg
 import Yesod.Form (FormMessage)
+import Data.Typeable (Typeable)
+import Control.Exception (Exception)
 
 data Auth = Auth
 
@@ -233,3 +238,8 @@ redirectLogin = do
 
 instance YesodAuth m => RenderMessage m AuthMessage where
     renderMessage = renderAuthMessage
+
+data AuthException = InvalidBrowserIDAssertion
+                   | InvalidFacebookResponse
+    deriving (Show, Typeable)
+instance Exception AuthException
diff --git a/yesod-auth/Yesod/Auth/BrowserId.hs b/yesod-auth/Yesod/Auth/BrowserId.hs
index 5251d4a0..9b8fd429 100644
--- a/yesod-auth/Yesod/Auth/BrowserId.hs
+++ b/yesod-auth/Yesod/Auth/BrowserId.hs
@@ -13,6 +13,8 @@ import Yesod.Core
 import Text.Hamlet (hamlet)
 import qualified Data.Text as T
 import Data.Maybe (fromMaybe)
+import Control.Monad.IO.Class (liftIO)
+import Control.Exception (throwIO)
 
 #include "qq.h"
 
@@ -52,7 +54,7 @@ helper maudience = AuthPlugin
                             return $ T.takeWhile (/= '/') $ stripScheme $ r $ tm LoginR
                 memail <- lift $ checkAssertion audience assertion (authHttpManager master)
                 case memail of
-                    Nothing -> error "Invalid assertion"
+                    Nothing -> liftIO $ throwIO InvalidBrowserIDAssertion
                     Just email -> setCreds True Creds
                         { credsPlugin = pid
                         , credsIdent = email
diff --git a/yesod-auth/Yesod/Auth/Facebook.hs b/yesod-auth/Yesod/Auth/Facebook.hs
index 2f08a8a2..c3ae5140 100644
--- a/yesod-auth/Yesod/Auth/Facebook.hs
+++ b/yesod-auth/Yesod/Auth/Facebook.hs
@@ -15,7 +15,6 @@ import Yesod.Auth
 import qualified Web.Authenticate.Facebook as Facebook
 import Data.Aeson
 import Data.Aeson.Types (parseMaybe)
-import Data.Maybe (fromMaybe)
 
 import Yesod.Form
 import Yesod.Handler
@@ -25,6 +24,8 @@ import Control.Monad (liftM, mzero, when)
 import Data.Monoid (mappend)
 import qualified Data.Aeson.Types
 import qualified Yesod.Auth.Message as Msg
+import Control.Monad.IO.Class (liftIO)
+import Control.Exception (throwIO)
 
 -- | Route for login using this authentication plugin.
 facebookLogin :: AuthRoute
@@ -81,8 +82,10 @@ authFacebook cid secret perms =
         let Facebook.AccessToken at' = at
         setSession facebookAccessTokenKey at'
         so <- lift $ Facebook.getGraphData at "me" (authHttpManager master)
-        let c = fromMaybe (error "Invalid response from Facebook")
-                $ parseMaybe (parseCreds at') $ either error id so
+        c <- maybe
+                (liftIO $ throwIO InvalidFacebookResponse)
+                return
+                $ either (const Nothing) Just so >>= parseMaybe (parseCreds at')
         setCreds True c
     dispatch "GET" ["logout"] = do
         m <- getYesod