{-# LANGUAGE FlexibleInstances #-}

module Network.OAuth2.Experiment.Grants.AuthorizationCode where

import Control.Monad.IO.Class (MonadIO (..))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Set (Set)
import Data.Text.Lazy (Text)
import Network.OAuth2 (ClientAuthenticationMethod (..), ExchangeToken (..))
import Network.OAuth2 qualified as OAuth2
import Network.OAuth2.Experiment.Flows.AuthorizationRequest
import Network.OAuth2.Experiment.Flows.RefreshTokenRequest
import Network.OAuth2.Experiment.Flows.TokenRequest
import Network.OAuth2.Experiment.Flows.UserInfoRequest
import Network.OAuth2.Experiment.Pkce
import Network.OAuth2.Experiment.Types
import Network.OAuth2.Experiment.Utils
import URI.ByteString hiding (UserInfo)

-- | An Application that supports "Authorization code" flow
--
-- https://www.rfc-editor.org/rfc/rfc6749#section-4.1
data AuthorizationCodeApplication = AuthorizationCodeApplication
  { AuthorizationCodeApplication -> Text
acName :: Text
  , AuthorizationCodeApplication -> ClientId
acClientId :: ClientId
  , AuthorizationCodeApplication -> ClientSecret
acClientSecret :: ClientSecret
  , AuthorizationCodeApplication -> Set Scope
acScope :: Set Scope
  , AuthorizationCodeApplication -> URI
acRedirectUri :: URI
  , AuthorizationCodeApplication -> AuthorizeState
acAuthorizeState :: AuthorizeState
  , AuthorizationCodeApplication -> Map Text Text
acAuthorizeRequestExtraParams :: Map Text Text
  , AuthorizationCodeApplication -> ClientAuthenticationMethod
acClientAuthenticationMethod :: ClientAuthenticationMethod
  }

instance HasClientAuthenticationMethod AuthorizationCodeApplication where
  getClientAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
  getClientAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
getClientAuthenticationMethod AuthorizationCodeApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
AuthorizeState
ClientSecret
ClientId
acName :: AuthorizationCodeApplication -> Text
acClientId :: AuthorizationCodeApplication -> ClientId
acClientSecret :: AuthorizationCodeApplication -> ClientSecret
acScope :: AuthorizationCodeApplication -> Set Scope
acRedirectUri :: AuthorizationCodeApplication -> URI
acAuthorizeState :: AuthorizationCodeApplication -> AuthorizeState
acAuthorizeRequestExtraParams :: AuthorizationCodeApplication -> Map Text Text
acClientAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acClientAuthenticationMethod :: ClientAuthenticationMethod
..} = ClientAuthenticationMethod
acClientAuthenticationMethod
  addClientAuthToHeader :: AuthorizationCodeApplication -> Request -> Request
addClientAuthToHeader AuthorizationCodeApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
AuthorizeState
ClientSecret
ClientId
acName :: AuthorizationCodeApplication -> Text
acClientId :: AuthorizationCodeApplication -> ClientId
acClientSecret :: AuthorizationCodeApplication -> ClientSecret
acScope :: AuthorizationCodeApplication -> Set Scope
acRedirectUri :: AuthorizationCodeApplication -> URI
acAuthorizeState :: AuthorizationCodeApplication -> AuthorizeState
acAuthorizeRequestExtraParams :: AuthorizationCodeApplication -> Map Text Text
acClientAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acClientAuthenticationMethod :: ClientAuthenticationMethod
..} = ClientId -> ClientSecret -> Request -> Request
addSecretToHeader ClientId
acClientId ClientSecret
acClientSecret

mkAuthorizationRequestParam :: AuthorizationCodeApplication -> AuthorizationRequestParam
mkAuthorizationRequestParam :: AuthorizationCodeApplication -> AuthorizationRequestParam
mkAuthorizationRequestParam AuthorizationCodeApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
AuthorizeState
ClientSecret
ClientId
acName :: AuthorizationCodeApplication -> Text
acClientId :: AuthorizationCodeApplication -> ClientId
acClientSecret :: AuthorizationCodeApplication -> ClientSecret
acScope :: AuthorizationCodeApplication -> Set Scope
acRedirectUri :: AuthorizationCodeApplication -> URI
acAuthorizeState :: AuthorizationCodeApplication -> AuthorizeState
acAuthorizeRequestExtraParams :: AuthorizationCodeApplication -> Map Text Text
acClientAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acClientAuthenticationMethod :: ClientAuthenticationMethod
..} =
  AuthorizationRequestParam
    { arScope :: Set Scope
arScope = Set Scope
acScope
    , arState :: AuthorizeState
arState = AuthorizeState
acAuthorizeState
    , arClientId :: ClientId
arClientId = ClientId
acClientId
    , arRedirectUri :: Maybe RedirectUri
arRedirectUri = RedirectUri -> Maybe RedirectUri
forall a. a -> Maybe a
Just (URI -> RedirectUri
RedirectUri URI
acRedirectUri)
    , arResponseType :: ResponseType
arResponseType = ResponseType
Code
    , arExtraParams :: Map Text Text
arExtraParams = Map Text Text
acAuthorizeRequestExtraParams
    }

