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

changed to see Response Status

Browse Source
This commit is contained in:
Hiromi Ishii 2011-05-19 20:53:09 +09:00
parent f3997728f6
commit f3d305506c
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
Web/Authenticate/OAuth.hs
View File

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