authenticate-oauth 1.5.0.3 → 1.5.1

raw patch · 3 files changed

+113/−14 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• Web/Authenticate/OAuth.hs +108/−13
• authenticate-oauth.cabal +1/−1

@@ -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)

@@ -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: <http://www.yesodweb.com/book/settings-types>.+--+-- 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

@@ -1,5 +1,5 @@ name:            authenticate-oauth-version:         1.5.0.3+version:         1.5.1 license:         BSD3 license-file:    LICENSE author:          Hiromi Ishii