changed type-class constaring.
This commit is contained in:
Hiromi Ishii
parent
cd0afdf2d5
commit
73eb78c446
@ -39,12 +39,13 @@ 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 (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 :: BS.ByteString -> Credential -> Credential
|
||||
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 PLAINTEXT = "PLAINTEXT"
|
||||
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 @@ injectOAuthToCred oa cred =
|
||||
, ("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 @@ paramEncode = BS.concatMap escape
|
||||
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 @@ getBaseString tok req = do
|
||||
-- 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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -5,7 +5,7 @@ license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Hiromi Ishii
|
||||
maintainer: Hiromi Ishii
|
||||
synopsis: Library to authenticate via OAuth for Haskell web applications.
|
||||
synopsis: Library to authenticate with OAuth for Haskell web applications.
|
||||
description: OAuth authentication, e.g. Twitter.
|
||||
category: Web
|
||||
stability: Stable
|
||||
@ -27,6 +27,7 @@ library
|
||||
, http-types >= 0.6 && < 0.7
|
||||
, blaze-builder
|
||||
, 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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user