diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,7 @@ +## 1.5.1 + +* [Add getAccessTokenWith #42](https://github.com/yesodweb/authenticate/pull/42) + ## 1.5.0.2 * [Allow RSA-2.1 #41](https://github.com/yesodweb/authenticate/pull/41) diff --git a/Web/Authenticate/OAuth.hs b/Web/Authenticate/OAuth.hs --- a/Web/Authenticate/OAuth.hs +++ b/Web/Authenticate/OAuth.hs @@ -6,6 +6,14 @@ oauthAuthorizeUri, oauthSignatureMethod, oauthConsumerKey, oauthConsumerSecret, oauthCallback, oauthRealm, oauthVersion, OAuthVersion(..), SignMethod(..), Credential(..), OAuthException(..), + -- ** Access token request + AccessTokenRequest, + defaultAccessTokenRequest, + accessTokenAddAuth, + accessTokenRequestHook, + accessTokenOAuth, + accessTokenTemporaryCredential, + accessTokenManager, -- * Operations for credentials newCredential, emptyCredential, insert, delete, inserts, injectVerifier, -- * Signature @@ -16,12 +24,15 @@ getTemporaryCredentialProxy, getTemporaryCredential', -- ** Authorization URL authorizeUrl, authorizeUrl', + -- ** Attaching auth to requests + addAuthBody, -- ** Finishing authentication getAccessToken, getAccessTokenProxy, getTokenCredential, getTokenCredentialProxy, getAccessToken', + getAccessTokenWith, -- * Utility Methods paramEncode, addScope, addMaybeProxy ) where @@ -72,7 +83,7 @@ -- 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''; + -- You MUST specify if you use 'getAcessToken' or 'getAccessToken'' or 'getAccessTokenWith'; -- otherwise you can just leave this empty. , oauthAuthorizeUri :: String -- ^ Uri to authorize (default: @\"\"@). @@ -130,6 +141,53 @@ instance Exception OAuthException +-- | Data type for getAccessTokenWith method. +-- +-- You can create values of this type using 'defaultAccessTokenRequest'. +-- +-- Since 1.5.1 +data AccessTokenRequest = AccessTokenRequest { + accessTokenAddAuth :: (BS.ByteString -> Credential -> Request -> Request) + -- ^ add auth hook. + -- + -- Default: addAuthHeader + -- + -- Since 1.5.1 + , accessTokenRequestHook :: (Request -> Request) + -- ^ Request Hook. + -- + -- Default: @id@ + -- + -- Since 1.5.1 + , accessTokenOAuth :: OAuth + -- ^ OAuth Application + -- + -- Since 1.5.1 + , accessTokenTemporaryCredential :: Credential + -- ^ Temporary Credential (with oauth_verifier if >= 1.0a) + -- + -- Since 1.5.1 + , accessTokenManager :: Manager + -- ^ Manager + -- + -- Since 1.5.1 + } + +-- | Create a value of type 'AccessTokenRequest' with default values filled in. +-- +-- Note that this is a settings type. More information on usage can be found +-- at: . +-- +-- Since 1.5.1 +defaultAccessTokenRequest :: OAuth -> Credential -> Manager -> AccessTokenRequest +defaultAccessTokenRequest oauth cred man = AccessTokenRequest + { accessTokenAddAuth = addAuthHeader + , accessTokenRequestHook = id + , accessTokenOAuth = oauth + , accessTokenTemporaryCredential = cred + , accessTokenManager = man + } + ---------------------------------------------------------------------- -- Credentials @@ -185,11 +243,20 @@ -> Credential -- ^ Credential -> Request -- ^ Original Request -> m Request -- ^ Signed OAuth Request -signOAuth oa crd req = do +signOAuth oa crd req = signOAuth' oa crd addAuthHeader req + +-- | More flexible signOAuth +signOAuth' :: MonadIO m + => OAuth -- ^ OAuth Application + -> Credential -- ^ Credential + -> (BS.ByteString -> Credential -> Request -> Request) -- ^ signature style + -> Request -- ^ Original Request + -> m Request -- ^ Signed OAuth Request +signOAuth' oa crd add_auth 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 + return $ add_auth prefix (insert "oauth_signature" sign tok) req where prefix = case oauthRealm oa of Nothing -> "OAuth " @@ -307,22 +374,37 @@ -> m Credential -- ^ Token Credential (Access Token & Secret) getAccessTokenProxy p = getAccessToken' $ addMaybeProxy p - getAccessToken' :: MonadIO m => (Request -> Request) -- ^ Request Hook -> 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 <- 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 - return $ Credential dic - else liftIO . throwIO . OAuthException $ "Gaining OAuth Token Credential Failed: " ++ BSL.unpack (responseBody rsp) +getAccessToken' hook oauth cr manager = do + maybe_access_token <- getAccessTokenWith AccessTokenRequest { accessTokenAddAuth = addAuthHeader, accessTokenRequestHook = hook, accessTokenOAuth = oauth, accessTokenTemporaryCredential = cr, accessTokenManager = manager } + case maybe_access_token of + Left error_response -> liftIO . throwIO . OAuthException $ "Gaining OAuth Token Credential Failed: " ++ BSL.unpack (responseBody error_response) + Right access_token -> return access_token +getAccessTokenWith :: MonadIO m + => AccessTokenRequest -- ^ extensible parameters + -> m (Either (Response BSL.ByteString) Credential) -- ^ Token Credential (Access Token & Secret) or the conduit response on failures +getAccessTokenWith params = do + let req = hook (fromJust $ parseUrl $ oauthAccessTokenUri oa) { method = "POST" } + rsp <- liftIO $ flip httpLbs manager =<< signOAuth' oa (if oauthVersion oa == OAuth10 then delete "oauth_verifier" cr else cr) add_auth req + if responseStatus rsp == status200 + then do + let dic = parseSimpleQuery . toStrict . responseBody $ rsp + return $ Right $ Credential dic + else + return $ Left rsp + where + add_auth = accessTokenAddAuth params + hook = accessTokenRequestHook params + oa = accessTokenOAuth params + cr = accessTokenTemporaryCredential params + manager = accessTokenManager params + getTokenCredential = getAccessToken getTokenCredentialProxy = getAccessTokenProxy @@ -355,12 +437,25 @@ ] cred +-- | Place the authentication information in a URL encoded body instead of the Authorization header. +-- +-- Note that the first parameter is used for realm in addAuthHeader, and this +-- function needs the same type. The parameter, however, is unused. +-- +-- Since 1.5.1 +addAuthBody :: a -> Credential -> Request -> Request +addAuthBody _ (Credential cred) req = urlEncodedBody (filterCreds cred) req + addAuthHeader :: BS.ByteString -> Credential -> Request -> Request 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) +renderAuthHeader prefix = (prefix `BS.append`). BS.intercalate "," . map (\(a,b) -> BS.concat [paramEncode a, "=\"", paramEncode b, "\""]) . filterCreds + +filterCreds :: [(BS.ByteString, BS.ByteString)] -> [(BS.ByteString, BS.ByteString)] +filterCreds = filter ((`elem` ["oauth_token", "oauth_verifier", "oauth_consumer_key", "oauth_signature_method", "oauth_timestamp", "oauth_nonce", "oauth_version", "oauth_callback", "oauth_signature"]) . fst) + getBaseString :: MonadIO m => Credential -> Request -> m BSL.ByteString getBaseString tok req = do diff --git a/authenticate-oauth.cabal b/authenticate-oauth.cabal --- a/authenticate-oauth.cabal +++ b/authenticate-oauth.cabal @@ -1,5 +1,5 @@ name: authenticate-oauth -version: 1.5.0.3 +version: 1.5.1 license: BSD3 license-file: LICENSE author: Hiromi Ishii