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)
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)
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
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 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 =>
Manager ->
OAuth2 ->
ExchangeToken ->
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 ->
Manager ->
OAuth2 ->
ExchangeToken ->
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'" #-}
fetchAccessTokenWithAuthMethod ::
MonadIO m =>
ClientAuthenticationMethod ->
Manager ->
OAuth2 ->
ExchangeToken ->
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)
refreshAccessToken ::
MonadIO m =>
Manager ->
OAuth2 ->
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 =>
Manager ->
OAuth2 ->
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 ->
Manager ->
OAuth2 ->
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'" #-}
refreshAccessTokenWithAuthMethod ::
MonadIO m =>
ClientAuthenticationMethod ->
Manager ->
OAuth2 ->
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)
doJSONPostRequest ::
(MonadIO m, FromJSON a) =>
Manager ->
OAuth2 ->
URI ->
PostBody ->
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
doSimplePostRequest ::
MonadIO m =>
Manager ->
OAuth2 ->
URI ->
PostBody ->
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
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)
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
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
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)
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 = 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)
]