{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.OAuth.OAuth2.HttpClient (
fetchAccessToken,
fetchAccessToken2,
refreshAccessToken,
refreshAccessToken2,
doSimplePostRequest,
authGetJSON,
authGetBS,
authGetBS2,
authPostJSON,
authPostBS,
authPostBS2,
authPostBS3,
authRequest
) where
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except
import qualified Data.Aeson.KeyMap as KeyMap
import qualified Data.Aeson.Key as Key
import Data.Aeson
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Maybe
import qualified Data.Text.Encoding as T
import Network.HTTP.Conduit
import qualified Network.HTTP.Types as HT
import Network.HTTP.Types.URI (parseQuery)
import Network.OAuth.OAuth2.Internal
import qualified Network.OAuth.OAuth2.TokenRequest as TR
import URI.ByteString
fetchAccessToken :: Manager
-> OAuth2
-> ExchangeToken
-> ExceptT (OAuth2Error TR.Errors) IO OAuth2Token
fetchAccessToken :: Manager
-> OAuth2
-> ExchangeToken
-> ExceptT (OAuth2Error Errors) IO OAuth2Token
fetchAccessToken Manager
manager OAuth2
oa ExchangeToken
code = Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error Errors) IO OAuth2Token
forall err a.
(FromJSON err, FromJSON a) =>
Manager
-> OAuth2 -> URI -> PostBody -> ExceptT (OAuth2Error err) IO a
doJSONPostRequest Manager
manager OAuth2
oa URI
uri PostBody
body
where (URI
uri, PostBody
body) = OAuth2 -> ExchangeToken -> (URI, PostBody)
accessTokenUrl OAuth2
oa ExchangeToken
code
fetchAccessToken2 :: Manager
-> OAuth2
-> ExchangeToken
-> ExceptT (OAuth2Error TR.Errors) IO OAuth2Token
fetchAccessToken2 :: Manager
-> OAuth2
-> ExchangeToken
-> ExceptT (OAuth2Error Errors) IO OAuth2Token
fetchAccessToken2 Manager
mgr OAuth2
oa ExchangeToken
code = do
let (URI
url, PostBody
body1) = OAuth2 -> ExchangeToken -> (URI, PostBody)
accessTokenUrl OAuth2
oa ExchangeToken
code
let extraBody :: PostBody
extraBody = [
(ByteString
"client_id", Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientId OAuth2
oa),
(ByteString
"client_secret", Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientSecret OAuth2
oa)
]
Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error Errors) IO OAuth2Token
forall err a.
(FromJSON err, FromJSON a) =>
Manager
-> OAuth2 -> URI -> PostBody -> ExceptT (OAuth2Error err) IO a
doJSONPostRequest Manager
mgr OAuth2
oa URI
url (PostBody
extraBody PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ PostBody
body1)
refreshAccessToken :: Manager
-> OAuth2
-> RefreshToken
-> ExceptT (OAuth2Error TR.Errors) IO OAuth2Token
refreshAccessToken :: Manager
-> OAuth2
-> RefreshToken
-> ExceptT (OAuth2Error Errors) IO OAuth2Token
refreshAccessToken Manager
manager OAuth2
oa RefreshToken
token = Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error Errors) IO OAuth2Token
forall err a.
(FromJSON err, FromJSON a) =>
Manager
-> OAuth2 -> URI -> PostBody -> ExceptT (OAuth2Error err) IO a
doJSONPostRequest Manager
manager OAuth2
oa URI
uri PostBody
body
where (URI
uri, PostBody
body) = OAuth2 -> RefreshToken -> (URI, PostBody)
refreshAccessTokenUrl OAuth2
oa RefreshToken
token
refreshAccessToken2 :: Manager
-> OAuth2
-> RefreshToken
-> ExceptT (OAuth2Error TR.Errors) IO OAuth2Token
refreshAccessToken2 :: Manager
-> OAuth2
-> RefreshToken
-> ExceptT (OAuth2Error Errors) IO OAuth2Token
refreshAccessToken2 Manager
manager OAuth2
oa RefreshToken
token = do
let (URI
uri, PostBody
body) = OAuth2 -> RefreshToken -> (URI, PostBody)
refreshAccessTokenUrl OAuth2
oa RefreshToken
token
let extraBody :: PostBody
extraBody = [
(ByteString
"client_id", Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientId OAuth2
oa),
(ByteString
"client_secret", Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientSecret OAuth2
oa)
]
Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error Errors) IO OAuth2Token
forall err a.
(FromJSON err, FromJSON a) =>
Manager
-> OAuth2 -> URI -> PostBody -> ExceptT (OAuth2Error err) IO a
doJSONPostRequest Manager
manager OAuth2
oa URI
uri (PostBody
extraBody PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ PostBody
body)
doJSONPostRequest :: (FromJSON err, FromJSON a)
=> Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error err) IO a
doJSONPostRequest :: Manager
-> OAuth2 -> URI -> PostBody -> ExceptT (OAuth2Error err) IO a
doJSONPostRequest Manager
manager OAuth2
oa URI
uri PostBody
body = do
ByteString
resp <- Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error err) IO ByteString
forall err.
FromJSON err =>
Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error err) IO ByteString
doSimplePostRequest Manager
manager OAuth2
oa URI
uri PostBody
body
case ByteString -> Either (OAuth2Error err) a
forall err a.
(FromJSON err, FromJSON a) =>
ByteString -> Either (OAuth2Error err) a
parseResponseFlexible ByteString
resp of
Right a
obj -> a -> ExceptT (OAuth2Error err) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
Left OAuth2Error err
e -> OAuth2Error err -> ExceptT (OAuth2Error err) IO a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE OAuth2Error err
e
doSimplePostRequest :: FromJSON err => Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error err) IO BSL.ByteString
doSimplePostRequest :: Manager
-> OAuth2
-> URI
-> PostBody
-> ExceptT (OAuth2Error err) IO ByteString
doSimplePostRequest Manager
manager OAuth2
oa URI
url PostBody
body =
IO (Either (OAuth2Error err) ByteString)
-> ExceptT (OAuth2Error err) IO ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either (OAuth2Error err) ByteString)
-> ExceptT (OAuth2Error err) IO ByteString)
-> IO (Either (OAuth2Error err) ByteString)
-> ExceptT (OAuth2Error err) IO ByteString
forall a b. (a -> b) -> a -> b
$ (Response ByteString -> Either (OAuth2Error err) ByteString)
-> IO (Response ByteString)
-> IO (Either (OAuth2Error err) ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response ByteString -> Either (OAuth2Error err) ByteString
forall err.
FromJSON err =>
Response ByteString -> Either (OAuth2Error err) ByteString
handleOAuth2TokenResponse IO (Response ByteString)
go
where
addBasicAuth :: Request -> Request
addBasicAuth = ByteString -> ByteString -> Request -> Request
applyBasicAuth (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientId OAuth2
oa) (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientSecret OAuth2
oa)
go :: IO (Response ByteString)
go = do
Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
let req' :: Request
req' = (Request -> Request
addBasicAuth (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe AccessToken -> Request -> Request
updateRequestHeaders Maybe AccessToken
forall a. Maybe a
Nothing) Request
req
Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs (PostBody -> Request -> Request
urlEncodedBody PostBody
body Request
req') Manager
manager
handleOAuth2TokenResponse :: FromJSON err => Response BSL.ByteString -> Either (OAuth2Error err) BSL.ByteString
handleOAuth2TokenResponse :: Response ByteString -> Either (OAuth2Error err) ByteString
handleOAuth2TokenResponse Response ByteString
rsp =
if Status -> Bool
HT.statusIsSuccessful (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
rsp)
then ByteString -> Either (OAuth2Error err) ByteString
forall a b. b -> Either a b
Right (ByteString -> Either (OAuth2Error err) ByteString)
-> ByteString -> Either (OAuth2Error err) ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp
else OAuth2Error err -> Either (OAuth2Error err) ByteString
forall a b. a -> Either a b
Left (OAuth2Error err -> Either (OAuth2Error err) ByteString)
-> OAuth2Error err -> Either (OAuth2Error err) ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> OAuth2Error err
forall err. FromJSON err => ByteString -> OAuth2Error err
parseOAuth2Error (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp)
parseResponseFlexible :: (FromJSON err, FromJSON a)
=> BSL.ByteString
-> Either (OAuth2Error err) a
parseResponseFlexible :: ByteString -> Either (OAuth2Error err) a
parseResponseFlexible ByteString
r = case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
r of
Left String
_ -> ByteString -> Either (OAuth2Error err) a
forall err a.
(FromJSON err, FromJSON a) =>
ByteString -> Either (OAuth2Error err) a
parseResponseString ByteString
r
Right a
x -> a -> Either (OAuth2Error err) a
forall a b. b -> Either a b
Right a
x
parseResponseString :: (FromJSON err, FromJSON a)
=> BSL.ByteString
-> Either (OAuth2Error err) a
parseResponseString :: ByteString -> Either (OAuth2Error err) a
parseResponseString ByteString
b = case ByteString -> Query
parseQuery (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
b of
[] -> OAuth2Error err -> Either (OAuth2Error err) a
forall a b. a -> Either a b
Left OAuth2Error err
errorMessage
Query
a -> case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result a) -> Value -> Result a
forall a b. (a -> b) -> a -> b
$ Query -> Value
queryToValue Query
a of
Error String
_ -> OAuth2Error err -> Either (OAuth2Error err) a
forall a b. a -> Either a b
Left OAuth2Error err
errorMessage
Success a
x -> a -> Either (OAuth2Error err) a
forall a b. b -> Either a b
Right a
x
where
queryToValue :: Query -> Value
queryToValue = Object -> Value
Object (Object -> Value) -> (Query -> Object) -> Query -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Key, Value)] -> Object
forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList ([(Key, Value)] -> Object)
-> (Query -> [(Key, Value)]) -> Query -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Maybe ByteString) -> (Key, Value))
-> Query -> [(Key, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Maybe ByteString) -> (Key, Value)
paramToPair
paramToPair :: (ByteString, Maybe ByteString) -> (Key, Value)
paramToPair (ByteString
k, Maybe ByteString
mv) = (Text -> Key
Key.fromText (Text -> Key) -> Text -> Key
forall a b. (a -> b) -> a -> b
$ByteString -> Text
T.decodeUtf8 ByteString
k, Value -> (ByteString -> Value) -> Maybe ByteString -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Null (Text -> Value
String (Text -> Value) -> (ByteString -> Text) -> ByteString -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8) Maybe ByteString
mv)
errorMessage :: OAuth2Error err
errorMessage = ByteString -> OAuth2Error err
forall err. FromJSON err => ByteString -> OAuth2Error err
parseOAuth2Error ByteString
b
authGetJSON :: (FromJSON b)
=> Manager
-> AccessToken
-> URI
-> ExceptT BSL.ByteString IO b
authGetJSON :: Manager -> AccessToken -> URI -> ExceptT ByteString IO b
authGetJSON Manager
manager AccessToken
t URI
uri = do
ByteString
resp <- Manager -> AccessToken -> URI -> ExceptT ByteString IO ByteString
authGetBS Manager
manager AccessToken
t URI
uri
case ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
resp of
Right b
obj -> b -> ExceptT ByteString IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
obj
Left String
e -> ByteString -> ExceptT ByteString IO b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ByteString -> ExceptT ByteString IO b)
-> ByteString -> ExceptT ByteString IO b
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BSL.pack String
e
authGetBS :: Manager
-> AccessToken
-> URI
-> ExceptT BSL.ByteString IO BSL.ByteString
authGetBS :: Manager -> AccessToken -> URI -> ExceptT ByteString IO ByteString
authGetBS Manager
manager AccessToken
token URI
url = do
Request
req <- URI -> ExceptT ByteString IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
where upReq :: Request -> Request
upReq = Maybe AccessToken -> Request -> Request
updateRequestHeaders (AccessToken -> Maybe AccessToken
forall a. a -> Maybe a
Just AccessToken
token) (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
setMethod StdMethod
HT.GET
authGetBS2 :: Manager
-> AccessToken
-> URI
-> ExceptT BSL.ByteString IO BSL.ByteString
authGetBS2 :: Manager -> AccessToken -> URI -> ExceptT ByteString IO ByteString
authGetBS2 Manager
manager AccessToken
token URI
url = do
Request
req <- IO Request -> ExceptT ByteString IO Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> ExceptT ByteString IO Request)
-> IO Request -> ExceptT ByteString IO Request
forall a b. (a -> b) -> a -> b
$ URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest (URI
url URI -> AccessToken -> URI
forall a. URIRef a -> AccessToken -> URIRef a
`appendAccessToken` AccessToken
token)
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
where upReq :: Request -> Request
upReq = Maybe AccessToken -> Request -> Request
updateRequestHeaders Maybe AccessToken
forall a. Maybe a
Nothing (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
setMethod StdMethod
HT.GET
authPostJSON :: (FromJSON b)
=> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT BSL.ByteString IO b
authPostJSON :: Manager
-> AccessToken -> URI -> PostBody -> ExceptT ByteString IO b
authPostJSON Manager
manager AccessToken
t URI
uri PostBody
pb = do
ByteString
resp <- Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBS Manager
manager AccessToken
t URI
uri PostBody
pb
case ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
resp of
Right b
obj -> b -> ExceptT ByteString IO b
forall (m :: * -> *) a. Monad m => a -> m a
return b
obj
Left String
e -> ByteString -> ExceptT ByteString IO b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ByteString -> ExceptT ByteString IO b)
-> ByteString -> ExceptT ByteString IO b
forall a b. (a -> b) -> a -> b
$ String -> ByteString
BSL.pack String
e
authPostBS :: Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT BSL.ByteString IO BSL.ByteString
authPostBS :: Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBS Manager
manager AccessToken
token URI
url PostBody
pb = do
Request
req <- URI -> ExceptT ByteString IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
where upBody :: Request -> Request
upBody = PostBody -> Request -> Request
urlEncodedBody (PostBody
pb PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ AccessToken -> PostBody
accessTokenToParam AccessToken
token)
upHeaders :: Request -> Request
upHeaders = Maybe AccessToken -> Request -> Request
updateRequestHeaders (AccessToken -> Maybe AccessToken
forall a. a -> Maybe a
Just AccessToken
token) (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
setMethod StdMethod
HT.POST
upReq :: Request -> Request
upReq = Request -> Request
upHeaders (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
upBody
authPostBS2 :: Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT BSL.ByteString IO BSL.ByteString
authPostBS2 :: Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString IO ByteString
authPostBS2 Manager
manager AccessToken
token URI
url PostBody
pb = do
Request
req <- URI -> ExceptT ByteString IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
where upBody :: Request -> Request
upBody = PostBody -> Request -> Request
urlEncodedBody (PostBody
pb PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ AccessToken -> PostBody
accessTokenToParam AccessToken
token)
upHeaders :: Request -> Request
upHeaders = Maybe AccessToken -> Request -> Request
updateRequestHeaders Maybe AccessToken
forall a. Maybe a
Nothing (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
setMethod StdMethod
HT.POST
upReq :: Request -> Request
upReq = Request -> Request
upHeaders (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
upBody
authPostBS3 :: Manager
-> AccessToken
-> URI
-> ExceptT BSL.ByteString IO BSL.ByteString
authPostBS3 :: Manager -> AccessToken -> URI -> ExceptT ByteString IO ByteString
authPostBS3 Manager
manager AccessToken
token URI
url = do
Request
req <- URI -> ExceptT ByteString IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
where upBody :: Request -> Request
upBody Request
req = Request
req { requestBody :: RequestBody
requestBody = RequestBody
"null" }
upHeaders :: Request -> Request
upHeaders = Maybe AccessToken -> Request -> Request
updateRequestHeaders (AccessToken -> Maybe AccessToken
forall a. a -> Maybe a
Just AccessToken
token) (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StdMethod -> Request -> Request
setMethod StdMethod
HT.POST
upReq :: Request -> Request
upReq = Request -> Request
upHeaders (Request -> Request) -> (Request -> Request) -> Request -> Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
upBody
authRequest :: Request
-> (Request -> Request)
-> Manager
-> ExceptT BSL.ByteString IO BSL.ByteString
authRequest :: Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString IO ByteString
authRequest Request
req Request -> Request
upReq Manager
manage = IO (Either ByteString ByteString)
-> ExceptT ByteString IO ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either ByteString ByteString)
-> ExceptT ByteString IO ByteString)
-> IO (Either ByteString ByteString)
-> ExceptT ByteString IO ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> Either ByteString ByteString
handleResponse (Response ByteString -> Either ByteString ByteString)
-> IO (Response ByteString) -> IO (Either ByteString ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs (Request -> Request
upReq Request
req) Manager
manage
handleResponse :: Response BSL.ByteString -> Either BSL.ByteString BSL.ByteString
handleResponse :: Response ByteString -> Either ByteString ByteString
handleResponse Response ByteString
rsp =
if Status -> Bool
HT.statusIsSuccessful (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
rsp)
then ByteString -> Either ByteString ByteString
forall a b. b -> Either a b
Right (ByteString -> Either ByteString ByteString)
-> ByteString -> Either ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp
else ByteString -> Either ByteString ByteString
forall a b. a -> Either a b
Left (ByteString -> Either ByteString ByteString)
-> ByteString -> Either ByteString ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp
updateRequestHeaders :: Maybe AccessToken -> Request -> Request
Maybe AccessToken
t Request
req =
let extras :: [(HeaderName, ByteString)]
extras = [ (HeaderName
HT.hUserAgent, ByteString
"hoauth2")
, (HeaderName
HT.hAccept, ByteString
"application/json") ]
bearer :: [(HeaderName, ByteString)]
bearer = [(HeaderName
HT.hAuthorization, ByteString
"Bearer " ByteString -> ByteString -> ByteString
`BS.append` Text -> ByteString
T.encodeUtf8 (AccessToken -> Text
atoken (Maybe AccessToken -> AccessToken
forall a. HasCallStack => Maybe a -> a
fromJust Maybe AccessToken
t))) | Maybe AccessToken -> Bool
forall a. Maybe a -> Bool
isJust Maybe AccessToken
t]
headers :: [(HeaderName, ByteString)]
headers = [(HeaderName, ByteString)]
bearer [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. [a] -> [a] -> [a]
++ [(HeaderName, ByteString)]
extras [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. [a] -> [a] -> [a]
++ Request -> [(HeaderName, ByteString)]
requestHeaders Request
req
in
Request
req { requestHeaders :: [(HeaderName, ByteString)]
requestHeaders = [(HeaderName, ByteString)]
headers }
setMethod :: HT.StdMethod -> Request -> Request
setMethod :: StdMethod -> Request -> Request
setMethod StdMethod
m Request
req = Request
req { method :: ByteString
method = StdMethod -> ByteString
HT.renderStdMethod StdMethod
m }