mkPkceAuthorizeRequestParam :: MonadIO m => AuthorizationCodeApplication -> m (AuthorizationRequestParam, CodeVerifier)
mkPkceAuthorizeRequestParam :: forall (m :: * -> *).
MonadIO m =>
AuthorizationCodeApplication
-> m (AuthorizationRequestParam, CodeVerifier)
mkPkceAuthorizeRequestParam AuthorizationCodeApplication
app = do
  PkceRequestParam {CodeChallengeMethod
CodeVerifier
CodeChallenge
codeVerifier :: CodeVerifier
codeChallenge :: CodeChallenge
codeChallengeMethod :: CodeChallengeMethod
codeChallengeMethod :: PkceRequestParam -> CodeChallengeMethod
codeChallenge :: PkceRequestParam -> CodeChallenge
codeVerifier :: PkceRequestParam -> CodeVerifier
..} <- m PkceRequestParam
forall (m :: * -> *). MonadIO m => m PkceRequestParam
mkPkceParam
  let authReqParam :: AuthorizationRequestParam
authReqParam = AuthorizationCodeApplication -> AuthorizationRequestParam
mkAuthorizationRequestParam AuthorizationCodeApplication
app
      combinatedExtraParams :: Map Text Text
combinatedExtraParams =
        [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
          [ AuthorizationRequestParam -> Map Text Text
arExtraParams AuthorizationRequestParam
authReqParam
          , CodeChallenge -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam CodeChallenge
codeChallenge
          , CodeChallengeMethod -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam CodeChallengeMethod
codeChallengeMethod
          ]
  (AuthorizationRequestParam, CodeVerifier)
-> m (AuthorizationRequestParam, CodeVerifier)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AuthorizationRequestParam
authReqParam {arExtraParams = combinatedExtraParams}, CodeVerifier
codeVerifier)

-- | https://www.rfc-editor.org/rfc/rfc6749#section-4.1.3
instance HasTokenRequest AuthorizationCodeApplication where
  type ExchangeTokenInfo AuthorizationCodeApplication = ExchangeToken
  data TokenRequest AuthorizationCodeApplication = AuthorizationCodeTokenRequest
    { TokenRequest AuthorizationCodeApplication -> ExchangeToken
trCode :: ExchangeToken
    , TokenRequest AuthorizationCodeApplication -> GrantTypeValue
trGrantType :: GrantTypeValue
    , TokenRequest AuthorizationCodeApplication -> RedirectUri
trRedirectUri :: RedirectUri
    , TokenRequest AuthorizationCodeApplication -> ClientId
trClientId :: ClientId
    , TokenRequest AuthorizationCodeApplication -> ClientSecret
trClientSecret :: ClientSecret
    , TokenRequest AuthorizationCodeApplication
-> ClientAuthenticationMethod
trClientAuthenticationMethod :: ClientAuthenticationMethod
    }

  mkTokenRequestParam :: AuthorizationCodeApplication -> ExchangeToken -> TokenRequest AuthorizationCodeApplication
  mkTokenRequestParam :: AuthorizationCodeApplication
-> ExchangeToken -> TokenRequest AuthorizationCodeApplication
mkTokenRequestParam AuthorizationCodeApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
AuthorizeState
ClientSecret
ClientId
acName :: AuthorizationCodeApplication -> Text
acClientId :: AuthorizationCodeApplication -> ClientId
acClientSecret :: AuthorizationCodeApplication -> ClientSecret
acScope :: AuthorizationCodeApplication -> Set Scope
acRedirectUri :: AuthorizationCodeApplication -> URI
acAuthorizeState :: AuthorizationCodeApplication -> AuthorizeState
acAuthorizeRequestExtraParams :: AuthorizationCodeApplication -> Map Text Text
acClientAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acClientAuthenticationMethod :: ClientAuthenticationMethod
..} ExchangeToken
authCode =
    AuthorizationCodeTokenRequest
      { trCode :: ExchangeToken
trCode = ExchangeToken
authCode
      , trGrantType :: GrantTypeValue
trGrantType = GrantTypeValue
GTAuthorizationCode
      , trRedirectUri :: RedirectUri
trRedirectUri = URI -> RedirectUri
RedirectUri URI
acRedirectUri
      , trClientId :: ClientId
trClientId = ClientId
acClientId
      , trClientSecret :: ClientSecret
trClientSecret = ClientSecret
acClientSecret
      , trClientAuthenticationMethod :: ClientAuthenticationMethod
trClientAuthenticationMethod = ClientAuthenticationMethod
acClientAuthenticationMethod
      }

