diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs --- a/Web/Authenticate/OAuth.hs +++ b/Web/Authenticate/OAuth.hs @@ -39,12 +39,13 @@ import Blaze.ByteString.Builder (toByteString) import Control.Monad.IO.Class (MonadIO) import Network.HTTP.Types (renderSimpleQuery, status200) -import Data.Conduit (MonadResource, ($$), ($=), Source) +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 -- | Data type for OAuth client (consumer). @@ -271,7 +272,7 @@ injectVerifier = insert "oauth_verifier" -- | Add OAuth headers & sign to 'Request'. -signOAuth :: (MonadResource m) +signOAuth :: (MonadUnsafeIO m) => OAuth -- ^ OAuth Application -> Credential -- ^ Credential -> Request m -- ^ Original Request @@ -296,14 +297,14 @@ showSigMtd HMACSHA1 = "HMAC-SHA1" showSigMtd (RSASHA1 _) = "RSA-SHA1" -addNonce :: MonadResource m => Credential -> m Credential +addNonce :: MonadUnsafeIO m => Credential -> m Credential addNonce cred = do - nonce <- liftIO $ replicateM 10 (randomRIO ('a','z')) -- FIXME very inefficient + nonce <- unsafeLiftIO $ replicateM 10 (randomRIO ('a','z')) -- FIXME very inefficient return $ insert "oauth_nonce" (BS.pack nonce) cred -addTimeStamp :: MonadResource m => Credential -> m Credential +addTimeStamp :: MonadUnsafeIO m => Credential -> m Credential addTimeStamp cred = do - stamp <- (floor . (`diffUTCTime` baseTime)) `liftM` liftIO getCurrentTime + stamp <- (floor . (`diffUTCTime` baseTime)) `liftM` unsafeLiftIO getCurrentTime return $ insert "oauth_timestamp" (BS.pack $ show (stamp :: Integer)) cred injectOAuthToCred :: OAuth -> Credential -> Credential @@ -313,7 +314,7 @@ , ("oauth_version", "1.0") ] cred -genSign :: MonadResource m => OAuth -> Credential -> Request m -> m BS.ByteString +genSign :: MonadUnsafeIO m => OAuth -> Credential -> Request m -> m BS.ByteString genSign oa tok req = case oauthSignatureMethod oa of HMACSHA1 -> do @@ -341,7 +342,7 @@ oct = '%' : replicate (2 - length num) '0' ++ num in BS.pack oct -getBaseString :: MonadResource m => Credential -> Request m -> m BSL.ByteString +getBaseString :: MonadUnsafeIO m => Credential -> Request m -> m BSL.ByteString getBaseString tok req = do let bsMtd = BS.map toUpper $ method req isHttps = secure req @@ -361,14 +362,14 @@ -- So this is OK. return $ BSL.intercalate "&" $ map (fromStrict.paramEncode) [bsMtd, bsURI, bsParams] -toLBS :: MonadResource m => RequestBody m -> m BS.ByteString +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' :: MonadResource m => Source m Builder -> m BS.ByteString +toLBS' :: MonadUnsafeIO m => Source m Builder -> m BS.ByteString toLBS' src = liftM BS.concat $ src $= builderToByteString $$ CL.consume isBodyFormEncoded :: [Header] -> Bool 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 @@ -1,10 +1,86 @@ {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} --- | This module is deprecated due to the interface change at conduit-0.3. --- For now, this package only re-exports 'Web.Authenticate.OAuth' module. +-- | This Module provides interface for the instance of 'MonadIO' instead of 'MonadIO'. +-- What this module do is just adding 'withManager' or 'runResourceT'. module Web.Authenticate.OAuth.IO - {-# DEPRECATED "This module is deprecated; use Web.Authenticate.OAuth instead." #-} + {-# DEPRECATED "This module is deprecated; rewrite your code using MonadResource" #-} ( module Web.Authenticate.OAuth, + getAccessToken, + getTemporaryCredential, getTemporaryCredentialWithScope, + getTemporaryCredentialProxy, getTemporaryCredential', + getTokenCredential, + getAccessTokenProxy, getTokenCredentialProxy, + getAccessToken' ) where -import Web.Authenticate.OAuth +import Network.HTTP.Conduit +import qualified Web.Authenticate.OAuth as OA +import Web.Authenticate.OAuth hiding + (getAccessToken, + getTemporaryCredential, getTemporaryCredentialWithScope, + getTemporaryCredentialProxy, getTemporaryCredential', + getTokenCredential, getTemporaryCredentialWithScope, + getAccessTokenProxy, getTemporaryCredentialProxy, + getTokenCredentialProxy, + getAccessToken', getTemporaryCredential') +import Data.Conduit +import Control.Monad.IO.Class +import qualified Data.ByteString.Char8 as BS + + +-- | Get temporary credential for requesting acces token. +getTemporaryCredential :: MonadIO m + => OA.OAuth -- ^ OAuth Application + -> m OA.Credential -- ^ Temporary Credential (Request Token & Secret). +getTemporaryCredential = liftIO . withManager . OA.getTemporaryCredential + +-- | Get temporary credential for requesting access token with Scope parameter. +getTemporaryCredentialWithScope :: MonadIO m + => BS.ByteString -- ^ Scope parameter string + -> OAuth -- ^ OAuth Application + -> m Credential -- ^ Temporay Credential (Request Token & Secret). +getTemporaryCredentialWithScope bs oa = + liftIO $ withManager $ OA.getTemporaryCredentialWithScope bs oa + + +-- | Get temporary credential for requesting access token via the proxy. +getTemporaryCredentialProxy :: MonadIO m + => Maybe Proxy -- ^ Proxy + -> OAuth -- ^ OAuth Application + -> m Credential -- ^ Temporary Credential (Request Token & Secret). +getTemporaryCredentialProxy p oa = liftIO $ withManager $ OA.getTemporaryCredential' (addMaybeProxy p) oa + +getTemporaryCredential' :: MonadIO m + => (Request (ResourceT IO) -> Request (ResourceT IO)) -- ^ Request Hook + -> OAuth -- ^ OAuth Application + -> m Credential -- ^ Temporary Credential (Request Token & Secret). +getTemporaryCredential' hook oa = liftIO $ withManager $ OA.getTemporaryCredential' hook oa + + +-- | Get Access token. +getAccessToken, getTokenCredential + :: MonadIO m + => 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 + +-- | Get Access token via the proxy. +getAccessTokenProxy, getTokenCredentialProxy + :: MonadIO m + => Maybe Proxy -- ^ Proxy + -> 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 + +getAccessToken' :: MonadIO m + => (Request (ResourceT IO) -> Request (ResourceT IO)) -- ^ Request Hook + -> 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 + + +getTokenCredential = getAccessToken +getTokenCredentialProxy = getAccessTokenProxy diff --git a/authenticate-oauth.cabal b/authenticate-oauth.cabal --- a/authenticate-oauth.cabal +++ b/authenticate-oauth.cabal @@ -1,10 +1,11 @@ + name: authenticate-oauth -version: 1.2.0 +version: 1.3.0 license: BSD3 license-file: LICENSE author: Hiromi Ishii maintainer: Hiromi Ishii -synopsis: Authentication methods for Haskell web applications. +synopsis: Library to authenticate with OAuth for Haskell web applications. description: OAuth authentication, e.g. Twitter. category: Web stability: Stable @@ -14,7 +15,7 @@ library build-depends: base >= 4 && < 5 - , http-conduit >= 1.3 && < 1.4 + , http-conduit >= 1.4 && < 1.5 , transformers >= 0.1 && < 0.3 , bytestring >= 0.9 , RSA >= 1.0 && < 1.1 @@ -25,8 +26,9 @@ , random , http-types >= 0.6 && < 0.7 , blaze-builder - , conduit >= 0.3 && < 0.4 - , blaze-builder-conduit >= 0.3 && < 0.4 + , conduit >= 0.4 && < 0.5 + , resourcet >= 0.3 && < 0.4 + , blaze-builder-conduit >= 0.4 && < 0.5 , monad-control >= 0.3 && < 0.4 exposed-modules: Web.Authenticate.OAuth, Web.Authenticate.OAuth.IO ghc-options: -Wall