{-# 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 Data.Aeson
import Data.Bifunctor (first)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.HashMap.Strict as HM (fromList)
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
-> IO (OAuth2Result TR.Errors OAuth2Token)
fetchAccessToken :: Manager
-> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token)
fetchAccessToken Manager
manager OAuth2
oa ExchangeToken
code = Manager
-> OAuth2
-> URI
-> PostBody
-> IO (OAuth2Result Errors OAuth2Token)
forall err a.
(FromJSON err, FromJSON a) =>
Manager -> OAuth2 -> URI -> PostBody -> IO (OAuth2Result err 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
-> IO (OAuth2Result TR.Errors OAuth2Token)
fetchAccessToken2 :: Manager
-> OAuth2 -> ExchangeToken -> IO (OAuth2Result Errors OAuth2Token)
fetchAccessToken2 Manager
mgr OAuth2
oa ExchangeToken
code = do
let (URI
url, PostBody
body1) = OAuth2 -> ExchangeToken -> (URI, PostBody)
accessTokenUrl OAuth2
oa ExchangeToken
code
let secret :: Text -> [(a, ByteString)]
secret Text
x = [(a
"client_secret", Text -> ByteString
T.encodeUtf8 Text
x)]
let extraBody :: PostBody
extraBody = (ByteString
"client_id", Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauthClientId OAuth2
oa) (ByteString, ByteString) -> PostBody -> PostBody
forall a. a -> [a] -> [a]
: PostBody -> (Text -> PostBody) -> Maybe Text -> PostBody
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> PostBody
forall a. IsString a => Text -> [(a, ByteString)]
secret (OAuth2 -> Maybe Text
oauthClientSecret OAuth2
oa)
Manager
-> OAuth2
-> URI
-> PostBody
-> IO (OAuth2Result Errors OAuth2Token)
forall err a.
(FromJSON err, FromJSON a) =>
Manager -> OAuth2 -> URI -> PostBody -> IO (OAuth2Result err a)
doJSONPostRequest Manager
mgr OAuth2
oa URI
url (PostBody
extraBody PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ PostBody
body1)
refreshAccessToken :: Manager
-> OAuth2
-> RefreshToken
-> IO (OAuth2Result TR.Errors OAuth2Token)
refreshAccessToken :: Manager
-> OAuth2 -> RefreshToken -> IO (OAuth2Result Errors OAuth2Token)
refreshAccessToken Manager
manager OAuth2
oa RefreshToken
token = Manager
-> OAuth2
-> URI
-> PostBody
-> IO (OAuth2Result Errors OAuth2Token)
forall err a.
(FromJSON err, FromJSON a) =>
Manager -> OAuth2 -> URI -> PostBody -> IO (OAuth2Result err 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
-> IO (OAuth2Result TR.Errors OAuth2Token)
refreshAccessToken2 :: Manager
-> OAuth2 -> RefreshToken -> IO (OAuth2Result Errors OAuth2Token)
refreshAccessToken2 Manager
manager OAuth2
oa RefreshToken
token = do
let (URI
uri, PostBody
body) = OAuth2 -> RefreshToken -> (URI, PostBody)
refreshAccessTokenUrl OAuth2
oa RefreshToken
token
let secret :: Text -> [(a, ByteString)]
secret Text
x = [(a
"client_secret", Text -> ByteString
T.encodeUtf8 Text
x)]
let extraBody :: PostBody
extraBody = (ByteString
"client_id", Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauthClientId OAuth2
oa) (ByteString, ByteString) -> PostBody -> PostBody
forall a. a -> [a] -> [a]
: PostBody -> (Text -> PostBody) -> Maybe Text -> PostBody
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Text -> PostBody
forall a. IsString a => Text -> [(a, ByteString)]
secret (OAuth2 -> Maybe Text
oauthClientSecret OAuth2
oa)
Manager
-> OAuth2
-> URI
-> PostBody
-> IO (OAuth2Result Errors OAuth2Token)
forall err a.
(FromJSON err, FromJSON a) =>
Manager -> OAuth2 -> URI -> PostBody -> IO (OAuth2Result err 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
-> IO (OAuth2Result err a)
doJSONPostRequest :: Manager -> OAuth2 -> URI -> PostBody -> IO (OAuth2Result err a)
doJSONPostRequest Manager
manager OAuth2
oa URI
uri PostBody
body = (OAuth2Result err ByteString -> OAuth2Result err a)
-> IO (OAuth2Result err ByteString) -> IO (OAuth2Result err a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OAuth2Result err ByteString -> OAuth2Result err a
forall err a.
(FromJSON err, FromJSON a) =>
OAuth2Result err ByteString -> OAuth2Result err a
parseResponseFlexible (Manager
-> OAuth2 -> URI -> PostBody -> IO (OAuth2Result err ByteString)
forall err.
FromJSON err =>
Manager
-> OAuth2 -> URI -> PostBody -> IO (OAuth2Result err ByteString)
doSimplePostRequest Manager
manager OAuth2
oa URI
uri PostBody
body)
doSimplePostRequest :: FromJSON err => Manager
-> OAuth2
-> URI
-> PostBody
-> IO (OAuth2Result err BSL.ByteString)
doSimplePostRequest :: Manager
-> OAuth2 -> URI -> PostBody -> IO (OAuth2Result err ByteString)
doSimplePostRequest Manager
manager OAuth2
oa URI
url PostBody
body = (Response ByteString -> OAuth2Result err ByteString)
-> IO (Response ByteString) -> IO (OAuth2Result err ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response ByteString -> OAuth2Result err ByteString
forall err.
FromJSON err =>
Response ByteString -> OAuth2Result err ByteString
handleOAuth2TokenResponse IO (Response ByteString)
go
where go :: IO (Response ByteString)
go = do
Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
let addBasicAuth :: Request -> Request
addBasicAuth = case OAuth2 -> Maybe Text
oauthClientSecret OAuth2
oa of
(Just Text
secret) -> ByteString -> ByteString -> Request -> Request
applyBasicAuth (Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauthClientId OAuth2
oa) (Text -> ByteString
T.encodeUtf8 Text
secret)
Maybe Text
Nothing -> Request -> Request
forall a. a -> a
id
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 -> OAuth2Result err BSL.ByteString
handleOAuth2TokenResponse :: Response ByteString -> OAuth2Result 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 -> OAuth2Result err ByteString
forall a b. b -> Either a b
Right (ByteString -> OAuth2Result err ByteString)
-> ByteString -> OAuth2Result err ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp
else OAuth2Error err -> OAuth2Result err ByteString
forall a b. a -> Either a b
Left (OAuth2Error err -> OAuth2Result err ByteString)
-> OAuth2Error err -> OAuth2Result 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
=> OAuth2Result err BSL.ByteString
-> OAuth2Result err a
parseResponseFlexible :: OAuth2Result err ByteString -> OAuth2Result err a
parseResponseFlexible OAuth2Result err ByteString
r = case OAuth2Result err ByteString -> OAuth2Result err a
forall err a.
(FromJSON err, FromJSON a) =>
OAuth2Result err ByteString -> OAuth2Result err a
parseResponseJSON OAuth2Result err ByteString
r of
Left OAuth2Error err
_ -> OAuth2Result err ByteString -> OAuth2Result err a
forall err a.
(FromJSON err, FromJSON a) =>
OAuth2Result err ByteString -> OAuth2Result err a
parseResponseString OAuth2Result err ByteString
r
OAuth2Result err a
x -> OAuth2Result err a
x
parseResponseJSON :: (FromJSON err, FromJSON a)
=> OAuth2Result err BSL.ByteString
-> OAuth2Result err a
parseResponseJSON :: OAuth2Result err ByteString -> OAuth2Result err a
parseResponseJSON (Left OAuth2Error err
b) = OAuth2Error err -> OAuth2Result err a
forall a b. a -> Either a b
Left OAuth2Error err
b
parseResponseJSON (Right ByteString
b) = case ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
b of
Left String
e -> OAuth2Error err -> OAuth2Result err a
forall a b. a -> Either a b
Left (OAuth2Error err -> OAuth2Result err a)
-> OAuth2Error err -> OAuth2Result err a
forall a b. (a -> b) -> a -> b
$ ByteString -> String -> OAuth2Error err
forall err. ByteString -> String -> OAuth2Error err
mkDecodeOAuth2Error ByteString
b String
e
Right a
x -> a -> OAuth2Result err a
forall a b. b -> Either a b
Right a
x
parseResponseString :: (FromJSON err, FromJSON a)
=> OAuth2Result err BSL.ByteString
-> OAuth2Result err a
parseResponseString :: OAuth2Result err ByteString -> OAuth2Result err a
parseResponseString (Left OAuth2Error err
b) = OAuth2Error err -> OAuth2Result err a
forall a b. a -> Either a b
Left OAuth2Error err
b
parseResponseString (Right 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 -> OAuth2Result 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 -> OAuth2Result err a
forall a b. a -> Either a b
Left OAuth2Error err
errorMessage
Success a
x -> a -> OAuth2Result 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
. [(Text, Value)] -> Object
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(Text, Value)] -> Object)
-> (Query -> [(Text, Value)]) -> Query -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Maybe ByteString) -> (Text, Value))
-> Query -> [(Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Maybe ByteString) -> (Text, Value)
paramToPair
paramToPair :: (ByteString, Maybe ByteString) -> (Text, Value)
paramToPair (ByteString
k, Maybe ByteString
mv) = (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
-> IO (Either BSL.ByteString b)
authGetJSON :: Manager -> AccessToken -> URI -> IO (Either ByteString b)
authGetJSON Manager
manager AccessToken
t URI
uri = do
Either ByteString ByteString
resp <- Manager -> AccessToken -> URI -> IO (Either ByteString ByteString)
authGetBS Manager
manager AccessToken
t URI
uri
Either ByteString b -> IO (Either ByteString b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString ByteString
resp Either ByteString ByteString
-> (ByteString -> Either ByteString b) -> Either ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((String -> ByteString) -> Either String b -> Either ByteString b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ByteString
BSL.pack (Either String b -> Either ByteString b)
-> (ByteString -> Either String b)
-> ByteString
-> Either ByteString b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
eitherDecode))
authGetBS :: Manager
-> AccessToken
-> URI
-> IO (Either BSL.ByteString BSL.ByteString)
authGetBS :: Manager -> AccessToken -> URI -> IO (Either ByteString ByteString)
authGetBS Manager
manager AccessToken
token URI
url = do
Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> IO (Either ByteString 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
-> IO (Either BSL.ByteString BSL.ByteString)
authGetBS2 :: Manager -> AccessToken -> URI -> IO (Either ByteString ByteString)
authGetBS2 Manager
manager AccessToken
token URI
url = do
Request
req <- 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
-> IO (Either ByteString 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
-> IO (Either BSL.ByteString b)
authPostJSON :: Manager
-> AccessToken -> URI -> PostBody -> IO (Either ByteString b)
authPostJSON Manager
manager AccessToken
t URI
uri PostBody
pb = do
Either ByteString ByteString
resp <- Manager
-> AccessToken
-> URI
-> PostBody
-> IO (Either ByteString ByteString)
authPostBS Manager
manager AccessToken
t URI
uri PostBody
pb
Either ByteString b -> IO (Either ByteString b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ByteString ByteString
resp Either ByteString ByteString
-> (ByteString -> Either ByteString b) -> Either ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ((String -> ByteString) -> Either String b -> Either ByteString b
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> ByteString
BSL.pack (Either String b -> Either ByteString b)
-> (ByteString -> Either String b)
-> ByteString
-> Either ByteString b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String b
forall a. FromJSON a => ByteString -> Either String a
eitherDecode))
authPostBS :: Manager
-> AccessToken
-> URI
-> PostBody
-> IO (Either BSL.ByteString BSL.ByteString)
authPostBS :: Manager
-> AccessToken
-> URI
-> PostBody
-> IO (Either ByteString ByteString)
authPostBS Manager
manager AccessToken
token URI
url PostBody
pb = do
Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> IO (Either ByteString 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
-> IO (Either BSL.ByteString BSL.ByteString)
authPostBS2 :: Manager
-> AccessToken
-> URI
-> PostBody
-> IO (Either ByteString ByteString)
authPostBS2 Manager
manager AccessToken
token URI
url PostBody
pb = do
Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> IO (Either ByteString 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
-> IO (Either BSL.ByteString BSL.ByteString)
authPostBS3 :: Manager -> AccessToken -> URI -> IO (Either ByteString ByteString)
authPostBS3 Manager
manager AccessToken
token URI
url = do
Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> IO (Either ByteString 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
-> IO (Either BSL.ByteString BSL.ByteString)
authRequest :: Request
-> (Request -> Request)
-> Manager
-> IO (Either ByteString ByteString)
authRequest Request
req Request -> Request
upReq Manager
manage = 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 }