{-# 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
    , TokenRequest AuthorizationCodeApplication -> Maybe ClientId
trClientId :: Maybe ClientId
    , TokenRequest AuthorizationCodeApplication -> Maybe ClientSecret
trClientSecret :: Maybe ClientSecret
    }

  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
      , trClientId :: Maybe ClientId
trClientId = if ClientAuthenticationMethod
acTokenRequestAuthenticationMethod 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
      , trClientSecret :: Maybe ClientSecret
trClientSecret = if ClientAuthenticationMethod
acTokenRequestAuthenticationMethod 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
      }

instance ToQueryParam (TokenRequest AuthorizationCodeApplication) where
  toQueryParam :: TokenRequest AuthorizationCodeApplication -> Map Text Text
  toQueryParam :: TokenRequest AuthorizationCodeApplication -> Map Text Text
toQueryParam AuthorizationCodeTokenRequest {Maybe ClientSecret
Maybe ClientId
ExchangeToken
RedirectUri
GrantTypeValue
trCode :: TokenRequest AuthorizationCodeApplication -> ExchangeToken
trGrantType :: TokenRequest AuthorizationCodeApplication -> GrantTypeValue
trRedirectUri :: TokenRequest AuthorizationCodeApplication -> RedirectUri
trClientId :: TokenRequest AuthorizationCodeApplication -> Maybe ClientId
trClientSecret :: TokenRequest AuthorizationCodeApplication -> Maybe ClientSecret
trCode :: ExchangeToken
trGrantType :: GrantTypeValue
trRedirectUri :: RedirectUri
trClientId :: Maybe ClientId
trClientSecret :: Maybe ClientSecret
..} =
    [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
      , Maybe ClientId -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Maybe ClientId
trClientId
      , Maybe ClientSecret -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Maybe ClientSecret
trClientSecret
      ]

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
      , rrClientId :: Maybe ClientId
rrClientId = if ClientAuthenticationMethod
acTokenRequestAuthenticationMethod 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
acTokenRequestAuthenticationMethod 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
      }