diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs --- a/Web/Authenticate/OAuth.hs +++ b/Web/Authenticate/OAuth.hs @@ -1,6 +1,5 @@ {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings, StandaloneDeriving #-} -{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Web.Authenticate.OAuth ( -- * Data types OAuth, def, newOAuth, oauthServerName, oauthRequestUri, oauthAccessTokenUri, @@ -12,36 +11,37 @@ -- * Signature signOAuth, genSign, -- * Url & operation for authentication - authorizeUrl, authorizeUrl', getAccessToken, getTemporaryCredential, - getTokenCredential, getTemporaryCredentialWithScope, - getAccessTokenProxy, getTemporaryCredentialProxy, + -- ** Temporary credentials + getTemporaryCredential, getTemporaryCredentialWithScope, + getTemporaryCredentialProxy, getTemporaryCredential', + -- ** Authorization URL + authorizeUrl, authorizeUrl', + -- ** Finishing authentication + getAccessToken, + getAccessTokenProxy, + getTokenCredential, getTokenCredentialProxy, - getAccessToken', getTemporaryCredential', + getAccessToken', -- * Utility Methods paramEncode, addScope, addMaybeProxy ) where -import Blaze.ByteString.Builder (toByteString, Builder) -import Codec.Crypto.RSA (ha_SHA1, rsassa_pkcs1_v1_5_sign) + +import Blaze.ByteString.Builder (toByteString) import Control.Exception import Control.Monad import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.Control -import Control.Monad.Trans.Resource import Crypto.Types.PubKey.RSA (PrivateKey (..), PublicKey (..)) import Data.ByteString.Base64 import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Char -import Data.Conduit (Source, ($$), ($=)) -import Data.Conduit.Blaze (builderToByteString) -import qualified Data.Conduit.List as CL import Data.Default import Data.Digest.Pure.SHA import qualified Data.IORef as I -import Data.List (sortBy) +import Data.List (sort) import Data.Maybe import Data.Time -import Network.HTTP.Conduit +import Network.HTTP.Client import Network.HTTP.Types (SimpleQuery, parseSimpleQuery) import Network.HTTP.Types (Header) import Network.HTTP.Types (renderSimpleQuery, status200) @@ -52,7 +52,13 @@ #else import Data.Data #endif +import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, hashSHA1) + +---------------------------------------------------------------------- +-- Data types + + -- | Data type for OAuth client (consumer). -- -- The constructor for this data type is not exposed. @@ -84,12 +90,14 @@ -- ^ Optional authorization realm (default: @Nothing@) , oauthVersion :: OAuthVersion -- ^ OAuth spec version (default: 'OAuth10a') - } deriving (Show, Eq, Ord, Read, Data, Typeable) + } deriving (Show, Eq, Read, Data, Typeable) + data OAuthVersion = OAuth10 -- ^ OAuth protocol ver 1.0 (no oauth_verifier; differs from RFC 5849). | OAuth10a -- ^ OAuth protocol ver 1.0a. This corresponds to community's 1.0a spec and RFC 5849. - deriving (Show, Eq, Ord, Data, Typeable, Read) + deriving (Show, Eq, Enum, Ord, Data, Typeable, Read) + -- | Default value for OAuth datatype. -- You must specify at least oauthServerName, URIs and Tokens. newOAuth :: OAuth @@ -108,21 +116,28 @@ instance Default OAuth where def = newOAuth + -- | Data type for signature method. data SignMethod = PLAINTEXT | HMACSHA1 | RSASHA1 PrivateKey - deriving (Show, Eq, Ord, Read, Data, Typeable) -deriving instance Ord PrivateKey -deriving instance Ord PublicKey + deriving (Show, Eq, Read, Data, Typeable) + +data OAuthException = OAuthException String + deriving (Show, Eq, Data, Typeable) + +instance Exception OAuthException + + +---------------------------------------------------------------------- +-- Credentials + + -- | Data type for redential. data Credential = Credential { unCredential :: [(BS.ByteString, BS.ByteString)] } deriving (Show, Eq, Ord, Read, Data, Typeable) --- | Empty credential. -emptyCredential :: Credential -emptyCredential = Credential [] -- | Convenient function to create 'Credential' with OAuth Token and Token Secret. newCredential :: BS.ByteString -- ^ value for oauth_token @@ -130,58 +145,103 @@ -> Credential newCredential tok sec = Credential [("oauth_token", tok), ("oauth_token_secret", sec)] -token, tokenSecret :: Credential -> BS.ByteString -token = fromMaybe "" . lookup "oauth_token" . unCredential -tokenSecret = fromMaybe "" . lookup "oauth_token_secret" . unCredential -data OAuthException = OAuthException String - deriving (Show, Eq, Data, Typeable) +-- | Empty credential. +emptyCredential :: Credential +emptyCredential = Credential [] -instance Exception OAuthException -toStrict :: BSL.ByteString -> BS.ByteString -toStrict = BS.concat . BSL.toChunks +-- | Insert an oauth parameter into given 'Credential'. +insert :: BS.ByteString -- ^ Parameter Name + -> BS.ByteString -- ^ Value + -> Credential -- ^ Credential + -> Credential -- ^ Result +insert k v = Credential . insertMap k v . unCredential -fromStrict :: BS.ByteString -> BSL.ByteString -fromStrict = BSL.fromChunks . return +-- | Convenient method for inserting multiple parameters into credential. +inserts :: [(BS.ByteString, BS.ByteString)] -> Credential -> Credential +inserts = flip $ foldr (uncurry insert) + + +-- | Remove an oauth parameter for key from given 'Credential'. +delete :: BS.ByteString -- ^ Parameter name + -> Credential -- ^ Credential + -> Credential -- ^ Result +delete key = Credential . deleteMap key . unCredential + + +-- | Insert @oauth-verifier@ on a 'Credential'. +injectVerifier :: BS.ByteString -> Credential -> Credential +injectVerifier = insert "oauth_verifier" + + +---------------------------------------------------------------------- +-- Signature + +-- | Add OAuth headers & sign to 'Request'. +signOAuth :: MonadIO m + => OAuth -- ^ OAuth Application + -> Credential -- ^ Credential + -> Request -- ^ Original Request + -> m Request -- ^ Signed OAuth Request +signOAuth oa crd req = do + crd' <- addTimeStamp =<< addNonce crd + let tok = injectOAuthToCred oa crd' + sign <- genSign oa tok req + return $ addAuthHeader prefix (insert "oauth_signature" sign tok) req + where + prefix = case oauthRealm oa of + Nothing -> "OAuth " + Just v -> "OAuth realm=\"" `BS.append` v `BS.append` "\"," + + +-- | Generate OAuth signature. Used by 'signOAuth'. +genSign :: MonadIO m => OAuth -> Credential -> Request -> m BS.ByteString +genSign oa tok req = + case oauthSignatureMethod oa of + HMACSHA1 -> do + text <- getBaseString tok req + let key = BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok] + return $ encode $ toStrict $ bytestringDigest $ hmacSha1 (fromStrict key) text + PLAINTEXT -> + return $ BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok] + RSASHA1 pr -> + liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign hashSHA1 pr) (getBaseString tok req) + + +---------------------------------------------------------------------- +-- Temporary credentails + + -- | Get temporary credential for requesting acces token. -getTemporaryCredential :: (MonadResource m, MonadBaseControl IO m) +getTemporaryCredential :: MonadIO m => OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredential = getTemporaryCredential' id + -- | Get temporary credential for requesting access token with Scope parameter. -getTemporaryCredentialWithScope :: (MonadResource m, MonadBaseControl IO m) +getTemporaryCredentialWithScope :: MonadIO m => BS.ByteString -- ^ Scope parameter string -> OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporay Credential (Request Token & Secret). getTemporaryCredentialWithScope bs = getTemporaryCredential' (addScope bs) -#if MIN_VERSION_http_conduit(2, 0, 0) -addScope :: BS.ByteString -> Request -> Request -#else -addScope :: (MonadIO m) => BS.ByteString -> Request m -> Request m -#endif -addScope scope req | BS.null scope = req - | otherwise = urlEncodedBody [("scope", scope)] req -- | Get temporary credential for requesting access token via the proxy. -getTemporaryCredentialProxy :: (MonadResource m, MonadBaseControl IO m) +getTemporaryCredentialProxy :: MonadIO m => Maybe Proxy -- ^ Proxy -> OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredentialProxy p oa m = getTemporaryCredential' (addMaybeProxy p) oa m -getTemporaryCredential' :: (MonadResource m, MonadBaseControl IO m) -#if MIN_VERSION_http_conduit(2, 0, 0) + +getTemporaryCredential' :: MonadIO m => (Request -> Request) -- ^ Request Hook -#else - => (Request m -> Request m) -- ^ Request Hook -#endif -> OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporary Credential (Request Token & Secret). @@ -189,19 +249,25 @@ let req = fromJust $ parseUrl $ oauthRequestUri oa crd = maybe id (insert "oauth_callback") (oauthCallback oa) $ emptyCredential req' <- signOAuth oa crd $ hook (req { method = "POST" }) - rsp <- httpLbs req' manager + rsp <- liftIO $ httpLbs req' manager if responseStatus rsp == status200 then do let dic = parseSimpleQuery . toStrict . responseBody $ rsp return $ Credential dic else liftIO . throwIO . OAuthException $ "Gaining OAuth Temporary Credential Failed: " ++ BSL.unpack (responseBody rsp) + +---------------------------------------------------------------------- +-- Authorization URL + + -- | URL to obtain OAuth verifier. authorizeUrl :: OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (Request Token & Secret) -> String -- ^ URL to authorize authorizeUrl = authorizeUrl' $ \oa -> const [("oauth_consumer_key", oauthConsumerKey oa)] + -- | Convert OAuth and Credential to URL to authorize. -- This takes function to choice parameter to pass to the server other than -- /oauth_callback/ or /oauth_token/. @@ -217,18 +283,23 @@ Just callback -> ("oauth_callback", callback):fixed +---------------------------------------------------------------------- +-- Finishing authentication + + -- | Get Access token. getAccessToken, getTokenCredential - :: (MonadResource m, MonadBaseControl IO m) + :: MonadIO m => OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (with oauth_verifier if >= 1.0a) -> Manager -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessToken = getAccessToken' id + -- | Get Access token via the proxy. getAccessTokenProxy, getTokenCredentialProxy - :: (MonadResource m, MonadBaseControl IO m) + :: MonadIO m => Maybe Proxy -- ^ Proxy -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (with oauth_verifier if >= 1.0a) @@ -236,19 +307,16 @@ -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessTokenProxy p = getAccessToken' $ addMaybeProxy p -getAccessToken' :: (MonadResource m, MonadBaseControl IO m) -#if MIN_VERSION_http_conduit(2, 0, 0) + +getAccessToken' :: MonadIO m => (Request -> Request) -- ^ Request Hook -#else - => (Request m -> Request m) -- ^ Request Hook -#endif -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (with oauth_verifier if >= 1.0a) -> Manager -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessToken' hook oa cr manager = do let req = hook (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" } - rsp <- flip httpLbs manager =<< signOAuth oa (if oauthVersion oa == OAuth10 then delete "oauth_verifier" cr else cr) req + rsp <- liftIO $ flip httpLbs manager =<< signOAuth oa (if oauthVersion oa == OAuth10 then delete "oauth_verifier" cr else cr) req if responseStatus rsp == status200 then do let dic = parseSimpleQuery . toStrict . responseBody $ rsp @@ -258,53 +326,7 @@ getTokenCredential = getAccessToken getTokenCredentialProxy = getAccessTokenProxy -insertMap :: Eq a => a -> b -> [(a,b)] -> [(a,b)] -insertMap key val = ((key,val):) . filter ((/=key).fst) -deleteMap :: Eq a => a -> [(a,b)] -> [(a,b)] -deleteMap k = filter ((/=k).fst) - --- | Insert an oauth parameter into given 'Credential'. -insert :: BS.ByteString -- ^ Parameter Name - -> BS.ByteString -- ^ Value - -> Credential -- ^ Credential - -> Credential -- ^ Result -insert k v = Credential . insertMap k v . unCredential - --- | Convenient method for inserting multiple parameters into credential. -inserts :: [(BS.ByteString, BS.ByteString)] -> Credential -> Credential -inserts = flip $ foldr (uncurry insert) - --- | Remove an oauth parameter for key from given 'Credential'. -delete :: BS.ByteString -- ^ Parameter name - -> Credential -- ^ Credential - -> Credential -- ^ Result -delete key = Credential . deleteMap key . unCredential - -injectVerifier :: BS.ByteString -> Credential -> Credential -injectVerifier = insert "oauth_verifier" - --- | Add OAuth headers & sign to 'Request'. -signOAuth :: (MonadUnsafeIO m) - => OAuth -- ^ OAuth Application - -> Credential -- ^ Credential -#if MIN_VERSION_http_conduit(2, 0, 0) - -> Request -- ^ Original Request - -> m Request -- ^ Signed OAuth Request -#else - -> Request m -- ^ Original Request - -> m (Request m) -- ^ Signed OAuth Request -#endif -signOAuth oa crd req = do - crd' <- addTimeStamp =<< addNonce crd - let tok = injectOAuthToCred oa crd' - sign <- genSign oa tok req - return $ addAuthHeader prefix (insert "oauth_signature" sign tok) req - where - prefix = case oauthRealm oa of - Nothing -> "OAuth " - Just v -> "OAuth realm=\"" `BS.append` v `BS.append` "\"," - baseTime :: UTCTime baseTime = UTCTime day 0 where @@ -315,14 +337,14 @@ showSigMtd HMACSHA1 = "HMAC-SHA1" showSigMtd (RSASHA1 _) = "RSA-SHA1" -addNonce :: MonadUnsafeIO m => Credential -> m Credential +addNonce :: MonadIO m => Credential -> m Credential addNonce cred = do - nonce <- unsafeLiftIO $ replicateM 10 (randomRIO ('a','z')) -- FIXME very inefficient + nonce <- liftIO $ replicateM 10 (randomRIO ('a','z')) -- FIXME very inefficient return $ insert "oauth_nonce" (BS.pack nonce) cred -addTimeStamp :: MonadUnsafeIO m => Credential -> m Credential +addTimeStamp :: MonadIO m => Credential -> m Credential addTimeStamp cred = do - stamp <- (floor . (`diffUTCTime` baseTime)) `liftM` unsafeLiftIO getCurrentTime + stamp <- (floor . (`diffUTCTime` baseTime)) `liftM` liftIO getCurrentTime return $ insert "oauth_timestamp" (BS.pack $ show (stamp :: Integer)) cred injectOAuthToCred :: OAuth -> Credential -> Credential @@ -332,47 +354,15 @@ , ("oauth_version", "1.0") ] cred -#if MIN_VERSION_http_conduit(2, 0, 0) -genSign :: MonadUnsafeIO m => OAuth -> Credential -> Request -> m BS.ByteString -#else -genSign :: MonadUnsafeIO m => OAuth -> Credential -> Request m -> m BS.ByteString -#endif -genSign oa tok req = - case oauthSignatureMethod oa of - HMACSHA1 -> do - text <- getBaseString tok req - let key = BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok] - return $ encode $ toStrict $ bytestringDigest $ hmacSha1 (fromStrict key) text - PLAINTEXT -> - return $ BS.intercalate "&" $ map paramEncode [oauthConsumerSecret oa, tokenSecret tok] - RSASHA1 pr -> - liftM (encode . toStrict . rsassa_pkcs1_v1_5_sign ha_SHA1 pr) (getBaseString tok req) -#if MIN_VERSION_http_conduit(2, 0, 0) addAuthHeader :: BS.ByteString -> Credential -> Request -> Request -#else -addAuthHeader :: BS.ByteString -> Credential -> Request a -> Request a -#endif addAuthHeader prefix (Credential cred) req = req { requestHeaders = insertMap "Authorization" (renderAuthHeader prefix cred) $ requestHeaders req } renderAuthHeader :: BS.ByteString -> [(BS.ByteString, BS.ByteString)] -> BS.ByteString renderAuthHeader prefix = (prefix `BS.append`). BS.intercalate "," . map (\(a,b) -> BS.concat [paramEncode a, "=\"", paramEncode b, "\""]) . filter ((`elem` ["oauth_token", "oauth_verifier", "oauth_consumer_key", "oauth_signature_method", "oauth_timestamp", "oauth_nonce", "oauth_version", "oauth_callback", "oauth_signature"]) . fst) --- | Encode a string using the percent encoding method for OAuth. -paramEncode :: BS.ByteString -> BS.ByteString -paramEncode = BS.concatMap escape - where - escape c | isAscii c && (isAlpha c || isDigit c || c `elem` "-._~") = BS.singleton c - | otherwise = let num = map toUpper $ showHex (ord c) "" - oct = '%' : replicate (2 - length num) '0' ++ num - in BS.pack oct - -#if MIN_VERSION_http_conduit(2, 0, 0) -getBaseString :: MonadUnsafeIO m => Credential -> Request -> m BSL.ByteString -#else -getBaseString :: MonadUnsafeIO m => Credential -> Request m -> m BSL.ByteString -#endif +getBaseString :: MonadIO m => Credential -> Request -> m BSL.ByteString getBaseString tok req = do let bsMtd = BS.map toUpper $ method req isHttps = secure req @@ -382,31 +372,67 @@ bsURI = BS.concat [scheme, "://", host req, bsPort, path req] bsQuery = parseSimpleQuery $ queryString req bsBodyQ <- if isBodyFormEncoded $ requestHeaders req - then liftM parseSimpleQuery $ toLBS (requestBody req) + then liftM parseSimpleQuery $ toBS (requestBody req) else return [] let bsAuthParams = filter ((`elem`["oauth_consumer_key","oauth_token", "oauth_version","oauth_signature_method","oauth_timestamp", "oauth_nonce", "oauth_verifier", "oauth_version","oauth_callback"]).fst) $ unCredential tok allParams = bsQuery++bsBodyQ++bsAuthParams - bsParams = BS.intercalate "&" $ map (\(a,b)->BS.concat[a,"=",b]) $ sortBy compareTuple + bsParams = BS.intercalate "&" $ map (\(a,b)->BS.concat[a,"=",b]) $ sort $ map (\(a,b) -> (paramEncode a,paramEncode b)) allParams -- parameter encoding method in OAuth is slight different from ordinary one. -- So this is OK. return $ BSL.intercalate "&" $ map (fromStrict.paramEncode) [bsMtd, bsURI, bsParams] -#if MIN_VERSION_http_conduit(2, 0, 0) -toLBS :: MonadUnsafeIO m => RequestBody -> m BS.ByteString -toLBS (RequestBodyLBS l) = return $ toStrict l -toLBS (RequestBodyBS s) = return s -toLBS (RequestBodyBuilder _ b) = return $ toByteString b -toLBS (RequestBodyStream _ givesPopper) = toLBS' givesPopper -toLBS (RequestBodyStreamChunked givesPopper) = toLBS' givesPopper -type Popper = IO BS.ByteString -type NeedsPopper a = Popper -> IO a -type GivesPopper a = NeedsPopper a -> IO a +---------------------------------------------------------------------- +-- Utilities -toLBS' :: MonadUnsafeIO m => GivesPopper () -> m BS.ByteString --- FIXME probably shouldn't be using MonadUnsafeIO -toLBS' gp = unsafeLiftIO $ do +-- | Encode a string using the percent encoding method for OAuth. +paramEncode :: BS.ByteString -> BS.ByteString +paramEncode = BS.concatMap escape + where + escape c | isAscii c && (isAlpha c || isDigit c || c `elem` "-._~") = BS.singleton c + | otherwise = let num = map toUpper $ showHex (ord c) "" + oct = '%' : replicate (2 - length num) '0' ++ num + in BS.pack oct + + +addScope :: BS.ByteString -> Request -> Request +addScope scope req | BS.null scope = req + | otherwise = urlEncodedBody [("scope", scope)] req + + +token, tokenSecret :: Credential -> BS.ByteString +token = fromMaybe "" . lookup "oauth_token" . unCredential +tokenSecret = fromMaybe "" . lookup "oauth_token_secret" . unCredential + + +addMaybeProxy :: Maybe Proxy -> Request -> Request +addMaybeProxy p req = req { proxy = p } + + +insertMap :: Eq a => a -> b -> [(a,b)] -> [(a,b)] +insertMap key val = ((key,val):) . filter ((/=key).fst) + +deleteMap :: Eq a => a -> [(a,b)] -> [(a,b)] +deleteMap k = filter ((/=k).fst) + + +toStrict :: BSL.ByteString -> BS.ByteString +toStrict = BS.concat . BSL.toChunks + +fromStrict :: BS.ByteString -> BSL.ByteString +fromStrict = BSL.fromChunks . return + + +toBS :: MonadIO m => RequestBody -> m BS.ByteString +toBS (RequestBodyLBS l) = return $ toStrict l +toBS (RequestBodyBS s) = return s +toBS (RequestBodyBuilder _ b) = return $ toByteString b +toBS (RequestBodyStream _ givesPopper) = toBS' givesPopper +toBS (RequestBodyStreamChunked givesPopper) = toBS' givesPopper + +toBS' :: MonadIO m => GivesPopper () -> m BS.ByteString +toBS' gp = liftIO $ do ref <- I.newIORef BS.empty gp (go ref) I.readIORef ref @@ -419,31 +445,7 @@ if BS.null bs then I.writeIORef ref $ BS.concat $ front [] else loop (front . (bs:)) -#else -toLBS :: MonadUnsafeIO m => RequestBody m -> m BS.ByteString -toLBS (RequestBodyLBS l) = return $ toStrict l -toLBS (RequestBodyBS s) = return s -toLBS (RequestBodyBuilder _ b) = return $ toByteString b -toLBS (RequestBodySource _ src) = toLBS' src -toLBS (RequestBodySourceChunked src) = toLBS' src -toLBS' :: MonadUnsafeIO m => Source m Builder -> m BS.ByteString -toLBS' src = liftM BS.concat $ src $= builderToByteString $$ CL.consume -#endif isBodyFormEncoded :: [Header] -> Bool isBodyFormEncoded = maybe False (=="application/x-www-form-urlencoded") . lookup "Content-Type" - -compareTuple :: (Ord a, Ord b) => (a, b) -> (a, b) -> Ordering -compareTuple (a,b) (c,d) = - case compare a c of - LT -> LT - EQ -> compare b d - GT -> GT - -#if MIN_VERSION_http_conduit(2, 0, 0) -addMaybeProxy :: Maybe Proxy -> Request -> Request -#else -addMaybeProxy :: Maybe Proxy -> Request m -> Request m -#endif -addMaybeProxy p req = req { proxy = p } diff --git a/Web/Authenticate/OAuth/IO.hs b/Web/Authenticate/OAuth/IO.hs --- a/Web/Authenticate/OAuth/IO.hs +++ b/Web/Authenticate/OAuth/IO.hs @@ -5,16 +5,16 @@ -- What this module do is just adding 'withManager' or 'runResourceT'. module Web.Authenticate.OAuth.IO {-# DEPRECATED "This module is deprecated; rewrite your code using MonadResource" #-} - ( + ( module Web.Authenticate.OAuth, getAccessToken, getTemporaryCredential, getTemporaryCredentialWithScope, getTemporaryCredentialProxy, getTemporaryCredential', getTokenCredential, - getAccessTokenProxy, getTokenCredentialProxy, + getAccessTokenProxy, getTokenCredentialProxy, getAccessToken' ) where -import Network.HTTP.Conduit +import Network.HTTP.Client import qualified Web.Authenticate.OAuth as OA import Web.Authenticate.OAuth hiding (getAccessToken, @@ -24,7 +24,6 @@ getAccessTokenProxy, getTemporaryCredentialProxy, getTokenCredentialProxy, getAccessToken', getTemporaryCredential') -import Data.Conduit import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as BS @@ -33,7 +32,7 @@ getTemporaryCredential :: MonadIO m => OA.OAuth -- ^ OAuth Application -> m OA.Credential -- ^ Temporary Credential (Request Token & Secret). -getTemporaryCredential = liftIO . withManager . OA.getTemporaryCredential +getTemporaryCredential = liftIO . withManager defaultManagerSettings . OA.getTemporaryCredential -- | Get temporary credential for requesting access token with Scope parameter. getTemporaryCredentialWithScope :: MonadIO m @@ -41,7 +40,7 @@ -> OAuth -- ^ OAuth Application -> m Credential -- ^ Temporay Credential (Request Token & Secret). getTemporaryCredentialWithScope bs oa = - liftIO $ withManager $ OA.getTemporaryCredentialWithScope bs oa + liftIO $ withManager defaultManagerSettings $ OA.getTemporaryCredentialWithScope bs oa -- | Get temporary credential for requesting access token via the proxy. @@ -49,17 +48,13 @@ => Maybe Proxy -- ^ Proxy -> OAuth -- ^ OAuth Application -> m Credential -- ^ Temporary Credential (Request Token & Secret). -getTemporaryCredentialProxy p oa = liftIO $ withManager $ OA.getTemporaryCredential' (addMaybeProxy p) oa +getTemporaryCredentialProxy p oa = liftIO $ withManager defaultManagerSettings $ OA.getTemporaryCredential' (addMaybeProxy p) oa getTemporaryCredential' :: MonadIO m -#if MIN_VERSION_http_conduit(2, 0, 0) => (Request -> Request) -- ^ Request Hook -#else - => (Request (ResourceT IO) -> Request (ResourceT IO)) -- ^ Request Hook -#endif -> OAuth -- ^ OAuth Application -> m Credential -- ^ Temporary Credential (Request Token & Secret). -getTemporaryCredential' hook oa = liftIO $ withManager $ OA.getTemporaryCredential' hook oa +getTemporaryCredential' hook oa = liftIO $ withManager defaultManagerSettings $ OA.getTemporaryCredential' hook oa -- | Get Access token. @@ -68,7 +63,7 @@ => OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential with oauth_verifier -> m Credential -- ^ Token Credential (Access Token & Secret) -getAccessToken oa cr = liftIO $ withManager $ OA.getAccessToken oa cr +getAccessToken oa cr = liftIO $ withManager defaultManagerSettings $ OA.getAccessToken oa cr -- | Get Access token via the proxy. getAccessTokenProxy, getTokenCredentialProxy @@ -77,18 +72,14 @@ -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential with oauth_verifier -> m Credential -- ^ Token Credential (Access Token & Secret) -getAccessTokenProxy p oa cr = liftIO $ withManager $ OA.getAccessTokenProxy p oa cr +getAccessTokenProxy p oa cr = liftIO $ withManager defaultManagerSettings $ OA.getAccessTokenProxy p oa cr getAccessToken' :: MonadIO m -#if MIN_VERSION_http_conduit(2, 0, 0) => (Request -> Request) -- ^ Request Hook -#else - => (Request (ResourceT IO) -> Request (ResourceT IO)) -- ^ Request Hook -#endif -> OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential with oauth_verifier -> m Credential -- ^ Token Credential (Access Token & Secret) -getAccessToken' hook oa cr = liftIO $ withManager $ OA.getAccessToken' hook oa cr +getAccessToken' hook oa cr = liftIO $ withManager defaultManagerSettings $ OA.getAccessToken' hook oa cr getTokenCredential = getAccessToken diff --git a/authenticate-oauth.cabal b/authenticate-oauth.cabal --- a/authenticate-oauth.cabal +++ b/authenticate-oauth.cabal @@ -1,6 +1,5 @@ - name: authenticate-oauth -version: 1.4.0.8 +version: 1.5 license: BSD3 license-file: LICENSE author: Hiromi Ishii @@ -15,22 +14,19 @@ library build-depends: base >= 4 && < 5 - , http-conduit >= 1.4 - , transformers >= 0.1 && < 0.4 + , http-client >= 0.3 + , transformers >= 0.1 && < 0.5 , bytestring >= 0.9 , crypto-pubkey-types >= 0.1 && < 0.5 - , RSA >= 1.2 && < 1.3 + , RSA == 2.0.* , time , data-default , base64-bytestring >= 0.1 && < 1.1 , SHA >= 1.4 && < 1.7 , random - , http-types >= 0.6 && < 0.9 + , http-types >= 0.6 , blaze-builder - , conduit >= 0.4 - , resourcet >= 0.3 && < 0.5 , blaze-builder-conduit >= 0.4 - , monad-control >= 0.3 && < 0.4 exposed-modules: Web.Authenticate.OAuth, Web.Authenticate.OAuth.IO ghc-options: -Wall