{-# 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.OAuth.OAuth2 (ClientAuthenticationMethod (..), ExchangeToken (..), OAuth2)
import Network.OAuth.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 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
acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
  }

instance HasOAuth2Key AuthorizationCodeApplication where
  mkOAuth2Key :: AuthorizationCodeApplication -> OAuth2
  mkOAuth2Key :: AuthorizationCodeApplication -> OAuth2
mkOAuth2Key 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
acTokenRequestAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
..} = ClientId -> ClientSecret -> OAuth2
toOAuth2Key ClientId
acClientId ClientSecret
acClientSecret

instance HasTokenRequestClientAuthenticationMethod 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
acTokenRequestAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
..} = ClientAuthenticationMethod
acTokenRequestAuthenticationMethod

instance HasAuthorizeRequest AuthorizationCodeApplication where
  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
acTokenRequestAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acTokenRequestAuthenticationMethod :: 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
      }

instance HasPkceAuthorizeRequest AuthorizationCodeApplication where
  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
codeVerifier :: PkceRequestParam -> CodeVerifier
codeChallenge :: PkceRequestParam -> CodeChallenge
codeChallengeMethod :: PkceRequestParam -> CodeChallengeMethod
..} <- m PkceRequestParam
forall (m :: * -> *). MonadIO m => m PkceRequestParam
mkPkceParam
    let authReqParam :: AuthorizationRequestParam
authReqParam = AuthorizationCodeApplication -> AuthorizationRequestParam
forall a. HasAuthorizeRequest a => a -> 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
    }

  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
acTokenRequestAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
..} ExchangeToken
authCode =
    AuthorizationCodeTokenRequest
      { trCode :: ExchangeToken
trCode = ExchangeToken
authCode
      , trGrantType :: GrantTypeValue
trGrantType = GrantTypeValue
GTAuthorizationCode
      , trRedirectUri :: RedirectUri
trRedirectUri = URI -> RedirectUri
RedirectUri URI
acRedirectUri
      }

instance ToQueryParam (TokenRequest AuthorizationCodeApplication) where
  toQueryParam :: TokenRequest AuthorizationCodeApplication -> Map Text Text
  toQueryParam :: TokenRequest AuthorizationCodeApplication -> Map Text Text
toQueryParam AuthorizationCodeTokenRequest {ExchangeToken
RedirectUri
GrantTypeValue
trCode :: TokenRequest AuthorizationCodeApplication -> ExchangeToken
trGrantType :: TokenRequest AuthorizationCodeApplication -> GrantTypeValue
trRedirectUri :: TokenRequest AuthorizationCodeApplication -> RedirectUri
trCode :: ExchangeToken
trGrantType :: GrantTypeValue
trRedirectUri :: RedirectUri
..} =
    [Map Text Text] -> Map Text Text
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
Map.unions
      [ 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
      ]

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
acTokenRequestAuthenticationMethod :: AuthorizationCodeApplication -> ClientAuthenticationMethod
acName :: Text
acClientId :: ClientId
acClientSecret :: ClientSecret
acScope :: Set Scope
acRedirectUri :: URI
acAuthorizeState :: AuthorizeState
acAuthorizeRequestExtraParams :: Map Text Text
acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
..} RefreshToken
rt =
    RefreshTokenRequest
      { rrScope :: Set Scope
rrScope = Set Scope
acScope
      , rrGrantType :: GrantTypeValue
rrGrantType = GrantTypeValue
GTRefreshToken
      , rrRefreshToken :: RefreshToken
rrRefreshToken = RefreshToken
rt
      }