{-# LANGUAGE OverloadedStrings #-}
{-|
    Module: Web.OIDC.Client.Internal
    Maintainer: krdlab@gmail.com
    Stability: experimental
-}
module Web.OIDC.Client.Internal where

import           Control.Applicative   ((<|>))
import           Control.Monad         (mzero)
import           Control.Monad.Catch   (MonadCatch, MonadThrow, throwM)
import           Data.Aeson            (FromJSON, Value (..), parseJSON, (.:),
                                        (.:?))
import           Data.Aeson.Types      (Parser)
import           Data.Text             (Text, unpack)
import           Data.Text.Read        (decimal)
import           Jose.Jwt              (Jwt)
import           Network.HTTP.Client   (HttpException, Request, parseRequest)
import           Prelude               hiding (exp)
import           Web.OIDC.Client.Types (OpenIdException (InternalHttpException))

data TokensResponse = TokensResponse
    { TokensResponse -> Text
accessToken  :: !Text
    , TokensResponse -> Text
tokenType    :: !Text
    , TokensResponse -> Jwt
idToken      :: !Jwt
    , TokensResponse -> Maybe Integer
expiresIn    :: !(Maybe Integer)
    , TokensResponse -> Maybe Text
refreshToken :: !(Maybe Text)
    }
  deriving (Int -> TokensResponse -> ShowS
[TokensResponse] -> ShowS
TokensResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TokensResponse] -> ShowS
$cshowList :: [TokensResponse] -> ShowS
show :: TokensResponse -> String
$cshow :: TokensResponse -> String
showsPrec :: Int -> TokensResponse -> ShowS
$cshowsPrec :: Int -> TokensResponse -> ShowS
Show, TokensResponse -> TokensResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TokensResponse -> TokensResponse -> Bool
$c/= :: TokensResponse -> TokensResponse -> Bool
== :: TokensResponse -> TokensResponse -> Bool
$c== :: TokensResponse -> TokensResponse -> Bool
Eq)

instance FromJSON TokensResponse where
    parseJSON :: Value -> Parser TokensResponse
parseJSON (Object Object
o) = Text
-> Text -> Jwt -> Maybe Integer -> Maybe Text -> TokensResponse
TokensResponse
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>  Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"access_token"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"token_type"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"id_token"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expires_in") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe Text -> Parser (Maybe Integer)
textToInt forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expires_in")))
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh_token"
    parseJSON Value
_          = forall (m :: * -> *) a. MonadPlus m => m a
mzero

textToInt :: Maybe Text -> Parser (Maybe Integer)
textToInt :: Maybe Text -> Parser (Maybe Integer)
textToInt (Just Text
t) =
    case forall a. Integral a => Reader a
decimal Text
t of
        Right (Integer
i, Text
_) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Integer
i
        Left  String
_      -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expires_in: expected a decimal text, encountered a non decimal text"
textToInt Maybe Text
_        = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

rethrow :: (MonadCatch m) => HttpException -> m a
rethrow :: forall (m :: * -> *) a. MonadCatch m => HttpException -> m a
rethrow = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> OpenIdException
InternalHttpException

parseUrl :: MonadThrow m => Text -> m Request
parseUrl :: forall (m :: * -> *). MonadThrow m => Text -> m Request
parseUrl = forall (m :: * -> *). MonadThrow m => String -> m Request
Network.HTTP.Client.parseRequest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack