    -- | Bindings Access Token and Refresh Token part of The OAuth 2.0 Authorization Framework
    -- RFC6749 <https://www.rfc-editor.org/rfc/rfc6749>
    module Network.OAuth.OAuth2.TokenRequest where

    import Control.Monad.IO.Class (MonadIO (..))
    import Control.Monad.Trans.Except (ExceptT (..), throwE)
    import Data.Aeson
    import Data.Aeson.Key qualified as Key
    import Data.Aeson.KeyMap qualified as KeyMap
    import Data.ByteString.Lazy.Char8 qualified as BSL
    import Data.Text (Text)
    import Data.Text qualified as T
    import Data.Text.Encoding qualified as T
    import Network.HTTP.Conduit
    import Network.HTTP.Types qualified as HT
    import Network.HTTP.Types.URI (parseQuery)
    import Network.OAuth.OAuth2.Internal
    import URI.ByteString
    import Prelude hiding (error)

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

    -- * Token Request Errors

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

    data TokenResponseError = TokenResponseError
      { TokenResponseError -> TokenResponseErrorCode
    tokenResponseError :: TokenResponseErrorCode
      , TokenResponseError -> Maybe Text
    tokenResponseErrorDescription :: Maybe Text
      , TokenResponseError -> Maybe (URIRef Absolute)
    tokenResponseErrorUri :: Maybe (URIRef Absolute)
      }
      deriving (Int -> TokenResponseError -> ShowS
    [TokenResponseError] -> ShowS
    TokenResponseError -> String
    (Int -> TokenResponseError -> ShowS)
    -> (TokenResponseError -> String)
    -> ([TokenResponseError] -> ShowS)
    -> Show TokenResponseError
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TokenResponseError -> ShowS
    showsPrec :: Int -> TokenResponseError -> ShowS
    $cshow :: TokenResponseError -> String
    show :: TokenResponseError -> String
    $cshowList :: [TokenResponseError] -> ShowS
    showList :: [TokenResponseError] -> ShowS
    Show, TokenResponseError -> TokenResponseError -> Bool
    (TokenResponseError -> TokenResponseError -> Bool)
    -> (TokenResponseError -> TokenResponseError -> Bool)
    -> Eq TokenResponseError
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TokenResponseError -> TokenResponseError -> Bool
    == :: TokenResponseError -> TokenResponseError -> Bool
    $c/= :: TokenResponseError -> TokenResponseError -> Bool
    /= :: TokenResponseError -> TokenResponseError -> Bool
    Eq)

    -- | Token Error Responses https://tools.ietf.org/html/rfc6749#section-5.2
    data TokenResponseErrorCode
      = InvalidRequest
      | InvalidClient
      | InvalidGrant
      | UnauthorizedClient
      | UnsupportedGrantType
      | InvalidScope
      | UnknownErrorCode Text
      deriving (Int -> TokenResponseErrorCode -> ShowS
    [TokenResponseErrorCode] -> ShowS
    TokenResponseErrorCode -> String
    (Int -> TokenResponseErrorCode -> ShowS)
    -> (TokenResponseErrorCode -> String)
    -> ([TokenResponseErrorCode] -> ShowS)
    -> Show TokenResponseErrorCode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> TokenResponseErrorCode -> ShowS
    showsPrec :: Int -> TokenResponseErrorCode -> ShowS
    $cshow :: TokenResponseErrorCode -> String
    show :: TokenResponseErrorCode -> String
    $cshowList :: [TokenResponseErrorCode] -> ShowS
    showList :: [TokenResponseErrorCode] -> ShowS
    Show, TokenResponseErrorCode -> TokenResponseErrorCode -> Bool
    (TokenResponseErrorCode -> TokenResponseErrorCode -> Bool)
    -> (TokenResponseErrorCode -> TokenResponseErrorCode -> Bool)
    -> Eq TokenResponseErrorCode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TokenResponseErrorCode -> TokenResponseErrorCode -> Bool
    == :: TokenResponseErrorCode -> TokenResponseErrorCode -> Bool
    $c/= :: TokenResponseErrorCode -> TokenResponseErrorCode -> Bool
    /= :: TokenResponseErrorCode -> TokenResponseErrorCode -> Bool
    Eq)

    instance FromJSON TokenResponseErrorCode where
      parseJSON :: Value -> Parser TokenResponseErrorCode
    parseJSON = String
    -> (Text -> Parser TokenResponseErrorCode)
    -> Value
    -> Parser TokenResponseErrorCode
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
    withText String
    "parseJSON TokenResponseErrorCode" ((Text -> Parser TokenResponseErrorCode)
     -> Value -> Parser TokenResponseErrorCode)
    -> (Text -> Parser TokenResponseErrorCode)
    -> Value
    -> Parser TokenResponseErrorCode
    forall a b. (a -> b) -> a -> b
    $ \Text
    t ->
        TokenResponseErrorCode -> Parser TokenResponseErrorCode
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TokenResponseErrorCode -> Parser TokenResponseErrorCode)
    -> TokenResponseErrorCode -> Parser TokenResponseErrorCode
    forall a b. (a -> b) -> a -> b
    $ case Text
    t of
          Text
    "invalid_request" -> TokenResponseErrorCode
    InvalidRequest
          Text
    "invalid_client" -> TokenResponseErrorCode
    InvalidClient
          Text
    "invalid_grant" -> TokenResponseErrorCode
    InvalidGrant
          Text
    "unauthorized_client" -> TokenResponseErrorCode
    UnauthorizedClient
          Text
    "unsupported_grant_type" -> TokenResponseErrorCode
    UnsupportedGrantType
          Text
    "invalid_scope" -> TokenResponseErrorCode
    InvalidScope
          Text
    _ -> Text -> TokenResponseErrorCode
    UnknownErrorCode Text
    t

    instance FromJSON TokenResponseError where
      parseJSON :: Value -> Parser TokenResponseError
    parseJSON = String
    -> (Object -> Parser TokenResponseError)
    -> Value
    -> Parser TokenResponseError
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
    withObject String
    "parseJSON TokenResponseError" ((Object -> Parser TokenResponseError)
     -> Value -> Parser TokenResponseError)
    -> (Object -> Parser TokenResponseError)
    -> Value
    -> Parser TokenResponseError
    forall a b. (a -> b) -> a -> b
    $ \Object
    t -> do
        TokenResponseErrorCode
    tokenResponseError <- Object
    t Object -> Key -> Parser TokenResponseErrorCode
    forall a. FromJSON a => Object -> Key -> Parser a
    .: Key
    "error"
        Maybe Text
    tokenResponseErrorDescription <- Object
    t Object -> Key -> Parser (Maybe Text)
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    .:? Key
    "error_description"
        Maybe (URIRef Absolute)
    tokenResponseErrorUri <- Object
    t Object -> Key -> Parser (Maybe (URIRef Absolute))
    forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
    .:? Key
    "error_uri"
        TokenResponseError -> Parser TokenResponseError
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure TokenResponseError {Maybe Text
    Maybe (URIRef Absolute)
    TokenResponseErrorCode
    tokenResponseError :: TokenResponseErrorCode
    tokenResponseErrorDescription :: Maybe Text
    tokenResponseErrorUri :: Maybe (URIRef Absolute)
    tokenResponseError :: TokenResponseErrorCode
    tokenResponseErrorDescription :: Maybe Text
    tokenResponseErrorUri :: Maybe (URIRef Absolute)
    ..}

    parseTokeResponseError :: BSL.ByteString -> TokenResponseError
    parseTokeResponseError :: ByteString -> TokenResponseError
    parseTokeResponseError ByteString
    string =
      (String -> TokenResponseError)
    -> (TokenResponseError -> TokenResponseError)
    -> Either String TokenResponseError
    -> TokenResponseError
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ByteString -> String -> TokenResponseError
    mkDecodeOAuth2Error ByteString
    string) TokenResponseError -> TokenResponseError
    forall a. a -> a
    id (ByteString -> Either String TokenResponseError
    forall a. FromJSON a => ByteString -> Either String a
    eitherDecode ByteString
    string)
      where
        mkDecodeOAuth2Error :: BSL.ByteString -> String -> TokenResponseError
        mkDecodeOAuth2Error :: ByteString -> String -> TokenResponseError
    mkDecodeOAuth2Error ByteString
    response String
    err =
          TokenResponseErrorCode
    -> Maybe Text -> Maybe (URIRef Absolute) -> TokenResponseError
    TokenResponseError
            (Text -> TokenResponseErrorCode
    UnknownErrorCode Text
    "")
            (Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String
    "Decode TokenResponseError failed: " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    err String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    "\n Original Response:\n" String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> Text -> String
    forall a. Show a => a -> String
    show (ByteString -> Text
    T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    BSL.toStrict ByteString
    response))
            Maybe (URIRef Absolute)
    forall a. Maybe a
    Nothing

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

    -- * URL

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

    -- | Prepare the URL and the request body query for fetching an access token.
    accessTokenUrl ::
      OAuth2 ->
      -- | access code gained via authorization URL
      ExchangeToken ->
      -- | access token request URL plus the request body.
      (URI, PostBody)
    accessTokenUrl :: OAuth2 -> ExchangeToken -> (URIRef Absolute, PostBody)
    accessTokenUrl OAuth2
    oa ExchangeToken
    code =
      let uri :: URIRef Absolute
    uri = OAuth2 -> URIRef Absolute
    oauth2TokenEndpoint OAuth2
    oa
          body :: PostBody
    body =
            [ (ByteString
    "code", Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ExchangeToken -> Text
    extoken ExchangeToken
    code)
            , (ByteString
    "redirect_uri", URIRef Absolute -> ByteString
    forall a. URIRef a -> ByteString
    serializeURIRef' (URIRef Absolute -> ByteString) -> URIRef Absolute -> ByteString
    forall a b. (a -> b) -> a -> b
    $ OAuth2 -> URIRef Absolute
    oauth2RedirectUri OAuth2
    oa)
            , (ByteString
    "grant_type", ByteString
    "authorization_code")
            ]
       in (URIRef Absolute
    uri, PostBody
    body)

    -- | Obtain a new access token by sending a Refresh Token to the Authorization server.
    refreshAccessTokenUrl ::
      OAuth2 ->
      -- | Refresh Token gained via authorization URL
      RefreshToken ->
      -- | Refresh Token request URL plus the request body.
      (URI, PostBody)
    refreshAccessTokenUrl :: OAuth2 -> RefreshToken -> (URIRef Absolute, PostBody)
    refreshAccessTokenUrl OAuth2
    oa RefreshToken
    token = (URIRef Absolute
    uri, PostBody
    body)
      where
        uri :: URIRef Absolute
    uri = OAuth2 -> URIRef Absolute
    oauth2TokenEndpoint OAuth2
    oa
        body :: PostBody
    body =
          [ (ByteString
    "grant_type", ByteString
    "refresh_token")
          , (ByteString
    "refresh_token", Text -> ByteString
    T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
    forall a b. (a -> b) -> a -> b
    $ RefreshToken -> Text
    rtoken RefreshToken
    token)
          ]

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

    -- * Token management

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

    -- | Exchange @code@ for an Access Token with authenticate in request header.
    fetchAccessToken ::
      MonadIO m =>
      -- | HTTP connection manager
      Manager ->
      -- | OAuth Data
      OAuth2 ->
      -- | OAuth2 Code
      ExchangeToken ->
      -- | Access Token
      ExceptT TokenResponseError m OAuth2Token
    fetchAccessToken :: forall (m :: * -> *).
    MonadIO m =>
    Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    fetchAccessToken = ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    fetchAccessTokenWithAuthMethod ClientAuthenticationMethod
    ClientSecretBasic

    fetchAccessToken2 ::
      MonadIO m =>
      -- | HTTP connection manager
      Manager ->
      -- | OAuth Data
      OAuth2 ->
      -- | Authorization Code
      ExchangeToken ->
      -- | Access Token
      ExceptT TokenResponseError m OAuth2Token
    fetchAccessToken2 :: forall (m :: * -> *).
    MonadIO m =>
    Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    fetchAccessToken2 = ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    fetchAccessTokenWithAuthMethod ClientAuthenticationMethod
    ClientSecretPost
    {-# DEPRECATED fetchAccessToken2 "use 'fetchAccessTokenWithAuthMethod'" #-}

    fetchAccessTokenInternal ::
      MonadIO m =>
      ClientAuthenticationMethod ->
      -- | HTTP connection manager
      Manager ->
      -- | OAuth Data
      OAuth2 ->
      -- | Authorization Code
      ExchangeToken ->
      -- | Access Token
      ExceptT TokenResponseError m OAuth2Token
    fetchAccessTokenInternal :: forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    fetchAccessTokenInternal = ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    fetchAccessTokenWithAuthMethod
    {-# DEPRECATED fetchAccessTokenInternal "use 'fetchAccessTokenWithAuthMethod'" #-}

    -- | Exchange @code@ for an Access Token
    --
    -- OAuth2 spec allows credential (@client_id@, @client_secret@) to be sent
    -- either in the header (a.k.a `ClientSecretBasic`).
    -- or as form/url params (a.k.a `ClientSecretPost`).
    --
    -- The OAuth provider can choose to implement only one, or both.
    -- Look for API document from the OAuth provider you're dealing with.
    -- If you`re uncertain, try `fetchAccessToken` which sends credential
    -- in authorization http header, which is common case.
    --
    -- @since 2.6.0
    fetchAccessTokenWithAuthMethod ::
      MonadIO m =>
      ClientAuthenticationMethod ->
      -- | HTTP connection manager
      Manager ->
      -- | OAuth Data
      OAuth2 ->
      -- | Authorization Code
      ExchangeToken ->
      -- | Access Token
      ExceptT TokenResponseError m OAuth2Token
    fetchAccessTokenWithAuthMethod :: forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> ExchangeToken
    -> ExceptT TokenResponseError m OAuth2Token
    fetchAccessTokenWithAuthMethod ClientAuthenticationMethod
    authMethod Manager
    manager OAuth2
    oa ExchangeToken
    code = do
      let (URIRef Absolute
    uri, PostBody
    body) = OAuth2 -> ExchangeToken -> (URIRef Absolute, PostBody)
    accessTokenUrl OAuth2
    oa ExchangeToken
    code
      let extraBody :: PostBody
    extraBody = if ClientAuthenticationMethod
    authMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
    forall a. Eq a => a -> a -> Bool
    == ClientAuthenticationMethod
    ClientSecretPost then OAuth2 -> PostBody
    clientSecretPost OAuth2
    oa else []
      Manager
    -> OAuth2
    -> URIRef Absolute
    -> PostBody
    -> ExceptT TokenResponseError m OAuth2Token
    forall (m :: * -> *) a.
    (MonadIO m, FromJSON a) =>
    Manager
    -> OAuth2
    -> URIRef Absolute
    -> PostBody
    -> ExceptT TokenResponseError m a
    doJSONPostRequest Manager
    manager OAuth2
    oa URIRef Absolute
    uri (PostBody
    body PostBody -> PostBody -> PostBody
    forall a. [a] -> [a] -> [a]
    ++ PostBody
    extraBody)

    -- | Fetch a new AccessToken using the Refresh Token with authentication in request header.
    refreshAccessToken ::
      MonadIO m =>
      -- | HTTP connection manager.
      Manager ->
      -- | OAuth context
      OAuth2 ->
      -- | Refresh Token gained after authorization
      RefreshToken ->
      ExceptT TokenResponseError m OAuth2Token
    refreshAccessToken :: forall (m :: * -> *).
    MonadIO m =>
    Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    refreshAccessToken = ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    refreshAccessTokenWithAuthMethod ClientAuthenticationMethod
    ClientSecretBasic

    refreshAccessToken2 ::
      MonadIO m =>
      -- | HTTP connection manager.
      Manager ->
      -- | OAuth context
      OAuth2 ->
      -- | Refresh Token gained after authorization
      RefreshToken ->
      ExceptT TokenResponseError m OAuth2Token
    refreshAccessToken2 :: forall (m :: * -> *).
    MonadIO m =>
    Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    refreshAccessToken2 = ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    refreshAccessTokenWithAuthMethod ClientAuthenticationMethod
    ClientSecretPost
    {-# DEPRECATED refreshAccessToken2 "use 'refreshAccessTokenWithAuthMethod'" #-}

    refreshAccessTokenInternal ::
      MonadIO m =>
      ClientAuthenticationMethod ->
      -- | HTTP connection manager.
      Manager ->
      -- | OAuth context
      OAuth2 ->
      -- | Refresh Token gained after authorization
      RefreshToken ->
      ExceptT TokenResponseError m OAuth2Token
    refreshAccessTokenInternal :: forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    refreshAccessTokenInternal = ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    refreshAccessTokenWithAuthMethod
    {-# DEPRECATED refreshAccessTokenInternal "use 'refreshAccessTokenWithAuthMethod'" #-}

    -- | Fetch a new AccessToken using the Refresh Token.
    --
    -- OAuth2 spec allows credential ("client_id", "client_secret") to be sent
    -- either in the header (a.k.a 'ClientSecretBasic').
    -- or as form/url params (a.k.a 'ClientSecretPost').
    --
    -- The OAuth provider can choose to implement only one, or both.
    -- Look for API document from the OAuth provider you're dealing with.
    -- If you're uncertain, try 'refreshAccessToken' which sends credential
    -- in authorization http header, which is common case.
    --
    -- @since 2.6.0
    refreshAccessTokenWithAuthMethod ::
      MonadIO m =>
      ClientAuthenticationMethod ->
      -- | HTTP connection manager.
      Manager ->
      -- | OAuth context
      OAuth2 ->
      -- | Refresh Token gained after authorization
      RefreshToken ->
      ExceptT TokenResponseError m OAuth2Token
    refreshAccessTokenWithAuthMethod :: forall (m :: * -> *).
    MonadIO m =>
    ClientAuthenticationMethod
    -> Manager
    -> OAuth2
    -> RefreshToken
    -> ExceptT TokenResponseError m OAuth2Token
    refreshAccessTokenWithAuthMethod ClientAuthenticationMethod
    authMethod Manager
    manager OAuth2
    oa RefreshToken
    token = do
      let (URIRef Absolute
    uri, PostBody
    body) = OAuth2 -> RefreshToken -> (URIRef Absolute, PostBody)
    refreshAccessTokenUrl OAuth2
    oa RefreshToken
    token
      let extraBody :: PostBody
    extraBody = if ClientAuthenticationMethod
    authMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
    forall a. Eq a => a -> a -> Bool
    == ClientAuthenticationMethod
    ClientSecretPost then OAuth2 -> PostBody
    clientSecretPost OAuth2
    oa else []
      Manager
    -> OAuth2
    -> URIRef Absolute
    -> PostBody
    -> ExceptT TokenResponseError m OAuth2Token
    forall (m :: * -> *) a.
    (MonadIO m, FromJSON a) =>
    Manager
    -> OAuth2
    -> URIRef Absolute
    -> PostBody
    -> ExceptT TokenResponseError m a
    doJSONPostRequest Manager
    manager OAuth2
    oa URIRef Absolute
    uri (PostBody
    body PostBody -> PostBody -> PostBody
    forall a. [a] -> [a] -> [a]
    ++ PostBody
    extraBody)

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

    -- * Utilies

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

    -- | Conduct post request and return response as JSON.
    doJSONPostRequest ::
      (MonadIO m, FromJSON a) =>
      -- | HTTP connection manager.
      Manager ->
      -- | OAuth options
      OAuth2 ->
      -- | The URL
      URI ->
      -- | request body
      PostBody ->
      -- | Response as JSON
      ExceptT TokenResponseError m a
    doJSONPostRequest :: forall (m :: * -> *) a.
    (MonadIO m, FromJSON a) =>
    Manager
    -> OAuth2
    -> URIRef Absolute
    -> PostBody
    -> ExceptT TokenResponseError m a
    doJSONPostRequest Manager
    manager OAuth2
    oa URIRef Absolute
    uri PostBody
    body = do
      ByteString
    resp <- Manager
    -> OAuth2
    -> URIRef Absolute
    -> PostBody
    -> ExceptT TokenResponseError m ByteString
    forall (m :: * -> *).
    MonadIO m =>
    Manager
    -> OAuth2
    -> URIRef Absolute
    -> PostBody
    -> ExceptT TokenResponseError m ByteString
    doSimplePostRequest Manager
    manager OAuth2
    oa URIRef Absolute
    uri PostBody
    body
      case ByteString -> Either TokenResponseError a
    forall a. FromJSON a => ByteString -> Either TokenResponseError a
    parseResponseFlexible ByteString
    resp of
        Right a
    obj -> a -> ExceptT TokenResponseError m a
    forall a. a -> ExceptT TokenResponseError m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    obj
        Left TokenResponseError
    e -> TokenResponseError -> ExceptT TokenResponseError m a
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
    throwE TokenResponseError
    e

    -- | Conduct post request.
    doSimplePostRequest ::
      MonadIO m =>
      -- | HTTP connection manager.
      Manager ->
      -- | OAuth options
      OAuth2 ->
      -- | URL
      URI ->
      -- | Request body.
      PostBody ->
      -- | Response as ByteString
      ExceptT TokenResponseError m BSL.ByteString
    doSimplePostRequest :: forall (m :: * -> *).
    MonadIO m =>
    Manager
    -> OAuth2
    -> URIRef Absolute
    -> PostBody
    -> ExceptT TokenResponseError m ByteString
    doSimplePostRequest Manager
    manager OAuth2
    oa URIRef Absolute
    url PostBody
    body =
      m (Either TokenResponseError ByteString)
    -> ExceptT TokenResponseError m ByteString
    forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
    ExceptT (m (Either TokenResponseError ByteString)
     -> ExceptT TokenResponseError m ByteString)
    -> (IO (Either TokenResponseError ByteString)
        -> m (Either TokenResponseError ByteString))
    -> IO (Either TokenResponseError ByteString)
    -> ExceptT TokenResponseError m ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Either TokenResponseError ByteString)
    -> m (Either TokenResponseError ByteString)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Either TokenResponseError ByteString)
     -> ExceptT TokenResponseError m ByteString)
    -> IO (Either TokenResponseError ByteString)
    -> ExceptT TokenResponseError m ByteString
    forall a b. (a -> b) -> a -> b
    $ (Response ByteString -> Either TokenResponseError ByteString)
    -> IO (Response ByteString)
    -> IO (Either TokenResponseError ByteString)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Response ByteString -> Either TokenResponseError ByteString
    handleOAuth2TokenResponse IO (Response ByteString)
    go
      where
        go :: IO (Response ByteString)
    go = do
          Request
    req <- URIRef Absolute -> IO Request
    forall (m :: * -> *). MonadThrow m => URIRef Absolute -> m Request
    uriToRequest URIRef Absolute
    url
          let req' :: Request
    req' = (OAuth2 -> Request -> Request
    addBasicAuth OAuth2
    oa (Request -> Request) -> (Request -> Request) -> Request -> Request
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Request -> Request
    addDefaultRequestHeaders) 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

    -- | Gets response body from a @Response@ if 200 otherwise assume 'Network.OAuth.OAuth2.TokenRequest.TokenResponseError'
    handleOAuth2TokenResponse :: Response BSL.ByteString -> Either TokenResponseError BSL.ByteString
    handleOAuth2TokenResponse :: Response ByteString -> Either TokenResponseError 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 TokenResponseError ByteString
    forall a b. b -> Either a b
    Right (ByteString -> Either TokenResponseError ByteString)
    -> ByteString -> Either TokenResponseError ByteString
    forall a b. (a -> b) -> a -> b
    $ Response ByteString -> ByteString
    forall body. Response body -> body
    responseBody Response ByteString
    rsp
        else TokenResponseError -> Either TokenResponseError ByteString
    forall a b. a -> Either a b
    Left (TokenResponseError -> Either TokenResponseError ByteString)
    -> TokenResponseError -> Either TokenResponseError ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> TokenResponseError
    parseTokeResponseError (Response ByteString -> ByteString
    forall body. Response body -> body
    responseBody Response ByteString
    rsp)

    -- | Try to parses response as JSON, if failed, try to parse as like query string.
    parseResponseFlexible ::
      FromJSON a =>
      BSL.ByteString ->
      Either TokenResponseError a
    parseResponseFlexible :: forall a. FromJSON a => ByteString -> Either TokenResponseError 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 TokenResponseError a
    forall a. FromJSON a => ByteString -> Either TokenResponseError a
    parseResponseString ByteString
    r
      Right a
    x -> a -> Either TokenResponseError a
    forall a b. b -> Either a b
    Right a
    x

    -- | Parses the response that contains not JSON but a Query String
    parseResponseString ::
      FromJSON a =>
      BSL.ByteString ->
      Either TokenResponseError a
    parseResponseString :: forall a. FromJSON a => ByteString -> Either TokenResponseError 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
      [] -> TokenResponseError -> Either TokenResponseError a
    forall a b. a -> Either a b
    Left TokenResponseError
    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
    _ -> TokenResponseError -> Either TokenResponseError a
    forall a b. a -> Either a b
    Left TokenResponseError
    errorMessage
        Success a
    x -> a -> Either TokenResponseError 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 :: TokenResponseError
    errorMessage = ByteString -> TokenResponseError
    parseTokeResponseError ByteString
    b

    -- | Add Basic Authentication header using client_id and client_secret.
    addBasicAuth :: OAuth2 -> Request -> Request
    addBasicAuth :: OAuth2 -> Request -> Request
    addBasicAuth OAuth2
    oa =
      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)

    -- | Set several header values:
    --   + userAgennt    : "hoauth2"
    --   + accept        : "application/json"
    addDefaultRequestHeaders :: Request -> Request
    addDefaultRequestHeaders :: Request -> Request
    addDefaultRequestHeaders Request
    req =
      let headers :: [(HeaderName, ByteString)]
    headers = [(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}

    -- | Add Credential (client_id, client_secret) to the request post body.
    clientSecretPost :: OAuth2 -> PostBody
    clientSecretPost :: OAuth2 -> PostBody
    clientSecretPost OAuth2
    oa =
      [ (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)
      ]