From d68d7b0d729399f5c06a6ca47a4418145add919d Mon Sep 17 00:00:00 2001 From: Hiromi Ishii Date: Thu, 2 Feb 2012 20:39:09 +0900 Subject: [PATCH] * Hide the constructor of 'OAuth' and make it an instance of 'Default' instead. * Added compatibility modules for ResourceIO data types. * Modified 'authorizeUrl' and added 'authorizeUrl'' function. thx!>darrint --- authenticate-oauth/Web/Authenticate/OAuth.hs | 84 +++++++++++----- .../Web/Authenticate/OAuth/IO.hs | 95 +++++++++++++++++++ authenticate-oauth/authenticate-oauth.cabal | 3 +- 3 files changed, 158 insertions(+), 24 deletions(-) create mode 100644 authenticate-oauth/Web/Authenticate/OAuth/IO.hs diff --git a/authenticate-oauth/Web/Authenticate/OAuth.hs b/authenticate-oauth/Web/Authenticate/OAuth.hs index 1211f5bd..d18c5fa3 100644 --- a/authenticate-oauth/Web/Authenticate/OAuth.hs +++ b/authenticate-oauth/Web/Authenticate/OAuth.hs @@ -2,13 +2,16 @@ {-# OPTIONS_GHC -Wall -fno-warn-orphans #-} module Web.Authenticate.OAuth ( -- * Data types - OAuth(..), newOAuth, SignMethod(..), Credential(..), OAuthException(..), + OAuth(oauthServerName, oauthRequestUri, oauthAccessTokenUri, oauthAuthorizeUri, + oauthSignatureMethod, oauthConsumerKey, oauthConsumerSecret, oauthCallback, + oauthRealm), + def, newOAuth, SignMethod(..), Credential(..), OAuthException(..), -- * Operations for credentials newCredential, emptyCredential, insert, delete, inserts, -- * Signature signOAuth, genSign, -- * Url & operation for authentication - authorizeUrl, getAccessToken, getTemporaryCredential, + authorizeUrl, authorizeUrl', getAccessToken, getTemporaryCredential, getTokenCredential, getTemporaryCredentialWithScope, getAccessTokenProxy, getTemporaryCredentialProxy, getTokenCredentialProxy, @@ -22,7 +25,7 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Maybe import Control.Applicative -import Network.HTTP.Types (parseSimpleQuery) +import Network.HTTP.Types (parseSimpleQuery, SimpleQuery) import Control.Exception import Control.Monad import Data.List (sortBy) @@ -42,18 +45,38 @@ import qualified Data.Conduit.List as CL import Data.Conduit.Blaze (builderToByteString) import Blaze.ByteString.Builder (Builder) import Control.Monad.IO.Class (liftIO) +import Data.Default -- | Data type for OAuth client (consumer). --- The default values apply when you use 'newOAuth' -data OAuth = OAuth { oauthServerName :: String -- ^ Service name (You MUST specify) - , oauthRequestUri :: String -- ^ URI to request temporary credential (You MUST specify) - , oauthAccessTokenUri :: String -- ^ Uri to obtain access token (You MUST specify) - , oauthAuthorizeUri :: String -- ^ Uri to authorize (You MUST specify) - , oauthSignatureMethod :: SignMethod -- ^ Signature Method (default: 'HMACSHA1') - , oauthConsumerKey :: BS.ByteString -- ^ Consumer key (You MUST specify) - , oauthConsumerSecret :: BS.ByteString -- ^ Consumer Secret (You MUST specify) - , oauthCallback :: Maybe BS.ByteString -- ^ Callback uri to redirect after authentication (default: 'Nothing') - , oauthRealm :: Maybe BS.ByteString -- ^ Optional authorization realm (default: 'Nothing') +-- +-- 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: @""@) + , oauthRequestUri :: String + -- ^ URI to request temporary credential (default: @""@). + -- You MUST specify if you use 'getTemporaryCredential\'', 'getTemporaryCredentialProxy' + -- or 'getTemporaryCredential'; otherwise you can just leave this empty. + , oauthAccessTokenUri :: String + -- ^ Uri to obtain access token (default: @""@). + -- You MUST specify if you use 'getAcessToken' or 'getAccessToken\''; + -- otherwise you can just leave this empty. + , oauthAuthorizeUri :: String + -- ^ Uri to authorize (default: @""@). + -- You MUST specify if you use 'authorizeUrl' or 'authorizeUrl\''; + -- otherwise you can just leave this empty. + , oauthSignatureMethod :: SignMethod + -- ^ Signature Method (default: 'HMACSHA1') + , oauthConsumerKey :: BS.ByteString + -- ^ Consumer key (You MUST specify) + , oauthConsumerSecret :: BS.ByteString + -- ^ Consumer Secret (You MUST specify) + , oauthCallback :: Maybe BS.ByteString + -- ^ Callback uri to redirect after authentication (default: @Nothing@) + , oauthRealm :: Maybe BS.ByteString + -- ^ Optional authorization realm (default: @Nothing@) } deriving (Show, Eq, Ord, Read, Data, Typeable) -- | Default value for OAuth datatype. @@ -62,14 +85,17 @@ newOAuth :: OAuth newOAuth = OAuth { oauthSignatureMethod = HMACSHA1 , oauthCallback = Nothing , oauthRealm = Nothing - , oauthServerName = error "oauthServerName" - , oauthRequestUri = error "oauthRequestUri" - , oauthAccessTokenUri = error "oauthAccessTokenUri" - , oauthAuthorizeUri = error "oauthAuthorizeUri" - , oauthConsumerKey = error "oauthConsumerKey" - , oauthConsumerSecret = error "oauthConsumerSecret" + , oauthServerName = "" + , oauthRequestUri = "" + , oauthAccessTokenUri = "" + , oauthAuthorizeUri = "" + , oauthConsumerKey = error "You MUST specify oauthConsumerKey parameter." + , oauthConsumerSecret = error "You MUST specify oauthConsumerSecret parameter." } +instance Default OAuth where + def = newOAuth + -- | Data type for signature method. data SignMethod = PLAINTEXT | HMACSHA1 @@ -158,10 +184,22 @@ getTemporaryCredential' hook oa manager = do authorizeUrl :: OAuth -- ^ OAuth Application -> Credential -- ^ Temporary Credential (Request Token & Secret) -> String -- ^ URL to authorize -authorizeUrl oa cr = oauthAuthorizeUri oa ++ BS.unpack (renderSimpleQuery True queries) - where queries = case oauthCallback oa of - Nothing -> [("oauth_token", token cr)] - Just callback -> [("oauth_token", token cr), ("oauth_callback", callback)] +authorizeUrl = authorizeUrl' $ \oa -> const [("oauth_consumer_key", oauthConsumerKey oa)] + +-- | Convert OAuth and Credential to URL to obatin OAuth Verifier. +-- This takes function to choice parameter to pass to the server other than +-- /oauth_callback/ or /oauth_token/. +authorizeUrl' :: (OAuth -> Credential -> SimpleQuery) + -> OAuth -- ^ OAuth Application + -> Credential -- ^ Temporary Credential (Request Token & Secret) + -> 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 = + case oauthCallback oa of + Nothing -> fixed + Just callback -> ("oauth_callback", callback):fixed + -- | Get Access token. getAccessToken, getTokenCredential diff --git a/authenticate-oauth/Web/Authenticate/OAuth/IO.hs b/authenticate-oauth/Web/Authenticate/OAuth/IO.hs new file mode 100644 index 00000000..dee73c31 --- /dev/null +++ b/authenticate-oauth/Web/Authenticate/OAuth/IO.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, StandaloneDeriving #-} +{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} +-- | This Module provides interface for the instance of ResouceIO instead of ResourceT. +-- What this module do is just adding 'withManager' or 'runResourceT'. +module Web.Authenticate.OAuth.IO + ( + module Web.Authenticate.OAuth, + getAccessToken, signOAuth, + getTemporaryCredential, getTemporaryCredentialWithScope, + getTemporaryCredentialProxy, getTemporaryCredential', + getTokenCredential, + getAccessTokenProxy, getTokenCredentialProxy, + getAccessToken', genSign + ) where +import Network.HTTP.Conduit +import qualified Web.Authenticate.OAuth as OA +import Web.Authenticate.OAuth hiding + (getAccessToken, signOAuth, + getTemporaryCredential, getTemporaryCredentialWithScope, + getTemporaryCredentialProxy, getTemporaryCredential', + getTokenCredential, getTemporaryCredentialWithScope, + getAccessTokenProxy, getTemporaryCredentialProxy, + getTokenCredentialProxy, genSign, + getAccessToken', getTemporaryCredential') +import Data.Conduit +import qualified Data.ByteString.Char8 as BS + + +-- | Get temporary credential for requesting acces token. +getTemporaryCredential :: ResourceIO m + => OA.OAuth -- ^ OAuth Application + -> m OA.Credential -- ^ Temporary Credential (Request Token & Secret). +getTemporaryCredential = withManager . OA.getTemporaryCredential + +-- | Get temporary credential for requesting access token with Scope parameter. +getTemporaryCredentialWithScope :: ResourceIO m + => BS.ByteString -- ^ Scope parameter string + -> OAuth -- ^ OAuth Application + -> m Credential -- ^ Temporay Credential (Request Token & Secret). +getTemporaryCredentialWithScope bs oa = + withManager $ OA.getTemporaryCredentialWithScope bs oa + + +-- | Get temporary credential for requesting access token via the proxy. +getTemporaryCredentialProxy :: ResourceIO m + => Maybe Proxy -- ^ Proxy + -> OAuth -- ^ OAuth Application + -> m Credential -- ^ Temporary Credential (Request Token & Secret). +getTemporaryCredentialProxy p oa = withManager $ OA.getTemporaryCredential' (addMaybeProxy p) oa + +getTemporaryCredential' :: ResourceIO m + => (Request m -> Request m) -- ^ Request Hook + -> OAuth -- ^ OAuth Application + -> m Credential -- ^ Temporary Credential (Request Token & Secret). +getTemporaryCredential' hook oa = withManager $ OA.getTemporaryCredential' hook oa + + +-- | Get Access token. +getAccessToken, getTokenCredential + :: ResourceIO m + => OAuth -- ^ OAuth Application + -> Credential -- ^ Temporary Credential with oauth_verifier + -> m Credential -- ^ Token Credential (Access Token & Secret) +getAccessToken oa cr = withManager $ OA.getAccessToken oa cr + +-- | Get Access token via the proxy. +getAccessTokenProxy, getTokenCredentialProxy + :: ResourceIO m + => Maybe Proxy -- ^ Proxy + -> OAuth -- ^ OAuth Application + -> Credential -- ^ Temporary Credential with oauth_verifier + -> m Credential -- ^ Token Credential (Access Token & Secret) +getAccessTokenProxy p oa cr = withManager $ OA.getAccessTokenProxy p oa cr + +getAccessToken' :: ResourceIO m + => (Request m -> Request m) -- ^ Request Hook + -> OAuth -- ^ OAuth Application + -> Credential -- ^ Temporary Credential with oauth_verifier + -> m Credential -- ^ Token Credential (Access Token & Secret) +getAccessToken' hook oa cr = withManager $ OA.getAccessToken' hook oa cr + + +getTokenCredential = getAccessToken +getTokenCredentialProxy = getAccessTokenProxy + +-- | Add OAuth headers & sign to 'Request' +signOAuth :: ResourceIO m + => OAuth -- ^ OAuth Application + -> Credential -- ^ Credential + -> Request m -- ^ Original Request + -> m (Request m) -- ^ Signed OAuth Request +signOAuth oa crd req = runResourceT $ OA.signOAuth oa crd req + +genSign :: ResourceIO m => OAuth -> Credential -> Request m -> m BS.ByteString +genSign oa tok req = runResourceT $ OA.genSign oa tok req diff --git a/authenticate-oauth/authenticate-oauth.cabal b/authenticate-oauth/authenticate-oauth.cabal index 06ccc03f..188b86f0 100644 --- a/authenticate-oauth/authenticate-oauth.cabal +++ b/authenticate-oauth/authenticate-oauth.cabal @@ -19,6 +19,7 @@ library , bytestring >= 0.9 , RSA >= 1.0 && < 1.1 , time + , data-default >= 0.3 && < 0.4 , base64-bytestring >= 0.1 && < 0.2 , SHA >= 1.4 && < 1.6 , random @@ -26,7 +27,7 @@ library , blaze-builder , conduit >= 0.2 && < 0.3 , blaze-builder-conduit >= 0.2 && < 0.3 - exposed-modules: Web.Authenticate.OAuth + exposed-modules: Web.Authenticate.OAuth, Web.Authenticate.OAuth.IO ghc-options: -Wall source-repository head