instance ToQueryParam (TokenRequest AuthorizationCodeApplication) where
  toQueryParam :: TokenRequest AuthorizationCodeApplication -> Map Text Text
  toQueryParam :: TokenRequest AuthorizationCodeApplication -> Map Text Text
toQueryParam AuthorizationCodeTokenRequest {ClientAuthenticationMethod
ExchangeToken
RedirectUri
ClientSecret
ClientId
GrantTypeValue
trCode :: TokenRequest AuthorizationCodeApplication -> ExchangeToken
trGrantType :: TokenRequest AuthorizationCodeApplication -> GrantTypeValue
trRedirectUri :: TokenRequest AuthorizationCodeApplication -> RedirectUri
trClientId :: TokenRequest AuthorizationCodeApplication -> ClientId
trClientSecret :: TokenRequest AuthorizationCodeApplication -> ClientSecret
trClientAuthenticationMethod :: TokenRequest AuthorizationCodeApplication
-> ClientAuthenticationMethod
trCode :: ExchangeToken
trGrantType :: GrantTypeValue
trRedirectUri :: RedirectUri
trClientId :: ClientId
trClientSecret :: ClientSecret
trClientAuthenticationMethod :: ClientAuthenticationMethod
..} =
    let extraBodyBasedOnClientAuthMethod :: [Map Text Text]
extraBodyBasedOnClientAuthMethod =
          case ClientAuthenticationMethod
trClientAuthenticationMethod of
            ClientAuthenticationMethod
ClientAssertionJwt ->
              [ [(Text, Text)] -> Map Text Text
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (Text
"client_assertion_type", Text
"urn:ietf:params:oauth:client-assertion-type:jwt-bearer")
                  , (Text
"client_assertion", ByteString -> Text
bs8ToLazyText (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
tlToBS (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ClientSecret -> Text
unClientSecret ClientSecret
trClientSecret)
                  ]
              ]
            ClientAuthenticationMethod
ClientSecretPost -> [ClientId -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ClientId
trClientId, ClientSecret -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ClientSecret
trClientSecret]
            ClientAuthenticationMethod
ClientSecretBasic -> []
     in [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions ([Map Text Text] -> Map Text Text)
-> [Map Text Text] -> Map Text Text
forall a b. (a -> b) -> a -> b
$
          [ ExchangeToken -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ExchangeToken
trCode
          , GrantTypeValue -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
trGrantType
          , RedirectUri -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam RedirectUri
trRedirectUri
          ]
            [Map Text Text] -> [Map Text Text] -> [Map Text Text]
forall a. [a] -> [a] -> [a]
++ [Map Text Text]
extraBodyBasedOnClientAuthMethod

instance HasUserInfoRequest AuthorizationCodeApplication

instance HasRefreshTokenRequest AuthorizationCodeApplication where
  mkRefreshTokenRequestParam :: AuthorizationCodeApplication -> OAuth2.RefreshToken -> RefreshTokenRequest
  mkRefreshTokenRequestParam :: AuthorizationCodeApplication -> RefreshToken -> RefreshTokenRequest
mkRefreshTokenRequestParam AuthorizationCodeApplication {Map Text Text
Text
Set Scope
URI
ClientAuthenticationMethod
AuthorizeState
ClientSecret
ClientId
acName :: AuthorizationCodeApplication -> Text
acClientId :: AuthorizationCodeApplication -> ClientId
acClientSecret :: AuthorizationCodeApplication -> ClientSecret
acScope :: AuthorizationCodeApplication -> Set Scope
acRedirectUri :: AuthorizationCodeApplication -> URI
acAuthorizeState :: AuthorizationCodeApplication -> AuthorizeState
acAuthorizeRequestExtraParams :: AuthorizationCodeApplication -> Map Text Text
acClientAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acClientAuthenticationMethod :: ClientAuthenticationMethod
..} RefreshToken
rt =
    RefreshTokenRequest
      { rrScope :: Set Scope
rrScope = Set Scope
acScope
      , rrGrantType :: GrantTypeValue
rrGrantType = GrantTypeValue
GTRefreshToken
      , rrRefreshToken :: RefreshToken
rrRefreshToken = RefreshToken
rt
      , rrClientId :: Maybe ClientId
rrClientId = if ClientAuthenticationMethod
acClientAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost then ClientId -> Maybe ClientId
forall a. a -> Maybe a
Just ClientId
acClientId else Maybe ClientId
forall a. Maybe a
Nothing
      , rrClientSecret :: Maybe ClientSecret
rrClientSecret = if ClientAuthenticationMethod
acClientAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientSecretPost then ClientSecret -> Maybe ClientSecret
forall a. a -> Maybe a
Just ClientSecret
acClientSecret else Maybe ClientSecret
forall a. Maybe a
Nothing
      }