authenticate-oauth 1.4.0.7 → 1.4.0.8
raw patch · 3 files changed
+112/−37 lines, 3 filesdep ~basedep ~http-conduit
Dependency ranges changed: base, http-conduit
Files
- Web/Authenticate/OAuth.hs +102/−36
- Web/Authenticate/OAuth/IO.hs +9/−0
- authenticate-oauth.cabal +1/−1
Web/Authenticate/OAuth.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving, FlexibleContexts #-}+{-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings, StandaloneDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Web.Authenticate.OAuth ( -- * Data types@@ -14,45 +15,48 @@ authorizeUrl, authorizeUrl', getAccessToken, getTemporaryCredential, getTokenCredential, getTemporaryCredentialWithScope, getAccessTokenProxy, getTemporaryCredentialProxy,- getTokenCredentialProxy, + getTokenCredentialProxy, getAccessToken', getTemporaryCredential', -- * Utility Methods paramEncode, addScope, addMaybeProxy ) where-import Network.HTTP.Conduit+import Blaze.ByteString.Builder (toByteString, Builder)+import Codec.Crypto.RSA (ha_SHA1, rsassa_pkcs1_v1_5_sign)+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.Maybe+import Data.Time+import Network.HTTP.Conduit+import Network.HTTP.Types (SimpleQuery, parseSimpleQuery)+import Network.HTTP.Types (Header)+import Network.HTTP.Types (renderSimpleQuery, status200)+import Numeric+import System.Random+#if MIN_VERSION_base(4,7,0)+import Data.Data hiding (Proxy (..))+#else import Data.Data-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import Data.Maybe-import Network.HTTP.Types (parseSimpleQuery, SimpleQuery)-import Control.Exception-import Control.Monad-import Data.List (sortBy)-import System.Random-import Data.Char-import Data.Digest.Pure.SHA-import Data.ByteString.Base64-import Data.Time-import Numeric-import Codec.Crypto.RSA (rsassa_pkcs1_v1_5_sign, ha_SHA1)-import Crypto.Types.PubKey.RSA (PrivateKey(..), PublicKey(..))-import Network.HTTP.Types (Header)-import Blaze.ByteString.Builder (toByteString)-import Control.Monad.IO.Class (MonadIO)-import Network.HTTP.Types (renderSimpleQuery, status200)-import Data.Conduit (($$), ($=), Source)-import qualified Data.Conduit.List as CL-import Data.Conduit.Blaze (builderToByteString)-import Blaze.ByteString.Builder (Builder)-import Control.Monad.IO.Class (liftIO)-import Control.Monad.Trans.Control-import Control.Monad.Trans.Resource-import Data.Default+#endif -- | Data type for OAuth client (consumer).--- --- The constructor for this data type is not exposed. --- Instead, you should use the 'def' method or 'newOAuth' function to retrieve a default instance, +--+-- The constructor for this data type is not exposed.+-- Instead, you should use the 'def' method or 'newOAuth' function to retrieve a default instance, -- and then use the records below to make modifications. -- This approach allows us to add configuration options without breaking backwards compatibility. data OAuth = OAuth { oauthServerName :: String -- ^ Service name (default: @\"\"@)@@ -67,7 +71,7 @@ , oauthAuthorizeUri :: String -- ^ Uri to authorize (default: @\"\"@). -- You MUST specify if you use 'authorizeUrl' or 'authorizeZUrl'';- -- otherwise you can just leave this empty. + -- otherwise you can just leave this empty. , oauthSignatureMethod :: SignMethod -- ^ Signature Method (default: 'HMACSHA1') , oauthConsumerKey :: BS.ByteString@@ -156,7 +160,11 @@ -> 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 @@ -169,14 +177,18 @@ getTemporaryCredentialProxy p oa m = getTemporaryCredential' (addMaybeProxy p) oa m getTemporaryCredential' :: (MonadResource m, MonadBaseControl IO m)+#if MIN_VERSION_http_conduit(2, 0, 0)+ => (Request -> Request) -- ^ Request Hook+#else => (Request m -> Request m) -- ^ Request Hook+#endif -> OAuth -- ^ OAuth Application -> Manager -> m Credential -- ^ Temporary Credential (Request Token & Secret). getTemporaryCredential' hook oa manager = do let req = fromJust $ parseUrl $ oauthRequestUri oa crd = maybe id (insert "oauth_callback") (oauthCallback oa) $ emptyCredential- req' <- signOAuth oa crd $ hook (req { method = "POST" }) + req' <- signOAuth oa crd $ hook (req { method = "POST" }) rsp <- httpLbs req' manager if responseStatus rsp == status200 then do@@ -199,7 +211,7 @@ -> String -- ^ URL to authorize authorizeUrl' f oa cr = oauthAuthorizeUri oa ++ BS.unpack (renderSimpleQuery True queries) where fixed = ("oauth_token", token cr):f oa cr- queries = + queries = case oauthCallback oa of Nothing -> fixed Just callback -> ("oauth_callback", callback):fixed@@ -225,7 +237,11 @@ getAccessTokenProxy p = getAccessToken' $ addMaybeProxy p getAccessToken' :: (MonadResource m, MonadBaseControl IO m)+#if MIN_VERSION_http_conduit(2, 0, 0)+ => (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@@ -272,8 +288,13 @@ 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'@@ -311,7 +332,11 @@ , ("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@@ -323,7 +348,11 @@ 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 } @@ -339,7 +368,11 @@ 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 tok req = do let bsMtd = BS.map toUpper $ method req isHttps = secure req@@ -359,6 +392,34 @@ -- 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++toLBS' :: MonadUnsafeIO m => GivesPopper () -> m BS.ByteString+-- FIXME probably shouldn't be using MonadUnsafeIO+toLBS' gp = unsafeLiftIO $ do+ ref <- I.newIORef BS.empty+ gp (go ref)+ I.readIORef ref+ where+ go ref popper =+ loop id+ where+ loop front = do+ bs <- popper+ 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@@ -368,6 +429,7 @@ 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"@@ -379,5 +441,9 @@ 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 }
Web/Authenticate/OAuth/IO.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving #-}+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} -- | This Module provides interface for the instance of 'MonadIO' instead of 'MonadIO'. -- What this module do is just adding 'withManager' or 'runResourceT'.@@ -51,7 +52,11 @@ getTemporaryCredentialProxy p oa = liftIO $ withManager $ 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@@ -75,7 +80,11 @@ getAccessTokenProxy p oa cr = liftIO $ withManager $ 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)
authenticate-oauth.cabal view
@@ -1,6 +1,6 @@ name: authenticate-oauth-version: 1.4.0.7+version: 1.4.0.8 license: BSD3 license-file: LICENSE author: Hiromi Ishii