hoauth2 0.3.7 → 0.4.0
raw patch · 10 files changed
+287/−150 lines, 10 filesdep +hoauth2dep −conduitdep −resourcetdep ~basedep ~http-conduitdep ~mtlnew-component:exe:test-doubannew-component:exe:test-fbnew-component:exe:test-githubnew-component:exe:test-googlenew-component:exe:test-weibo
Dependencies added: hoauth2
Dependencies removed: conduit, resourcet
Dependency ranges changed: base, http-conduit, mtl, transformers
Files
- README.md +2/−6
- example/Douban/test.hs +38/−0
- example/Facebook/test.hs +18/−21
- example/Github/test.hs +12/−16
- example/Google/test.hs +52/−45
- example/Keys.hs.sample +8/−0
- example/Weibo/test.hs +16/−20
- hoauth2.cabal +103/−9
- src/Network/OAuth/OAuth2/HttpClient.hs +37/−31
- src/Network/OAuth/OAuth2/Internal.hs +1/−2
README.md view
@@ -1,13 +1,9 @@ [](http://travis-ci.org/freizl/hoauth2) -## Introduction+# Introduction A lightweight oauth2 haskell binding. See examples in `example/` folder. -In additions, [snaplet-oauth] use this lib as well.--[snaplet-oauth]: https://github.com/HaskellCNOrg/snaplet-oauth--## Contribute+# Contribute Feel free send pull request or submit issue ticket.
+ example/Douban/test.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++{-++douban oauth2: http://developers.douban.com/wiki/?title=oauth2++-}++module Main where++import qualified Data.ByteString 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 doubanKey+ putStrLn "visit the url and paste code here: "+ code <- getLine+ mgr <- newManager conduitManagerSettings+ token <- fetchAccessToken mgr doubanKey (sToBS code)+ print token+ case token of+ Right r -> do+ uid <- authGetBS mgr r "https://api.douban.com/v2/user/~me"+ print uid+ Left l -> BSL.putStrLn l+ closeManager mgr++sToBS :: String -> BS.ByteString+sToBS = T.encodeUtf8 . T.pack
example/Facebook/test.hs view
@@ -6,21 +6,17 @@ module Main where -import Keys (facebookKey)+import Keys (facebookKey) import Network.OAuth.OAuth2-import Network.OAuth.OAuth2.HttpClient -import Control.Applicative ((<$>), (<*>))-import Control.Monad (mzero)-import Data.Aeson (FromJSON, Value (Object),- parseJSON, (.:), (.:?))-import Data.Aeson.TH (deriveJSON, defaultOptions)-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BL-import Data.Text (Text)-import Prelude hiding (id)-import qualified Prelude as P (id)-import System.Environment (getArgs)+import Data.Aeson (FromJSON)+import Data.Aeson.TH (defaultOptions, deriveJSON)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Text (Text)+import Network.HTTP.Conduit+import Prelude hiding (id)+import qualified Prelude as P (id) -------------------------------------------------- @@ -38,10 +34,12 @@ print $ authorizationUrl facebookKey `appendQueryParam` facebookScope putStrLn "visit the url and paste code here: " code <- fmap BS.pack getLine+ mgr <- newManager conduitManagerSettings let (url, body) = accessTokenUrl facebookKey code- (Right token) <- doJSONPostRequest facebookKey url (body ++ [("state", "test")])- userinfo token >>= print- userinfo' token >>= print+ (Right token) <- doJSONPostRequest mgr facebookKey url (body ++ [("state", "test")])+ userinfo mgr token >>= print+ userinfo' mgr token >>= print+ closeManager mgr -------------------------------------------------- -- FaceBook API@@ -51,9 +49,8 @@ facebookScope = [("scope", "user_about_me,email")] -- | Fetch user id and email.-userinfo :: AccessToken -> IO (OAuth2Result BL.ByteString)-userinfo token = authGetBS token "https://graph.facebook.com/me?fields=id,name,email&"--userinfo' :: FromJSON User => AccessToken -> IO (OAuth2Result User)-userinfo' token = authGetJSON token "https://graph.facebook.com/me?fields=id,name,email"+userinfo :: Manager -> AccessToken -> IO (OAuth2Result BL.ByteString)+userinfo mgr token = authGetBS mgr token "https://graph.facebook.com/me?fields=id,name,email&" +userinfo' :: FromJSON User => Manager -> AccessToken -> IO (OAuth2Result User)+userinfo' mgr token = authGetJSON mgr token "https://graph.facebook.com/me?fields=id,name,email"
example/Github/test.hs view
@@ -6,21 +6,15 @@ module Main where import Control.Applicative-import Control.Monad (mzero)-import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad (mzero) import Data.Aeson-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import Data.Conduit (MonadResource)-import Data.Maybe (fromJust)-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import qualified Data.ByteString as BS+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import Network.HTTP.Conduit-import qualified Network.HTTP.Types as HT import Network.OAuth.OAuth2-import Network.OAuth.OAuth2.HttpClient import Keys @@ -31,18 +25,20 @@ print $ authorizationUrl githubKey `appendQueryParam` [("state", state)] putStrLn "visit the url and paste code here: " code <- getLine+ mgr <- newManager conduitManagerSettings let (url, body) = accessTokenUrl githubKey (sToBS code)- token <- doJSONPostRequest githubKey url (body ++ [("state", state)])+ token <- doJSONPostRequest mgr githubKey url (body ++ [("state", state)]) print (token :: OAuth2Result AccessToken) case token of- Right at -> userInfo at >>= print- Left l -> print "no access token found yet"+ Right at -> userInfo mgr at >>= print+ Left _ -> putStrLn "no access token found yet"+ closeManager mgr -- | Test API: user ---userInfo :: AccessToken -> IO (OAuth2Result GithubUser)-userInfo token = authGetJSON token "https://api.github.com/user"+userInfo :: Manager -> AccessToken -> IO (OAuth2Result GithubUser)+userInfo mgr token = authGetJSON mgr token "https://api.github.com/user" data GithubUser = GithubUser { gid :: Integer , gname :: Text
example/Google/test.hs view
@@ -13,33 +13,29 @@ module Main where -import Keys (googleKey)+import Keys (googleKey) import Network.OAuth.OAuth2-import Network.OAuth.OAuth2.HttpClient -import Control.Applicative ((<$>), (<*>))-import Control.Monad (mzero)-import Data.Aeson (FromJSON, Value (Object),- parseJSON, (.:), (.:?))-import Data.Aeson.TH (deriveJSON, defaultOptions)-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Internal as BL-import Data.Text (Text)-import Network.HTTP.Types (renderSimpleQuery)-import Prelude hiding (id)-import qualified Prelude as P (id)-import System.Environment (getArgs)+import Data.Aeson (FromJSON)+import Data.Aeson.TH (defaultOptions, deriveJSON)+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy.Internal as BL+import Data.Text (Text)+import Network.HTTP.Conduit+import Prelude hiding (id)+import qualified Prelude as P (id)+import System.Environment (getArgs) -------------------------------------------------- -data Token = Token { issued_to :: Text- , audience :: Text- , user_id :: Maybe Text- , scope :: Text- , expires_in :: Integer+data Token = Token { issued_to :: Text+ , audience :: Text+ , user_id :: Maybe Text+ , scope :: Text+ , expires_in :: Integer -- , email :: Maybe Text -- , verified_email :: Maybe Bool- , access_type :: Text+ , access_type :: Text } deriving (Show) @@ -63,16 +59,18 @@ main :: IO () main = do xs <- getArgs+ mgr <- newManager conduitManagerSettings case xs of- ["offline"] -> offlineCase- _ -> normalCase+ ["offline"] -> offlineCase mgr+ _ -> normalCase mgr+ closeManager mgr -offlineCase :: IO ()-offlineCase = do+offlineCase :: Manager -> IO ()+offlineCase mgr = do BS.putStrLn $ authorizationUrl googleKey `appendQueryParam` (googleScopeEmail ++ googleAccessOffline) putStrLn "visit the url and paste code here: " code <- fmap BS.pack getLine- (Right token) <- fetchAccessToken googleKey code+ (Right token) <- fetchAccessToken mgr googleKey code f token -- -- obtain a new access token with refresh token, which turns out only in response at first time.@@ -81,30 +79,30 @@ case refreshToken token of Nothing -> putStrLn "Failed to fetch refresh token" Just tk -> do- (Right token) <- fetchRefreshToken googleKey tk- f token+ (Right token') <- fetchRefreshToken mgr googleKey tk+ f token' --validateToken accessToken >>= print --(validateToken' accessToken :: IO (OAuth2Result Token)) >>= print where f token = do print token- validateToken token >>= print- (validateToken' token :: IO (OAuth2Result Token)) >>= print+ validateToken mgr token >>= print+ (validateToken' mgr token :: IO (OAuth2Result Token)) >>= print -normalCase :: IO ()-normalCase = do+normalCase :: Manager -> IO ()+normalCase mgr = do BS.putStrLn $ authorizationUrl googleKey `appendQueryParam` googleScopeUserInfo putStrLn "visit the url and paste code here: " code <- fmap BS.pack getLine- (Right token) <- fetchAccessToken googleKey code+ (Right token) <- fetchAccessToken mgr googleKey code putStr "AccessToken: " >> print token -- get response in ByteString- validateToken token >>= print+ validateToken mgr token >>= print -- get response in JSON- (validateToken' token :: IO (OAuth2Result Token)) >>= print+ (validateToken' mgr token :: IO (OAuth2Result Token)) >>= print -- get response in ByteString- userinfo token >>= print+ userinfo mgr token >>= print -- get response in JSON- (userinfo' token :: IO (OAuth2Result User)) >>= print+ (userinfo' mgr token :: IO (OAuth2Result User)) >>= print -------------------------------------------------- -- Google API@@ -123,18 +121,27 @@ ,("approval_prompt", "force")] -- | Token Validation-validateToken :: AccessToken -> IO (OAuth2Result BL.ByteString)-validateToken token = authGetBS token "https://www.googleapis.com/oauth2/v1/tokeninfo"+validateToken :: Manager+ -> AccessToken+ -> IO (OAuth2Result BL.ByteString)+validateToken mgr token = authGetBS mgr token "https://www.googleapis.com/oauth2/v1/tokeninfo" -validateToken' :: FromJSON a => AccessToken -> IO (OAuth2Result a)-validateToken' token = authGetJSON token "https://www.googleapis.com/oauth2/v1/tokeninfo"+validateToken' :: FromJSON a+ => Manager+ -> AccessToken+ -> IO (OAuth2Result a)+validateToken' mgr token = authGetJSON mgr token "https://www.googleapis.com/oauth2/v1/tokeninfo" -- | fetch user email. -- for more information, please check the playround site. ---userinfo :: AccessToken -> IO (OAuth2Result BL.ByteString)-userinfo token = authGetBS token "https://www.googleapis.com/oauth2/v2/userinfo"--userinfo' :: FromJSON a => AccessToken -> IO (OAuth2Result a)-userinfo' token = authGetJSON token "https://www.googleapis.com/oauth2/v2/userinfo"+userinfo :: Manager+ -> AccessToken+ -> IO (OAuth2Result BL.ByteString)+userinfo mgr token = authGetBS mgr token "https://www.googleapis.com/oauth2/v2/userinfo" +userinfo' :: FromJSON a+ => Manager+ -> AccessToken+ -> IO (OAuth2Result a)+userinfo' mgr token = authGetJSON mgr token "https://www.googleapis.com/oauth2/v2/userinfo"
example/Keys.hs.sample view
@@ -38,3 +38,11 @@ , oauthAccessTokenEndpoint = "https://graph.facebook.com/oauth/access_token" } +doubanKey :: OAuth2+doubanKey = OAuth2 { oauthClientId = "xxxxxxxxxxxxxxx"+ , oauthClientSecret = "xxxxxxxxxxxxxxxxxxxxxx"+ , oauthCallback = Just "http://localhost:9999/oauthCallback"+ , oauthOAuthorizeEndpoint = "https://www.douban.com/service/auth2/auth"+ , oauthAccessTokenEndpoint = "https://www.douban.com/service/auth2/token"+ }+
example/Weibo/test.hs view
@@ -20,33 +20,29 @@ module Main where -import Control.Monad.Trans.Control (MonadBaseControl)-import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import Data.Conduit (MonadResource)-import Data.Maybe (fromJust)-import qualified Data.Text as T-import qualified Data.Text.Encoding as T+import qualified Data.ByteString 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 qualified Network.HTTP.Types as HT- import Network.OAuth.OAuth2-import Network.OAuth.OAuth2.HttpClient import Keys main :: IO () main = do- print $ authorizationUrl weiboKey- putStrLn "visit the url and paste code here: "- code <- getLine- token <- fetchAccessToken weiboKey (sToBS code)- print token- case token of- Right r -> do- uid <- authGetBS r "https://api.weibo.com/2/account/get_uid.json"- print uid- Left l -> BSL.putStrLn l+ print $ authorizationUrl weiboKey+ putStrLn "visit the url and paste code here: "+ code <- getLine+ mgr <- newManager conduitManagerSettings+ token <- fetchAccessToken mgr weiboKey (sToBS code)+ print token+ case token of+ Right r -> do+ uid <- authGetBS mgr r "https://api.weibo.com/2/account/get_uid.json"+ print uid+ Left l -> BSL.putStrLn l+ closeManager mgr sToBS :: String -> BS.ByteString sToBS = T.encodeUtf8 . T.pack
hoauth2.cabal view
@@ -1,6 +1,6 @@ Name: hoauth2 -- (http://www.haskell.org/haskellwiki/Package_versioning_policy)-Version: 0.3.7+Version: 0.4.0 Synopsis: hoauth2 Description:@@ -38,7 +38,7 @@ example/run-7.6.sh example/run.sh -Cabal-version: >=1.8+Cabal-version: >=1.10 Source-Repository head Type: git@@ -47,6 +47,7 @@ Library hs-source-dirs: src+ default-language: Haskell2010 Exposed-modules: Network.OAuth.OAuth2.HttpClient Network.OAuth.OAuth2.Internal@@ -58,18 +59,111 @@ text >= 0.11 && < 1.2, bytestring >= 0.9 && < 0.11, bytestring-show >= 0.3.5 && < 0.4,- conduit >= 1.0 && < 1.1,- http-conduit >= 2.0 && < 2.1,+ http-conduit >= 2.0 && < 2.2, http-types >= 0.8 && < 0.9, monad-control >= 0.3 && < 0.4,- mtl >= 1 && < 2.2,- transformers >= 0.2 && < 0.4,- resourcet >= 0.4 && < 0.5,+ mtl >= 1 && < 2.3,+ transformers >= 0.2 && < 0.5, random if impl(ghc >= 6.12.0) ghc-options: -Wall -fwarn-tabs -funbox-strict-fields- -fno-warn-orphans -fno-warn-unused-do-bind+ -fno-warn-unused-do-bind else ghc-options: -Wall -fwarn-tabs -funbox-strict-fields- -fno-warn-orphans++Executable test-weibo+ main-is: Weibo/test.hs+ hs-source-dirs: example+ default-language: Haskell2010+ build-depends: base >=4.5 && <5,+ http-types >= 0.8 && < 0.9,+ http-conduit >= 2.0 && < 2.2,+ text >= 0.11 && < 1.2,+ text >= 0.11 && < 1.2,+ bytestring >= 0.9 && < 0.11,+ 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+++Executable test-google+ main-is: Google/test.hs+ hs-source-dirs: example+ default-language: Haskell2010+ build-depends: base >=4.5 && <5,+ http-types >= 0.8 && < 0.9,+ http-conduit >= 2.0 && < 2.2,+ text >= 0.11 && < 1.2,+ text >= 0.11 && < 1.2,+ bytestring >= 0.9 && < 0.11,+ aeson >= 0.7 && < 0.8,+ 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+++Executable test-github+ main-is: Github/test.hs+ hs-source-dirs: example+ default-language: Haskell2010+ build-depends: base >=4.5 && <5,+ http-types >= 0.8 && < 0.9,+ http-conduit >= 2.0 && < 2.2,+ text >= 0.11 && < 1.2,+ text >= 0.11 && < 1.2,+ bytestring >= 0.9 && < 0.11,+ aeson >= 0.7 && < 0.8,+ 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++Executable test-douban+ main-is: Douban/test.hs+ hs-source-dirs: example+ default-language: Haskell2010+ build-depends: base >=4.5 && <5,+ http-types >= 0.8 && < 0.9,+ http-conduit >= 2.0 && < 2.2,+ text >= 0.11 && < 1.2,+ text >= 0.11 && < 1.2,+ bytestring >= 0.9 && < 0.11,+ aeson >= 0.7 && < 0.8,+ 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++Executable test-fb+ main-is: Facebook/test.hs+ hs-source-dirs: example+ default-language: Haskell2010+ build-depends: base >=4.5 && <5,+ http-types >= 0.8 && < 0.9,+ http-conduit >= 2.0 && < 2.2,+ text >= 0.11 && < 1.2,+ text >= 0.11 && < 1.2,+ bytestring >= 0.9 && < 0.11,+ aeson >= 0.7 && < 0.8,+ 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
@@ -1,5 +1,5 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-} -- | A simple http client to request OAuth2 tokens and several utils. @@ -10,7 +10,7 @@ import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Maybe-import Network.HTTP.Conduit+import Network.HTTP.Conduit hiding (withManager) import qualified Network.HTTP.Types as HT import Network.OAuth.OAuth2.Internal@@ -22,40 +22,44 @@ -- | Request (via POST method) "Access Token". -- ---fetchAccessToken :: OAuth2 -- ^ OAuth Data+fetchAccessToken :: Manager -- ^ HTTP connection manager+ -> OAuth2 -- ^ OAuth Data -> BS.ByteString -- ^ Authentication code gained after authorization -> IO (OAuth2Result AccessToken) -- ^ Access Token-fetchAccessToken oa code = doJSONPostRequest oa uri body+fetchAccessToken manager oa code = doJSONPostRequest manager oa uri body where (uri, body) = accessTokenUrl oa code -- | Request the "Refresh Token".-fetchRefreshToken :: OAuth2 -- ^ OAuth context+fetchRefreshToken :: Manager -- ^ HTTP connection manager.+ -> OAuth2 -- ^ OAuth context -> BS.ByteString -- ^ refresh token gained after authorization -> IO (OAuth2Result AccessToken)-fetchRefreshToken oa rtoken = doJSONPostRequest oa uri body+fetchRefreshToken manager oa rtoken = doJSONPostRequest manager oa uri body where (uri, body) = refreshAccessTokenUrl oa rtoken -- | Conduct post request and return response as JSON. doJSONPostRequest :: FromJSON a- => OAuth2+ => Manager -- ^ HTTP connection manager.+ -> OAuth2 -- ^ OAuth options -> URI -- ^ The URL -> PostBody -- ^ request body -> IO (OAuth2Result a) -- ^ Response as ByteString-doJSONPostRequest oa uri body = liftM parseResponseJSON (doSimplePostRequest oa uri body)+doJSONPostRequest manager oa uri body = liftM parseResponseJSON (doSimplePostRequest manager oa uri body) -- | Conduct post request.-doSimplePostRequest :: OAuth2- -> URI -- ^ URL+doSimplePostRequest :: Manager -- ^ HTTP connection manager.+ -> OAuth2 -- ^ OAuth options+ -> URI -- ^ URL -> PostBody -- ^ Request body. -> IO (OAuth2Result BSL.ByteString) -- ^ Response as ByteString-doSimplePostRequest oa url body = liftM handleResponse go+doSimplePostRequest manager oa url body = liftM handleResponse go where go = do req <- parseUrl $ BS.unpack url let addBasicAuth = applyBasicAuth (oauthClientId oa) (oauthClientSecret oa) req' = (addBasicAuth . updateRequestHeaders Nothing) req- withManager $ httpLbs (urlEncodedBody body req')+ httpLbs (urlEncodedBody body req') manager -------------------------------------------------- -- * AUTH requests@@ -63,52 +67,54 @@ -- | Conduct GET request and return response as JSON. authGetJSON :: FromJSON a- => AccessToken+ => Manager -- ^ HTTP connection manager.+ -> AccessToken -> URI -- ^ Full URL -> IO (OAuth2Result a) -- ^ Response as JSON-authGetJSON t uri = liftM parseResponseJSON $ authGetBS t uri+authGetJSON manager t uri = liftM parseResponseJSON $ authGetBS manager t uri -- | Conduct GET request.-authGetBS :: AccessToken+authGetBS :: Manager -- ^ HTTP connection manager.+ -> AccessToken -> URI -- ^ URL -> IO (OAuth2Result BSL.ByteString) -- ^ Response as ByteString-authGetBS token url = liftM handleResponse go+authGetBS manager token url = liftM handleResponse go where go = do req <- parseUrl $ BS.unpack $ url `appendAccessToken` token- authenticatedRequest token HT.GET req+ authenticatedRequest manager token HT.GET req -- | Conduct POST request and return response as JSON. authPostJSON :: FromJSON a- => AccessToken+ => Manager -- ^ HTTP connection manager.+ -> AccessToken -> URI -- ^ Full URL -> PostBody -> IO (OAuth2Result a) -- ^ Response as JSON-authPostJSON t uri pb = liftM parseResponseJSON $ authPostBS t uri pb+authPostJSON manager t uri pb = liftM parseResponseJSON $ authPostBS manager t uri pb -- | Conduct POST request.-authPostBS :: AccessToken+authPostBS :: Manager -- ^ HTTP connection manager.+ -> AccessToken -> URI -- ^ URL -> PostBody -> IO (OAuth2Result BSL.ByteString) -- ^ Response as ByteString-authPostBS token url pb = liftM handleResponse go+authPostBS manager token url pb = liftM handleResponse go where body = pb ++ accessTokenToParam token go = do req <- parseUrl $ BS.unpack url- authenticatedRequest token HT.POST $ urlEncodedBody body req+ authenticatedRequest manager token HT.POST $ urlEncodedBody body req -- |Sends a HTTP request including the Authorization header with the specified -- access token. ---authenticatedRequest :: AccessToken -- ^ Authentication token to use+authenticatedRequest :: Manager -- ^ HTTP connection manager.+ -> AccessToken -- ^ Authentication token to use -> HT.StdMethod -- ^ Method to use -> Request -- ^ Request to perform -> IO (Response BSL.ByteString)-authenticatedRequest token m r = withManager- $ httpLbs- $ updateRequestHeaders (Just token)- $ setMethod m r--- { checkStatus = \_ _ _ -> Nothing }+authenticatedRequest manager token m r =+ httpLbs (updateRequestHeaders (Just token) $ setMethod m r) manager -- | Sets the HTTP method to use --@@ -128,7 +134,7 @@ else Left $ BSL.append "Gaining token failed: " (responseBody rsp) -- | Parses a @OAuth2Result BSL.ByteString@ into @FromJSON a => a@--- +-- parseResponseJSON :: FromJSON a => OAuth2Result BSL.ByteString -> OAuth2Result a@@ -141,7 +147,7 @@ -- + userAgennt : hoauth2 -- + accept : application/json -- + authorization : Bearer xxxxx if AccessToken provided.--- +-- updateRequestHeaders :: Maybe AccessToken -> Request -> Request updateRequestHeaders t req = let extras = [ (HT.hUserAgent, "hoauth2")
src/Network/OAuth/OAuth2/Internal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK -ignore-exports #-} @@ -144,4 +144,3 @@ -- | lift value in the Maybe and abonda Nothing transform' :: [(a, Maybe b)] -> [(a, b)] transform' = map (\(a, Just b) -> (a, b)) . filter (isJust . snd)-