From f3d305506c69495e9e86d5dda6acb120a6dcbeb3 Mon Sep 17 00:00:00 2001
From: Hiromi Ishii <konn.jinro_at_gmail.com>
Date: Thu, 19 May 2011 20:53:09 +0900
Subject: [PATCH 1/2] changed to see Response Status

---
 Web/Authenticate/OAuth.hs | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs
index 2fc2e0fe..22d98bf5 100644
--- a/Web/Authenticate/OAuth.hs
+++ b/Web/Authenticate/OAuth.hs
@@ -2,7 +2,7 @@
 {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
 module Web.Authenticate.OAuth
     ( -- * Data types
-      OAuth(..), SignMethod(..), Credential(..),
+      OAuth(..), SignMethod(..), Credential(..), OAuthException(..),
       -- * Operations for credentials
       emptyCredential, insert, delete, inserts,
       -- * Signature
@@ -38,6 +38,7 @@ import Data.Enumerator (($$), run_, Stream (..), continue)
 import Data.Monoid (mconcat)
 import Control.Monad.IO.Class (MonadIO (liftIO))
 import Data.IORef (newIORef, readIORef, atomicModifyIORef)
+import Control.Exception (Exception, throwIO)
 
 -- | Data type for OAuth client (consumer).
 data OAuth = OAuth { oauthServerName      :: String        -- ^ Service name
@@ -75,7 +76,7 @@ token, tokenSecret :: Credential -> BS.ByteString
 token = fromMaybe "" . lookup "oauth_token" . unCredential
 tokenSecret = fromMaybe "" . lookup "oauth_token_secret" . unCredential
 
-data OAuthException = ProtocolException String
+data OAuthException = OAuthException String
                       deriving (Show, Eq, Data, Typeable)
 
 instance Exception OAuthException
@@ -93,8 +94,11 @@ getTemporaryCredential oa = do
   let req = fromJust $ parseUrl $ oauthRequestUri oa
   req' <- signOAuth oa emptyCredential (req { method = "POST" }) 
   rsp <- withManager $ httpLbs req'
-  let dic = parseSimpleQuery . toStrict . responseBody $ rsp
-  return $ Credential dic
+  if statusCode rsp == 200
+    then do
+      let dic = parseSimpleQuery . toStrict . responseBody $ rsp
+      return $ Credential dic
+    else throwIO . OAuthException $ "Gaining OAuth Temporary Credential Failed: " ++ BSL.unpack (responseBody rsp)
 
 -- | URL to obtain OAuth verifier.
 authorizeUrl :: OAuth           -- ^ OAuth Application

From 6b639403459a869a1e4ea9cdbe5f3af73c14d534 Mon Sep 17 00:00:00 2001
From: Hiromi Ishii <konn.jinro_at_gmail.com>
Date: Thu, 19 May 2011 20:58:09 +0900
Subject: [PATCH 2/2] changed to see Response Status

---
 Web/Authenticate/OAuth.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs
index 22d98bf5..28e0bd8a 100644
--- a/Web/Authenticate/OAuth.hs
+++ b/Web/Authenticate/OAuth.hs
@@ -114,8 +114,12 @@ getAccessToken, getTokenCredential
 getAccessToken oa cr = do
   let req = (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" }
   rsp <- signOAuth oa cr req >>= withManager . httpLbs
-  let dic = parseSimpleQuery . toStrict . responseBody $ rsp
-  return $ Credential dic
+  if statusCode rsp == 200
+    then do
+      let dic = parseSimpleQuery . toStrict . responseBody $ rsp
+      return $ Credential dic
+    else throwIO . OAuthException $ "Gaining OAuth Temporary Credential Failed: " ++ BSL.unpack (responseBody rsp)
+
 
 getTokenCredential = getAccessToken