-- | Bindings for The OAuth 2.0 Authorization Framework: Bearer Token Usage
-- RFC6750 <https://www.rfc-editor.org/rfc/rfc6750>
module Network.OAuth.OAuth2.HttpClient (
  -- * AUTH requests
  authGetJSON,
  authGetBS,
  authGetBS2,
  authGetJSONWithAuthMethod,
  authGetJSONInternal,
  authGetBSWithAuthMethod,
  authGetBSInternal,
  authPostJSON,
  authPostBS,
  authPostBS2,
  authPostBS3,
  authPostJSONWithAuthMethod,
  authPostJSONInternal,
  authPostBSWithAuthMethod,
  authPostBSInternal,

  -- * Types
  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)

--------------------------------------------------

-- * AUTH requests

-- Making request with Access Token appended to Header, Request body or query string.
--
--------------------------------------------------

-- | Conduct an authorized GET request and return response as JSON.
--   Inject Access Token to Authorization Header.
authGetJSON ::
  (MonadIO m, FromJSON a) =>
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  -- | Response as JSON
  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

-- | Deprecated. Use `authGetJSONWithAuthMethod` instead.
authGetJSONInternal ::
  (MonadIO m, FromJSON a) =>
  APIAuthenticationMethod ->
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  -- | Response as JSON
  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" #-}

-- | Conduct an authorized GET request and return response as JSON.
--   Allow to specify how to append AccessToken.
--
-- @since 2.6.0
authGetJSONWithAuthMethod ::
  (MonadIO m, FromJSON a) =>
  APIAuthenticationMethod ->
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  -- | Response as JSON
  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)

-- | Conduct an authorized GET request.
--   Inject Access Token to Authorization Header.
authGetBS ::
  MonadIO m =>
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  -- | Response as ByteString
  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

-- | Same to 'authGetBS' but set access token to query parameter rather than header
authGetBS2 ::
  MonadIO m =>
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  -- | Response as ByteString
  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 ->
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  -- | Response as ByteString
  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" #-}

-- | Conduct an authorized GET request and return response as ByteString.
--   Allow to specify how to append AccessToken.
--
-- @since 2.6.0
authGetBSWithAuthMethod ::
  MonadIO m =>
  -- | Specify the way that how to append the 'AccessToken' in the request
  APIAuthenticationMethod ->
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  -- | Response as ByteString
  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

-- | Conduct POST request and return response as JSON.
--   Inject Access Token to Authorization Header.
authPostJSON ::
  (MonadIO m, FromJSON a) =>
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  PostBody ->
  -- | Response as JSON
  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 ->
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  PostBody ->
  -- | Response as ByteString
  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'" #-}

-- | Conduct POST request and return response as JSON.
--   Allow to specify how to append AccessToken.
--
-- @since 2.6.0
authPostJSONWithAuthMethod ::
  (MonadIO m, FromJSON a) =>
  APIAuthenticationMethod ->
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  PostBody ->
  -- | Response as ByteString
  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)

-- | Conduct POST request.
--   Inject Access Token to http header (Authorization)
authPostBS ::
  MonadIO m =>
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  PostBody ->
  -- | Response as ByteString
  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

-- | Conduct POST request with access token only in the request body but header.
authPostBS2 ::
  MonadIO m =>
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  PostBody ->
  -- | Response as ByteString
  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'" #-}

-- | Conduct POST request with access token only in the header and not in body
authPostBS3 ::
  MonadIO m =>
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  PostBody ->
  -- | Response as ByteString
  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 ->
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  PostBody ->
  -- | Response as ByteString
  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'" #-}

-- | Conduct POST request and return response as ByteString.
--   Allow to specify how to append AccessToken.
--
-- @since 2.6.0
authPostBSWithAuthMethod ::
  MonadIO m =>
  APIAuthenticationMethod ->
  -- | HTTP connection manager.
  Manager ->
  AccessToken ->
  URI ->
  PostBody ->
  -- | Response as ByteString
  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
  -- TODO: urlEncodedBody send request as 'application/x-www-form-urlencoded'
  -- seems shall go with application/json which is more common?
  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

--------------------------------------------------

-- * Types

--------------------------------------------------

-- | https://www.rfc-editor.org/rfc/rfc6750#section-2
data APIAuthenticationMethod
  = -- | Provides in Authorization header
    AuthInRequestHeader
  | -- | Provides in request body
    AuthInRequestBody
  | -- | Provides in request query parameter
    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)

--------------------------------------------------

-- * Utilities

--------------------------------------------------

-- | Send an HTTP request.
authRequest ::
  MonadIO m =>
  -- | Request to perform
  Request ->
  -- | Modify request before sending
  (Request -> Request) ->
  -- | HTTP connection manager.
  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)

-- | Set several header values:
--   + userAgennt    : "hoauth2"
--   + accept        : "application/json"
--   + authorization : "Bearer xxxxx" if 'Network.OAuth.OAuth2.AccessToken' provided.
updateRequestHeaders :: Maybe AccessToken -> Request -> Request
updateRequestHeaders :: Maybe AccessToken -> Request -> Request
updateRequestHeaders 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}

-- | Set the HTTP method to use.
setMethod :: HT.StdMethod -> Request -> Request
setMethod :: StdMethod -> Request -> Request
setMethod StdMethod
m Request
req = Request
req {method = HT.renderStdMethod m}

-- | For @GET@ method API.
appendAccessToken ::
  -- | Base URI
  URIRef a ->
  -- | Authorized Access Token
  AccessToken ->
  -- | Combined Result
  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

-- | Create `QueryParams` with given access token value.
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)]