hoauth2 0.5.6.0 → 0.5.7
raw patch · 5 files changed
+93/−11 lines, 5 filesdep ~basenew-component:exe:test-dropboxPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
+ Network.OAuth.OAuth2.HttpClient: authPostBS' :: Manager -> AccessToken -> URI -> PostBody -> IO (OAuth2Result ByteString)
Files
- example/Dropbox/test.hs +39/−0
- example/Keys.hs.sample +7/−0
- hoauth2.cabal +25/−1
- src/Network/OAuth/OAuth2/HttpClient.hs +16/−2
- src/Network/OAuth/OAuth2/Internal.hs +6/−8
+ example/Dropbox/test.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Main where++import Control.Monad (liftM)+import Data.Aeson.TH (defaultOptions, deriveJSON)+import qualified Network.HTTP.Types as HT+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Network.HTTP.Conduit++import Network.OAuth.OAuth2++import Keys+++main :: IO ()+main = do+ print $ authorizationUrl dropboxKey+ putStrLn "visit the url and paste code here: "+ code <- fmap BS.pack getLine+ mgr <- newManager tlsManagerSettings+ token <- fetchAccessToken mgr dropboxKey code+ print token+ case token of+ Right at -> getSpaceUsage mgr at >>= print+ Left _ -> putStrLn "no access token found yet"++getSpaceUsage :: Manager -> AccessToken -> IO (OAuth2Result BSL.ByteString)+getSpaceUsage mgr token = do+ req <- parseRequest $ BS.unpack "https://api.dropboxapi.com/2/users/get_space_usage"+ authRequest req upReq mgr+ where upHeaders = updateRequestHeaders (Just token) . setMethod HT.POST+ upBody req = req {requestBody = "null" }+ upReq = upHeaders . upBody
example/Keys.hs.sample view
@@ -61,3 +61,10 @@ , oauthOAuthorizeEndpoint = "https://stackexchange.com/oauth" , oauthAccessTokenEndpoint = "https://stackexchange.com/oauth/access_token" }+dropboxKey :: OAuth2+dropboxKey = OAuth2 { oauthClientId = "xxx"+ , oauthClientSecret = "xxx"+ , oauthCallback = Just "http://localhost:9988/oauth2/callback"+ , oauthOAuthorizeEndpoint = "https://www.dropbox.com/1/oauth2/authorize"+ , oauthAccessTokenEndpoint = "https://api.dropboxapi.com/oauth2/token"+ }
hoauth2.cabal view
@@ -1,6 +1,6 @@ Name: hoauth2 -- http://wiki.haskell.org/Package_versioning_policy-Version: 0.5.6.0+Version: 0.5.7 Synopsis: Haskell OAuth2 authentication client Description:@@ -237,3 +237,27 @@ -fno-warn-unused-do-bind else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields++Executable test-dropbox+ if flag(test)+ Buildable: True+ else+ Buildable: False++ main-is: Dropbox/test.hs+ hs-source-dirs: example+ default-language: Haskell2010+ build-depends: base >= 4.5 && < 5,+ http-types >= 0.9 && < 0.10,+ http-conduit >= 2.2 && < 2.3,+ text >= 0.11 && < 1.3,+ bytestring >= 0.9 && < 0.11,+ aeson >= 1.0 && < 1.1,+ hoauth2++ if impl(ghc >= 6.12.0)+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields+ -fno-warn-unused-do-bind+ else+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields+
src/Network/OAuth/OAuth2/HttpClient.hs view
@@ -16,6 +16,7 @@ authGetBS', authPostJSON, authPostBS,+ authPostBS', authRequest, -- * Utilities handleResponse,@@ -144,6 +145,19 @@ upHeaders = updateRequestHeaders (Just token) . setMethod HT.POST upReq = upHeaders . upBody +-- | Conduct POST request with access token in the request body rather header+authPostBS' :: Manager -- ^ HTTP connection manager.+ -> AccessToken+ -> URI -- ^ URL+ -> PostBody+ -> IO (OAuth2Result BSL.ByteString) -- ^ Response as ByteString+authPostBS' manager token url pb = do+ req <- parseUrl $ BS.unpack url+ authRequest req upReq manager+ where upBody = urlEncodedBody (pb ++ accessTokenToParam token)+ upHeaders = updateRequestHeaders Nothing . setMethod HT.POST+ upReq = upHeaders . upBody+ -- |Send an HTTP request including the Authorization header with the specified -- access token. --@@ -162,7 +176,7 @@ handleResponse rsp = if HT.statusIsSuccessful (responseStatus rsp) then Right $ responseBody rsp- else Left $ BSL.append "hoauth2.HttpClient.parseResponseJSON/Gaining token failed: " (responseBody rsp)+ else Left $ BSL.append "hoauth2.HttpClient.handleResponse/Gaining token failed: " (responseBody rsp) -- | Parses a @OAuth2Result BSL.ByteString@ into @FromJSON a => a@ parseResponseJSON :: FromJSON a@@ -186,7 +200,7 @@ where queryToValue = Object . HM.fromList . map paramToPair paramToPair (k, mv) = (T.decodeUtf8 k, maybe Null (String . T.decodeUtf8) mv)- errorMessage = ("hoauth2.HttpClient.parseResponseJSON/Could not decode JSON or URL: " `BSL.append` b)+ errorMessage = "hoauth2.HttpClient.parseResponseJSON/Could not decode JSON or URL: " `BSL.append` b -- | Try 'parseResponseJSON' and 'parseResponseString' parseResponseFlexible :: FromJSON a
src/Network/OAuth/OAuth2/Internal.hs view
@@ -96,11 +96,10 @@ -> (URI, PostBody) -- ^ access token request URL plus the request body. accessTokenUrl' oa code gt = (uri, body) where uri = oauthAccessTokenEndpoint oa- body = transform' [ ("client_id", Just $ oauthClientId oa)- , ("client_secret", Just $ oauthClientSecret oa)- , ("code", Just code)+ body = transform' [ ("code", Just code) , ("redirect_uri", oauthCallback oa)- , ("grant_type", gt) ]+ , ("grant_type", gt)+ ] -- | Using a Refresh Token. Obtain a new access token by -- sending a refresh token to the Authorization server.@@ -109,10 +108,9 @@ -> (URI, PostBody) -- ^ refresh token request URL plus the request body. refreshAccessTokenUrl oa rtoken = (uri, body) where uri = oauthAccessTokenEndpoint oa- body = transform' [ ("client_id", Just $ oauthClientId oa)- , ("client_secret", Just $ oauthClientSecret oa)- , ("grant_type", Just "refresh_token")- , ("refresh_token", Just rtoken) ]+ body = transform' [ ("grant_type", Just "refresh_token")+ , ("refresh_token", Just rtoken)+ ] -------------------------------------------------- -- * UTILs