module Network.OAuth.OAuth2.HttpClient (
authGetJSON,
authGetBS,
authGetBS2,
authGetJSONWithAuthMethod,
authGetJSONInternal,
authGetBSWithAuthMethod,
authGetBSInternal,
authPostJSON,
authPostBS,
authPostBS2,
authPostBS3,
authPostJSONWithAuthMethod,
authPostJSONInternal,
authPostBSWithAuthMethod,
authPostBSInternal,
APIAuthenticationMethod (..),
) where
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except (ExceptT (..), throwE)
import Data.Aeson (FromJSON, eitherDecode)
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy.Char8 qualified as BSL
import Data.Maybe (fromJust, isJust)
import Data.Text.Encoding qualified as T
import Lens.Micro (over)
import Network.HTTP.Client.Contrib (handleResponse)
import Network.HTTP.Conduit
import Network.HTTP.Types qualified as HT
import Network.OAuth.OAuth2.Internal
import URI.ByteString (URI, URIRef, queryL, queryPairsL)
authGetJSON ::
(MonadIO m, FromJSON a) =>
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m a
authGetJSON :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSON = APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
authGetJSONInternal ::
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m a
authGetJSONInternal :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONInternal = APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONWithAuthMethod
{-# DEPRECATED authGetJSONInternal "use authGetJSONWithAuthMethod" #-}
authGetJSONWithAuthMethod ::
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m a
authGetJSONWithAuthMethod :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
t URI
uri = do
ByteString
resp <- APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
t URI
uri
([Char] -> ExceptT ByteString m a)
-> (a -> ExceptT ByteString m a)
-> Either [Char] a
-> ExceptT ByteString m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> ExceptT ByteString m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ByteString -> ExceptT ByteString m a)
-> ([Char] -> ByteString) -> [Char] -> ExceptT ByteString m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BSL.pack) a -> ExceptT ByteString m a
forall a. a -> ExceptT ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
resp)
authGetBS ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m BSL.ByteString
authGetBS :: forall (m :: * -> *).
MonadIO m =>
Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBS = APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
authGetBS2 ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m BSL.ByteString
authGetBS2 :: forall (m :: * -> *).
MonadIO m =>
Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBS2 = APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod APIAuthenticationMethod
AuthInRequestQuery
{-# DEPRECATED authGetBS2 "use authGetBSWithAuthMethod" #-}
authGetBSInternal ::
MonadIO m =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m BSL.ByteString
authGetBSInternal :: forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSInternal = APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod
{-# DEPRECATED authGetBSInternal "use authGetBSWithAuthMethod" #-}
authGetBSWithAuthMethod ::
MonadIO m =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
ExceptT BSL.ByteString m BSL.ByteString
authGetBSWithAuthMethod :: forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m ByteString
authGetBSWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url = do
let appendToUrl :: Bool
appendToUrl = APIAuthenticationMethod
AuthInRequestQuery APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== APIAuthenticationMethod
authTypes
let appendToHeader :: Bool
appendToHeader = APIAuthenticationMethod
AuthInRequestHeader APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== APIAuthenticationMethod
authTypes
let uri :: URI
uri = if Bool
appendToUrl then URI
url URI -> AccessToken -> URI
forall a. URIRef a -> AccessToken -> URIRef a
`appendAccessToken` AccessToken
token else URI
url
let upReq :: Request -> Request
upReq = Maybe AccessToken -> Request -> Request
updateRequestHeaders (if Bool
appendToHeader then AccessToken -> Maybe AccessToken
forall a. a -> Maybe a
Just AccessToken
token else 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
Request
req <- IO Request -> ExceptT ByteString m Request
forall a. IO a -> ExceptT ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> ExceptT ByteString m Request)
-> IO Request -> ExceptT ByteString m Request
forall a b. (a -> b) -> a -> b
$ URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
uri
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString m ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
authPostJSON ::
(MonadIO m, FromJSON a) =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m a
authPostJSON :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager -> AccessToken -> URI -> PostBody -> ExceptT ByteString m a
authPostJSON = APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
authPostJSONWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
authPostJSONInternal ::
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m a
authPostJSONInternal :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
authPostJSONInternal = APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
authPostJSONWithAuthMethod
{-# DEPRECATED authPostJSONInternal "use 'authPostJSONWithAuthMethod'" #-}
authPostJSONWithAuthMethod ::
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m a
authPostJSONWithAuthMethod :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m a
authPostJSONWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body = do
ByteString
resp <- APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body
([Char] -> ExceptT ByteString m a)
-> (a -> ExceptT ByteString m a)
-> Either [Char] a
-> ExceptT ByteString m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> ExceptT ByteString m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE (ByteString -> ExceptT ByteString m a)
-> ([Char] -> ByteString) -> [Char] -> ExceptT ByteString m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BSL.pack) a -> ExceptT ByteString m a
forall a. a -> ExceptT ByteString m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either [Char] a
forall a. FromJSON a => ByteString -> Either [Char] a
eitherDecode ByteString
resp)
authPostBS ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBS :: forall (m :: * -> *).
MonadIO m =>
Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBS = APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
authPostBS2 ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBS2 :: forall (m :: * -> *).
MonadIO m =>
Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBS2 = APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
AuthInRequestBody
{-# DEPRECATED authPostBS2 "use 'authPostBSWithAuthMethod'" #-}
authPostBS3 ::
MonadIO m =>
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBS3 :: forall (m :: * -> *).
MonadIO m =>
Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBS3 = APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
AuthInRequestHeader
{-# DEPRECATED authPostBS3 "use 'authPostBSWithAuthMethod'" #-}
authPostBSInternal ::
MonadIO m =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBSInternal :: forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSInternal = APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod
{-# DEPRECATED authPostBSInternal "use 'authPostBSWithAuthMethod'" #-}
authPostBSWithAuthMethod ::
MonadIO m =>
APIAuthenticationMethod ->
Manager ->
AccessToken ->
URI ->
PostBody ->
ExceptT BSL.ByteString m BSL.ByteString
authPostBSWithAuthMethod :: forall (m :: * -> *).
MonadIO m =>
APIAuthenticationMethod
-> Manager
-> AccessToken
-> URI
-> PostBody
-> ExceptT ByteString m ByteString
authPostBSWithAuthMethod APIAuthenticationMethod
authTypes Manager
manager AccessToken
token URI
url PostBody
body = do
let appendToBody :: Bool
appendToBody = APIAuthenticationMethod
AuthInRequestBody APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== APIAuthenticationMethod
authTypes
let appendToHeader :: Bool
appendToHeader = APIAuthenticationMethod
AuthInRequestHeader APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== APIAuthenticationMethod
authTypes
let reqBody :: PostBody
reqBody = if Bool
appendToBody then PostBody
body PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ AccessToken -> PostBody
accessTokenToParam AccessToken
token else PostBody
body
let upBody :: Request -> Request
upBody = if PostBody -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null PostBody
reqBody then Request -> Request
forall a. a -> a
id else PostBody -> Request -> Request
urlEncodedBody PostBody
reqBody
let upHeaders :: Request -> Request
upHeaders = Maybe AccessToken -> Request -> Request
updateRequestHeaders (if Bool
appendToHeader then AccessToken -> Maybe AccessToken
forall a. a -> Maybe a
Just AccessToken
token else 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
let 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
Request
req <- IO Request -> ExceptT ByteString m Request
forall a. IO a -> ExceptT ByteString m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> ExceptT ByteString m Request)
-> IO Request -> ExceptT ByteString m Request
forall a b. (a -> b) -> a -> b
$ URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
uriToRequest URI
url
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString m ByteString
forall (m :: * -> *).
MonadIO m =>
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString m ByteString
authRequest Request
req Request -> Request
upReq Manager
manager
data APIAuthenticationMethod
=
|
AuthInRequestBody
|
AuthInRequestQuery
deriving (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
(APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> Eq APIAuthenticationMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
== :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c/= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
/= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
Eq, Eq APIAuthenticationMethod
Eq APIAuthenticationMethod =>
(APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod -> APIAuthenticationMethod -> Bool)
-> (APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod)
-> (APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod)
-> Ord APIAuthenticationMethod
APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
compare :: APIAuthenticationMethod -> APIAuthenticationMethod -> Ordering
$c< :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
< :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c<= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
<= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c> :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
> :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$c>= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
>= :: APIAuthenticationMethod -> APIAuthenticationMethod -> Bool
$cmax :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
max :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
$cmin :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
min :: APIAuthenticationMethod
-> APIAuthenticationMethod -> APIAuthenticationMethod
Ord)
authRequest ::
MonadIO m =>
Request ->
(Request -> Request) ->
Manager ->
ExceptT BSL.ByteString m BSL.ByteString
authRequest :: forall (m :: * -> *).
MonadIO m =>
Request
-> (Request -> Request)
-> Manager
-> ExceptT ByteString m ByteString
authRequest Request
req Request -> Request
upReq Manager
manage = m (Either ByteString ByteString) -> ExceptT ByteString m ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either ByteString ByteString)
-> ExceptT ByteString m ByteString)
-> m (Either ByteString ByteString)
-> ExceptT ByteString m ByteString
forall a b. (a -> b) -> a -> b
$ do
Response ByteString
resp <- Request -> Manager -> m (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs (Request -> Request
upReq Request
req) Manager
manage
Either ByteString ByteString -> m (Either ByteString ByteString)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response ByteString -> Either ByteString ByteString
handleResponse Response ByteString
resp)
updateRequestHeaders :: Maybe AccessToken -> Request -> Request
Maybe AccessToken
t Request
req =
let 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)]
defaultRequestHeaders [(HeaderName, ByteString)]
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. [a] -> [a] -> [a]
++ Request -> [(HeaderName, ByteString)]
requestHeaders Request
req
in Request
req {requestHeaders = headers}
setMethod :: HT.StdMethod -> Request -> Request
setMethod :: StdMethod -> Request -> Request
setMethod StdMethod
m Request
req = Request
req {method = HT.renderStdMethod m}
appendAccessToken ::
URIRef a ->
AccessToken ->
URIRef a
appendAccessToken :: forall a. URIRef a -> AccessToken -> URIRef a
appendAccessToken URIRef a
uri AccessToken
t = ASetter (URIRef a) (URIRef a) PostBody PostBody
-> (PostBody -> PostBody) -> URIRef a -> URIRef a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Query -> Identity Query) -> URIRef a -> Identity (URIRef a)
forall a (f :: * -> *).
Functor f =>
(Query -> f Query) -> URIRef a -> f (URIRef a)
queryL ((Query -> Identity Query) -> URIRef a -> Identity (URIRef a))
-> ((PostBody -> Identity PostBody) -> Query -> Identity Query)
-> ASetter (URIRef a) (URIRef a) PostBody PostBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PostBody -> Identity PostBody) -> Query -> Identity Query
Lens' Query PostBody
queryPairsL) (\PostBody
query -> PostBody
query PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ AccessToken -> PostBody
accessTokenToParam AccessToken
t) URIRef a
uri
accessTokenToParam :: AccessToken -> [(BS.ByteString, BS.ByteString)]
accessTokenToParam :: AccessToken -> PostBody
accessTokenToParam AccessToken
t = [(ByteString
"access_token", Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AccessToken -> Text
atoken AccessToken
t)]