{-# LANGUAGE OverloadedStrings #-}

-- | 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 GHC.Generics (Generic)
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

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

-- * Token Request Errors

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

data TokenRequestError = TokenRequestError
  { TokenRequestError -> TokenRequestErrorCode
error :: TokenRequestErrorCode
  , TokenRequestError -> Maybe Text
errorDescription :: Maybe Text
  , TokenRequestError -> Maybe (URIRef Absolute)
errorUri :: Maybe (URIRef Absolute)
  }
  deriving (Int -> TokenRequestError -> ShowS
[TokenRequestError] -> ShowS
TokenRequestError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokenRequestError] -> ShowS
$cshowList :: [TokenRequestError] -> ShowS
show :: TokenRequestError -> String
$cshow :: TokenRequestError -> String
showsPrec :: Int -> TokenRequestError -> ShowS
$cshowsPrec :: Int -> TokenRequestError -> ShowS
Show, TokenRequestError -> TokenRequestError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokenRequestError -> TokenRequestError -> Bool
$c/= :: TokenRequestError -> TokenRequestError -> Bool
== :: TokenRequestError -> TokenRequestError -> Bool
$c== :: TokenRequestError -> TokenRequestError -> Bool
Eq, forall x. Rep TokenRequestError x -> TokenRequestError
forall x. TokenRequestError -> Rep TokenRequestError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TokenRequestError x -> TokenRequestError
$cfrom :: forall x. TokenRequestError -> Rep TokenRequestError x
Generic)

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

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

instance FromJSON TokenRequestError where
  parseJSON :: Value -> Parser TokenRequestError
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {constructorTagModifier :: ShowS
constructorTagModifier = Char -> ShowS
camelTo2 Char
'_'}

parseTokeRequestError :: BSL.ByteString -> TokenRequestError
parseTokeRequestError :: ByteString -> TokenRequestError
parseTokeRequestError ByteString
string =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> String -> TokenRequestError
mkDecodeOAuth2Error ByteString
string) forall a. a -> a
id (forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
string)
  where
    mkDecodeOAuth2Error :: BSL.ByteString -> String -> TokenRequestError
    mkDecodeOAuth2Error :: ByteString -> String -> TokenRequestError
mkDecodeOAuth2Error ByteString
response String
err =
      TokenRequestErrorCode
-> Maybe Text -> Maybe (URIRef Absolute) -> TokenRequestError
TokenRequestError
        (Text -> TokenRequestErrorCode
UnknownErrorCode Text
"")
        (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ String
"Decode TokenRequestError failed: " forall a. Semigroup a => a -> a -> a
<> String
err forall a. Semigroup a => a -> a -> a
<> String
"\n Original Response:\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ByteString -> Text
T.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
response))
        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 forall a b. (a -> b) -> a -> b
