{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Req.OAuth2.Internal.AccessToken
( AccessTokenRequest(..)
, AccessTokenResponse(..)
, fetchAccessToken
) where
import Data.Aeson ((.:), withObject)
import Data.Aeson.Types (Parser, Value, parseEither)
import Data.Text (Text)
import Network.HTTP.Req ((=:), useHttpsURI)
import Network.HTTP.Req.OAuth2.Internal.AuthCode
import Network.HTTP.Req.OAuth2.Internal.Types
import Network.HTTP.Req.OAuth2.Internal.Util
data AccessTokenRequest = AccessTokenRequest AuthCode
data AccessTokenResponse = AccessTokenResponse TokenPair
fetchAccessToken :: App -> AccessTokenRequest -> IO (Either String AccessTokenResponse)
fetchAccessToken :: App -> AccessTokenRequest -> IO (Either String AccessTokenResponse)
fetchAccessToken App
app (AccessTokenRequest (AuthCode Text
ac)) = do
let clientPair :: ClientPair
clientPair = App -> ClientPair
appClientPair App
app
ClientPair (ClientId Text
cid) ClientSecret
_ = ClientPair
clientPair
Just (Url 'Https
url, Option Any
_) = URI -> Maybe (Url 'Https, Option Any)
forall (scheme :: Scheme). URI -> Maybe (Url 'Https, Option scheme)
useHttpsURI (URI -> Maybe (Url 'Https, Option Any))
-> URI -> Maybe (Url 'Https, Option Any)
forall a b. (a -> b) -> a -> b
$ App -> URI
appTokenUri App
app
(Value -> Parser AccessTokenResponse)
-> Value -> Either String AccessTokenResponse
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser AccessTokenResponse
pResponse (Value -> Either String AccessTokenResponse)
-> IO Value -> IO (Either String AccessTokenResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Url 'Https -> Option 'Https -> FormUrlEncodedParam -> IO Value
oAuth2PostRaw
Url 'Https
url
(ClientPair -> Option 'Https
forall (scheme :: Scheme). ClientPair -> Option scheme
oAuth2AuthHeader ClientPair
clientPair)
(Text
"code" Text -> Text -> FormUrlEncodedParam
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Text
ac FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
forall a. Semigroup a => a -> a -> a
<> Text
"grant_type" Text -> Text -> FormUrlEncodedParam
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"authorization_code" :: Text) FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
forall a. Semigroup a => a -> a -> a
<> Text
"client_id" Text -> Text -> FormUrlEncodedParam
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Text
cid FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
forall a. Semigroup a => a -> a -> a
<> Text
"expires_in" Text -> Text -> FormUrlEncodedParam
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"3600" :: Text))
pResponse :: Value -> Parser AccessTokenResponse
pResponse :: Value -> Parser AccessTokenResponse
pResponse =
String
-> (Object -> Parser AccessTokenResponse)
-> Value
-> Parser AccessTokenResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AccessTokenResponse" ((Object -> Parser AccessTokenResponse)
-> Value -> Parser AccessTokenResponse)
-> (Object -> Parser AccessTokenResponse)
-> Value
-> Parser AccessTokenResponse
forall a b. (a -> b) -> a -> b
$ \Object
v -> (TokenPair -> AccessTokenResponse
AccessTokenResponse (TokenPair -> AccessTokenResponse)
-> (RefreshToken -> TokenPair)
-> RefreshToken
-> AccessTokenResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((RefreshToken -> TokenPair)
-> RefreshToken -> AccessTokenResponse)
-> (AccessToken -> RefreshToken -> TokenPair)
-> AccessToken
-> RefreshToken
-> AccessTokenResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessToken -> RefreshToken -> TokenPair
TokenPair
(AccessToken -> RefreshToken -> AccessTokenResponse)
-> Parser AccessToken
-> Parser (RefreshToken -> AccessTokenResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> AccessToken
AccessToken (Text -> AccessToken) -> Parser Text -> Parser AccessToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"access_token")
Parser (RefreshToken -> AccessTokenResponse)
-> Parser RefreshToken -> Parser AccessTokenResponse
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> RefreshToken
RefreshToken (Text -> RefreshToken) -> Parser Text -> Parser RefreshToken
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"refresh_token")