{-# LANGUAGE OverloadedStrings #-}

module Network.HTTP.Req.OAuth2.Internal.RefreshToken
    ( RefreshTokenRequest(..)
    , RefreshTokenResponse(..)
    , fetchRefreshToken
    ) 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.Types
import           Network.HTTP.Req.OAuth2.Internal.Util

data RefreshTokenRequest = RefreshTokenRequest RefreshToken

data RefreshTokenResponse = RefreshTokenResponse TokenPair

fetchRefreshToken :: App -> RefreshTokenRequest -> IO (Either String RefreshTokenResponse)
fetchRefreshToken :: App
-> RefreshTokenRequest -> IO (Either String RefreshTokenResponse)
fetchRefreshToken App
app (RefreshTokenRequest (RefreshToken Text
rt)) = do
    let clientPair :: ClientPair
clientPair = App -> ClientPair
appClientPair App
app
        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 RefreshTokenResponse)
-> Value -> Either String RefreshTokenResponse
forall a b. (a -> Parser b) -> a -> Either String b
parseEither Value -> Parser RefreshTokenResponse
pResponse (Value -> Either String RefreshTokenResponse)
-> IO Value -> IO (Either String RefreshTokenResponse)
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
"grant_type" Text -> Text -> FormUrlEncodedParam
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"refresh_token" :: Text) FormUrlEncodedParam -> FormUrlEncodedParam -> FormUrlEncodedParam
forall a. Semigroup a => a -> a -> a
<> Text
"refresh_token" Text -> Text -> FormUrlEncodedParam
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: Text
rt 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 RefreshTokenResponse
pResponse :: Value -> Parser RefreshTokenResponse
pResponse =
    String
-> (Object -> Parser RefreshTokenResponse)
-> Value
-> Parser RefreshTokenResponse
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RefreshTokenResponse" ((Object -> Parser RefreshTokenResponse)
 -> Value -> Parser RefreshTokenResponse)
-> (Object -> Parser RefreshTokenResponse)
-> Value
-> Parser RefreshTokenResponse
forall a b. (a -> b) -> a -> b
$ \Object
v -> (TokenPair -> RefreshTokenResponse
RefreshTokenResponse (TokenPair -> RefreshTokenResponse)
-> (RefreshToken -> TokenPair)
-> RefreshToken
-> RefreshTokenResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ) ((RefreshToken -> TokenPair)
 -> RefreshToken -> RefreshTokenResponse)
-> (AccessToken -> RefreshToken -> TokenPair)
-> AccessToken
-> RefreshToken
-> RefreshTokenResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AccessToken -> RefreshToken -> TokenPair
TokenPair
        (AccessToken -> RefreshToken -> RefreshTokenResponse)
-> Parser AccessToken
-> Parser (RefreshToken -> RefreshTokenResponse)
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 -> RefreshTokenResponse)
-> Parser RefreshToken -> Parser RefreshTokenResponse
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")