$ ExchangeToken -> Text
extoken ExchangeToken
code)
        , (ByteString
"redirect_uri", forall a. URIRef a -> ByteString
serializeURIRef' 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 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 TokenRequestError m OAuth2Token
fetchAccessToken :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessToken = forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessTokenWithAuthMethod ClientAuthenticationMethod
ClientSecretBasic

fetchAccessToken2 ::
  (MonadIO m) =>
  -- | HTTP connection manager
  Manager ->
  -- | OAuth Data
  OAuth2 ->
  -- | Authorization Code
  ExchangeToken ->
  -- | Access Token
  ExceptT TokenRequestError m OAuth2Token
fetchAccessToken2 :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessToken2 = forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError 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 TokenRequestError m OAuth2Token
fetchAccessTokenInternal :: forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessTokenInternal = forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError 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 TokenRequestError m OAuth2Token
fetchAccessTokenWithAuthMethod :: forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError 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 forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost then OAuth2 -> PostBody
clientSecretPost OAuth2
oa else []
  forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URIRef Absolute
-> PostBody
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
manager OAuth2
oa URIRef Absolute
uri (PostBody
body 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 TokenRequestError m OAuth2Token
refreshAccessToken :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessToken = forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessTokenWithAuthMethod ClientAuthenticationMethod
ClientSecretBasic

refreshAccessToken2 ::
  (MonadIO m) =>
  -- | HTTP connection manager.
  Manager ->
  -- | OAuth context
  OAuth2 ->
  -- | Refresh Token gained after authorization
  RefreshToken ->
  ExceptT TokenRequestError m OAuth2Token
refreshAccessToken2 :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessToken2 = forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError 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 TokenRequestError m OAuth2Token
refreshAccessTokenInternal :: forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessTokenInternal = forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError 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 TokenRequestError m OAuth2Token
refreshAccessTokenWithAuthMethod :: forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError 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 forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost then OAuth2 -> PostBody
clientSecretPost OAuth2
oa else []
  forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URIRef Absolute
-> PostBody
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
manager OAuth2
oa URIRef Absolute
uri (PostBody
body 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 TokenRequestError m a
doJSONPostRequest :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> OAuth2
-> URIRef Absolute
-> PostBody
-> ExceptT TokenRequestError m a
doJSONPostRequest Manager
manager OAuth2
oa URIRef Absolute
uri PostBody
body = do
  ByteString
resp <- forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> URIRef Absolute
-> PostBody
-> ExceptT TokenRequestError m ByteString
doSimplePostRequest Manager
manager OAuth2
oa URIRef Absolute
uri PostBody
body
  case forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseFlexible ByteString
resp of
    Right a
obj -> forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
    Left TokenRequestError
e -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TokenRequestError
e

-- | Conduct post request.
doSimplePostRequest ::
  (MonadIO m) =>
  -- | HTTP connection manager.
  Manager ->
  -- | OAuth options
  OAuth2 ->
  -- | URL
  URI ->
  -- | Request body.
  PostBody ->
  -- | Response as ByteString
  ExceptT TokenRequestError m BSL.ByteString
doSimplePostRequest :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> URIRef Absolute
-> PostBody
-> ExceptT TokenRequestError m ByteString
doSimplePostRequest Manager
manager OAuth2
oa URIRef Absolute
url PostBody
body =
  forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response ByteString -> Either TokenRequestError ByteString
handleOAuth2TokenResponse IO (Response ByteString)
go
  where
    addBasicAuth :: Request -> Request
addBasicAuth = ByteString -> ByteString -> Request -> Request
applyBasicAuth (Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientId OAuth2
oa) (Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientSecret OAuth2
oa)
    go :: IO (Response ByteString)
go = do
      Request
req <- forall (m :: * -> *). MonadThrow m => URIRef Absolute -> m Request
uriToRequest URIRef Absolute
url
      let req' :: Request
req' = (Request -> Request
addBasicAuth forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
addDefaultRequestHeaders) Request
req
      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 'OAuth2Error'
handleOAuth2TokenResponse :: Response BSL.ByteString -> Either TokenRequestError BSL.ByteString
handleOAuth2TokenResponse :: Response ByteString -> Either TokenRequestError ByteString
handleOAuth2TokenResponse Response ByteString
rsp =
  if Status -> Bool
HT.statusIsSuccessful (forall body. Response body -> Status
responseStatus Response ByteString
rsp)
    then forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall body. Response body -> body
responseBody Response ByteString
rsp
    else forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ ByteString -> TokenRequestError
parseTokeRequestError (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 TokenRequestError a
parseResponseFlexible :: forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseFlexible ByteString
r = case forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
r of
  Left String
_ -> forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseString ByteString
r
  Right a
x -> 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 TokenRequestError a
parseResponseString :: forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseString ByteString
b = case ByteString -> Query
parseQuery forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.toStrict ByteString
b of
  [] -> forall a b. a -> Either a b
Left TokenRequestError
errorMessage
  Query
a -> case forall a. FromJSON a => Value -> Result a
fromJSON forall a b. (a -> b) -> a -> b
$ Query -> Value
queryToValue Query
a of
    Error String
_ -> forall a b. a -> Either a b
Left TokenRequestError
errorMessage
    Success a
x -> forall a b. b -> Either a b
Right a
x
  where
    queryToValue :: Query -> Value
queryToValue = Object -> Value
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. [(Key, v)] -> KeyMap v
KeyMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
k, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
Null (Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
T.decodeUtf8) Maybe ByteString
mv)
    errorMessage :: TokenRequestError
errorMessage = ByteString -> TokenRequestError
parseTokeRequestError ByteString
b

-- | 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 forall a. [a] -> [a] -> [a]
++ Request -> [(HeaderName, ByteString)]
requestHeaders Request
req
   in Request
req {requestHeaders :: [(HeaderName, ByteString)]
requestHeaders = [(HeaderName, ByteString)]
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 forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientId OAuth2
oa)
  , (ByteString
"client_secret", Text -> ByteString
T.encodeUtf8 forall a b. (a -> b) -> a -> b
$ OAuth2 -> Text
oauth2ClientSecret OAuth2
oa)
  ]