{-# LANGUAGE OverloadedStrings #-}
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
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
(Int -> TokenRequestError -> ShowS)
-> (TokenRequestError -> String)
-> ([TokenRequestError] -> ShowS)
-> Show TokenRequestError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenRequestError -> ShowS
showsPrec :: Int -> TokenRequestError -> ShowS
$cshow :: TokenRequestError -> String
show :: TokenRequestError -> String
$cshowList :: [TokenRequestError] -> ShowS
showList :: [TokenRequestError] -> ShowS
Show, TokenRequestError -> TokenRequestError -> Bool
(TokenRequestError -> TokenRequestError -> Bool)
-> (TokenRequestError -> TokenRequestError -> Bool)
-> Eq TokenRequestError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenRequestError -> TokenRequestError -> Bool
== :: TokenRequestError -> TokenRequestError -> Bool
$c/= :: TokenRequestError -> TokenRequestError -> Bool
/= :: TokenRequestError -> TokenRequestError -> Bool
Eq, (forall x. TokenRequestError -> Rep TokenRequestError x)
-> (forall x. Rep TokenRequestError x -> TokenRequestError)
-> Generic TokenRequestError
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
$cfrom :: forall x. TokenRequestError -> Rep TokenRequestError x
from :: forall x. TokenRequestError -> Rep TokenRequestError x
$cto :: forall x. Rep TokenRequestError x -> TokenRequestError
to :: forall x. Rep TokenRequestError x -> TokenRequestError
Generic)
data TokenRequestErrorCode
= InvalidRequest
| InvalidClient
| InvalidGrant
| UnauthorizedClient
| UnsupportedGrantType
| InvalidScope
| UnknownErrorCode Text
deriving (Int -> TokenRequestErrorCode -> ShowS
[TokenRequestErrorCode] -> ShowS
TokenRequestErrorCode -> String
(Int -> TokenRequestErrorCode -> ShowS)
-> (TokenRequestErrorCode -> String)
-> ([TokenRequestErrorCode] -> ShowS)
-> Show TokenRequestErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TokenRequestErrorCode -> ShowS
showsPrec :: Int -> TokenRequestErrorCode -> ShowS
$cshow :: TokenRequestErrorCode -> String
show :: TokenRequestErrorCode -> String
$cshowList :: [TokenRequestErrorCode] -> ShowS
showList :: [TokenRequestErrorCode] -> ShowS
Show, TokenRequestErrorCode -> TokenRequestErrorCode -> Bool
(TokenRequestErrorCode -> TokenRequestErrorCode -> Bool)
-> (TokenRequestErrorCode -> TokenRequestErrorCode -> Bool)
-> Eq TokenRequestErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TokenRequestErrorCode -> TokenRequestErrorCode -> Bool
== :: TokenRequestErrorCode -> TokenRequestErrorCode -> Bool
$c/= :: TokenRequestErrorCode -> TokenRequestErrorCode -> Bool
/= :: TokenRequestErrorCode -> TokenRequestErrorCode -> Bool
Eq)
instance FromJSON TokenRequestErrorCode where
parseJSON :: Value -> Parser TokenRequestErrorCode
parseJSON = String
-> (Text -> Parser TokenRequestErrorCode)
-> Value
-> Parser TokenRequestErrorCode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"parseJSON TokenRequestErrorCode" ((Text -> Parser TokenRequestErrorCode)
-> Value -> Parser TokenRequestErrorCode)
-> (Text -> Parser TokenRequestErrorCode)
-> Value
-> Parser TokenRequestErrorCode
forall a b. (a -> b) -> a -> b
$ \Text
t ->
TokenRequestErrorCode -> Parser TokenRequestErrorCode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TokenRequestErrorCode -> Parser TokenRequestErrorCode)
-> TokenRequestErrorCode -> Parser TokenRequestErrorCode
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 = Options -> Value -> Parser TokenRequestError
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 =
(String -> TokenRequestError)
-> (TokenRequestError -> TokenRequestError)
-> Either String TokenRequestError
-> TokenRequestError
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> String -> TokenRequestError
mkDecodeOAuth2Error ByteString
string) TokenRequestError -> TokenRequestError
forall a. a -> a
id (ByteString -> Either String TokenRequestError
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
"")
(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 TokenRequestError 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
accessTokenUrl ::
OAuth2 ->
ExchangeToken ->
(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)
refreshAccessTokenUrl ::
OAuth2 ->
RefreshToken ->
(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)
]
fetchAccessToken ::
(MonadIO m) =>
Manager ->
OAuth2 ->
ExchangeToken ->
ExceptT TokenRequestError m OAuth2Token
fetchAccessToken :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessToken = ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessTokenWithAuthMethod ClientAuthenticationMethod
ClientSecretBasic
fetchAccessToken2 ::
(MonadIO m) =>
Manager ->
OAuth2 ->
ExchangeToken ->
ExceptT TokenRequestError m OAuth2Token
fetchAccessToken2 :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessToken2 = ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessTokenWithAuthMethod ClientAuthenticationMethod
ClientSecretPost
{-# DEPRECATED fetchAccessToken2 "use 'fetchAccessTokenWithAuthMethod'" #-}
fetchAccessTokenInternal ::
(MonadIO m) =>
ClientAuthenticationMethod ->
Manager ->
OAuth2 ->
ExchangeToken ->
ExceptT TokenRequestError m OAuth2Token
fetchAccessTokenInternal :: forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessTokenInternal = ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> ExchangeToken
-> ExceptT TokenRequestError m OAuth2Token
fetchAccessTokenWithAuthMethod
{-# DEPRECATED fetchAccessTokenInternal "use 'fetchAccessTokenWithAuthMethod'" #-}
fetchAccessTokenWithAuthMethod ::
(MonadIO m) =>
ClientAuthenticationMethod ->
Manager ->
OAuth2 ->
ExchangeToken ->
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 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 TokenRequestError m OAuth2Token
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 PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ PostBody
extraBody)
refreshAccessToken ::
(MonadIO m) =>
Manager ->
OAuth2 ->
RefreshToken ->
ExceptT TokenRequestError m OAuth2Token
refreshAccessToken :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessToken = ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessTokenWithAuthMethod ClientAuthenticationMethod
ClientSecretBasic
refreshAccessToken2 ::
(MonadIO m) =>
Manager ->
OAuth2 ->
RefreshToken ->
ExceptT TokenRequestError m OAuth2Token
refreshAccessToken2 :: forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessToken2 = ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessTokenWithAuthMethod ClientAuthenticationMethod
ClientSecretPost
{-# DEPRECATED refreshAccessToken2 "use 'refreshAccessTokenWithAuthMethod'" #-}
refreshAccessTokenInternal ::
(MonadIO m) =>
ClientAuthenticationMethod ->
Manager ->
OAuth2 ->
RefreshToken ->
ExceptT TokenRequestError m OAuth2Token
refreshAccessTokenInternal :: forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessTokenInternal = ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
forall (m :: * -> *).
MonadIO m =>
ClientAuthenticationMethod
-> Manager
-> OAuth2
-> RefreshToken
-> ExceptT TokenRequestError m OAuth2Token
refreshAccessTokenWithAuthMethod
{-# DEPRECATED refreshAccessTokenInternal "use 'refreshAccessTokenWithAuthMethod'" #-}
refreshAccessTokenWithAuthMethod ::
(MonadIO m) =>
ClientAuthenticationMethod ->
Manager ->
OAuth2 ->
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 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 TokenRequestError m OAuth2Token
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 PostBody -> PostBody -> PostBody
forall a. [a] -> [a] -> [a]
++ PostBody
extraBody)
doJSONPostRequest ::
(MonadIO m, FromJSON a) =>
Manager ->
OAuth2 ->
URI ->
PostBody ->
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 <- Manager
-> OAuth2
-> URIRef Absolute
-> PostBody
-> ExceptT TokenRequestError m ByteString
forall (m :: * -> *).
MonadIO m =>
Manager
-> OAuth2
-> URIRef Absolute
-> PostBody
-> ExceptT TokenRequestError m ByteString
doSimplePostRequest Manager
manager OAuth2
oa URIRef Absolute
uri PostBody
body
case ByteString -> Either TokenRequestError a
forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseFlexible ByteString
resp of
Right a
obj -> a -> ExceptT TokenRequestError m a
forall a. a -> ExceptT TokenRequestError m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
obj
Left TokenRequestError
e -> TokenRequestError -> ExceptT TokenRequestError m a
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE TokenRequestError
e
doSimplePostRequest ::
(MonadIO m) =>
Manager ->
OAuth2 ->
URI ->
PostBody ->
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 =
m (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString)
-> (IO (Either TokenRequestError ByteString)
-> m (Either TokenRequestError ByteString))
-> IO (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either TokenRequestError ByteString)
-> m (Either TokenRequestError ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString)
-> IO (Either TokenRequestError ByteString)
-> ExceptT TokenRequestError m ByteString
forall a b. (a -> b) -> a -> b
$ (Response ByteString -> Either TokenRequestError ByteString)
-> IO (Response ByteString)
-> IO (Either TokenRequestError 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 TokenRequestError ByteString
handleOAuth2TokenResponse IO (Response ByteString)
go
where
addBasicAuth :: Request -> Request
addBasicAuth = 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)
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' = (Request -> Request
addBasicAuth (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
handleOAuth2TokenResponse :: Response BSL.ByteString -> Either TokenRequestError BSL.ByteString
handleOAuth2TokenResponse :: Response ByteString -> Either TokenRequestError 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 TokenRequestError ByteString
forall a b. b -> Either a b
Right (ByteString -> Either TokenRequestError ByteString)
-> ByteString -> Either TokenRequestError ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp
else TokenRequestError -> Either TokenRequestError ByteString
forall a b. a -> Either a b
Left (TokenRequestError -> Either TokenRequestError ByteString)
-> TokenRequestError -> Either TokenRequestError ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> TokenRequestError
parseTokeRequestError (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
rsp)
parseResponseFlexible ::
(FromJSON a) =>
BSL.ByteString ->
Either TokenRequestError a
parseResponseFlexible :: forall a. FromJSON a => ByteString -> Either TokenRequestError 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 TokenRequestError a
forall a. FromJSON a => ByteString -> Either TokenRequestError a
parseResponseString ByteString
r
Right a
x -> a -> Either TokenRequestError a
forall a b. b -> Either a b
Right a
x
parseResponseString ::
(FromJSON a) =>
BSL.ByteString ->
Either TokenRequestError a
parseResponseString :: forall a. FromJSON a => ByteString -> Either TokenRequestError 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
[] -> TokenRequestError -> Either TokenRequestError a
forall a b. a -> Either a b
Left TokenRequestError
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
_ -> TokenRequestError -> Either TokenRequestError a
forall a b. a -> Either a b
Left TokenRequestError
errorMessage
Success a
x -> a -> Either TokenRequestError 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 :: TokenRequestError
errorMessage = ByteString -> TokenRequestError
parseTokeRequestError ByteString
b
addDefaultRequestHeaders :: Request -> Request
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 :: [(HeaderName, ByteString)]
requestHeaders = [(HeaderName, ByteString)]
headers}
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)
]