{-# LANGUAGE FlexibleInstances #-}

module Network.OAuth2.Experiment.Grants.ClientCredentials where

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 (..), OAuth2)
import Network.OAuth2.Experiment.Flows.TokenRequest
import Network.OAuth2.Experiment.Types
import Network.OAuth2.Experiment.Utils

-- | An Application that supports "Client Credentials" flow
--
-- https://www.rfc-editor.org/rfc/rfc6749#section-4.4
data ClientCredentialsApplication = ClientCredentialsApplication
  { ClientCredentialsApplication -> ClientId
ccClientId :: ClientId
  , ClientCredentialsApplication -> ClientSecret
ccClientSecret :: ClientSecret
  , ClientCredentialsApplication -> Text
ccName :: Text
  , ClientCredentialsApplication -> Set Scope
ccScope :: Set Scope
  , ClientCredentialsApplication -> Map Text Text
ccTokenRequestExtraParams :: Map Text Text
  , ClientCredentialsApplication -> ClientAuthenticationMethod
ccTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
  }

instance HasOAuth2Key ClientCredentialsApplication where
  mkOAuth2Key :: ClientCredentialsApplication -> OAuth2
  mkOAuth2Key :: ClientCredentialsApplication -> OAuth2
mkOAuth2Key ClientCredentialsApplication {Map Text Text
Text
Set Scope
ClientAuthenticationMethod
ClientSecret
ClientId
ccClientId :: ClientCredentialsApplication -> ClientId
ccClientSecret :: ClientCredentialsApplication -> ClientSecret
ccName :: ClientCredentialsApplication -> Text
ccScope :: ClientCredentialsApplication -> Set Scope
ccTokenRequestExtraParams :: ClientCredentialsApplication -> Map Text Text
ccTokenRequestAuthenticationMethod :: ClientCredentialsApplication -> ClientAuthenticationMethod
ccClientId :: ClientId
ccClientSecret :: ClientSecret
ccName :: Text
ccScope :: Set Scope
ccTokenRequestExtraParams :: Map Text Text
ccTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
..} = ClientId -> ClientSecret -> OAuth2
toOAuth2Key ClientId
ccClientId ClientSecret
ccClientSecret

instance HasTokenRequestClientAuthenticationMethod ClientCredentialsApplication where
  getClientAuthenticationMethod :: ClientCredentialsApplication -> ClientAuthenticationMethod
  getClientAuthenticationMethod :: ClientCredentialsApplication -> ClientAuthenticationMethod
getClientAuthenticationMethod ClientCredentialsApplication {Map Text Text
Text
Set Scope
ClientAuthenticationMethod
ClientSecret
ClientId
ccClientId :: ClientCredentialsApplication -> ClientId
ccClientSecret :: ClientCredentialsApplication -> ClientSecret
ccName :: ClientCredentialsApplication -> Text
ccScope :: ClientCredentialsApplication -> Set Scope
ccTokenRequestExtraParams :: ClientCredentialsApplication -> Map Text Text
ccTokenRequestAuthenticationMethod :: ClientCredentialsApplication -> ClientAuthenticationMethod
ccClientId :: ClientId
ccClientSecret :: ClientSecret
ccName :: Text
ccScope :: Set Scope
ccTokenRequestExtraParams :: Map Text Text
ccTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
..} = ClientAuthenticationMethod
ccTokenRequestAuthenticationMethod

-- | https://www.rfc-editor.org/rfc/rfc6749#section-4.4.2
instance HasTokenRequest ClientCredentialsApplication where
  type ExchangeTokenInfo ClientCredentialsApplication = NoNeedExchangeToken
  data TokenRequest ClientCredentialsApplication = ClientCredentialsTokenRequest
    { TokenRequest ClientCredentialsApplication -> Set Scope
trScope :: Set Scope
    , TokenRequest ClientCredentialsApplication -> GrantTypeValue
trGrantType :: GrantTypeValue
    , TokenRequest ClientCredentialsApplication -> ClientSecret
trClientSecret :: ClientSecret
    , TokenRequest ClientCredentialsApplication -> ClientId
trClientId :: ClientId
    , TokenRequest ClientCredentialsApplication -> Map Text Text
trExtraParams :: Map Text Text
    , TokenRequest ClientCredentialsApplication
-> ClientAuthenticationMethod
trClientAuthenticationMethod :: ClientAuthenticationMethod
    }

  mkTokenRequestParam :: ClientCredentialsApplication -> NoNeedExchangeToken -> TokenRequest ClientCredentialsApplication
  mkTokenRequestParam :: ClientCredentialsApplication
-> NoNeedExchangeToken -> TokenRequest ClientCredentialsApplication
mkTokenRequestParam ClientCredentialsApplication {Map Text Text
Text
Set Scope
ClientAuthenticationMethod
ClientSecret
ClientId
ccClientId :: ClientCredentialsApplication -> ClientId
ccClientSecret :: ClientCredentialsApplication -> ClientSecret
ccName :: ClientCredentialsApplication -> Text
ccScope :: ClientCredentialsApplication -> Set Scope
ccTokenRequestExtraParams :: ClientCredentialsApplication -> Map Text Text
ccTokenRequestAuthenticationMethod :: ClientCredentialsApplication -> ClientAuthenticationMethod
ccClientId :: ClientId
ccClientSecret :: ClientSecret
ccName :: Text
ccScope :: Set Scope
ccTokenRequestExtraParams :: Map Text Text
ccTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
..} NoNeedExchangeToken
_ =
    ClientCredentialsTokenRequest
      { trScope :: Set Scope
trScope = Set Scope
ccScope
      , trGrantType :: GrantTypeValue
trGrantType = GrantTypeValue
GTClientCredentials
      , trClientSecret :: ClientSecret
trClientSecret = ClientSecret
ccClientSecret
      , trClientAuthenticationMethod :: ClientAuthenticationMethod
trClientAuthenticationMethod = ClientAuthenticationMethod
ccTokenRequestAuthenticationMethod
      , trExtraParams :: Map Text Text
trExtraParams = Map Text Text
ccTokenRequestExtraParams
      , trClientId :: ClientId
trClientId = ClientId
ccClientId
      }

instance ToQueryParam (TokenRequest ClientCredentialsApplication) where
  toQueryParam :: TokenRequest ClientCredentialsApplication -> Map Text Text
  toQueryParam :: TokenRequest ClientCredentialsApplication -> Map Text Text
toQueryParam ClientCredentialsTokenRequest {Map Text Text
Set Scope
ClientAuthenticationMethod
ClientSecret
ClientId
GrantTypeValue
trScope :: TokenRequest ClientCredentialsApplication -> Set Scope
trGrantType :: TokenRequest ClientCredentialsApplication -> GrantTypeValue
trClientSecret :: TokenRequest ClientCredentialsApplication -> ClientSecret
trClientId :: TokenRequest ClientCredentialsApplication -> ClientId
trExtraParams :: TokenRequest ClientCredentialsApplication -> Map Text Text
trClientAuthenticationMethod :: TokenRequest ClientCredentialsApplication
-> ClientAuthenticationMethod
trScope :: Set Scope
trGrantType :: GrantTypeValue
trClientSecret :: ClientSecret
trClientId :: ClientId
trExtraParams :: Map Text Text
trClientAuthenticationMethod :: ClientAuthenticationMethod
..} =
    let jwtAssertionBody :: [Map Text Text]
jwtAssertionBody =
          if ClientAuthenticationMethod
trClientAuthenticationMethod ClientAuthenticationMethod -> ClientAuthenticationMethod -> Bool
forall a. Eq a => a -> a -> Bool
== ClientAuthenticationMethod
ClientAssertionJwt
            then
              [ ClientId -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam ClientId
trClientId
              , [(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)
                  ]
              ]
            else []
     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
$
          [ GrantTypeValue -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam GrantTypeValue
trGrantType
          , Set Scope -> Map Text Text
forall a. ToQueryParam a => a -> Map Text Text
toQueryParam Set Scope
trScope
          , Map Text Text
trExtraParams
          ]
            [Map Text Text] -> [Map Text Text] -> [Map Text Text]
forall a. [a] -> [a] -> [a]
++ [Map Text Text]
jwtAssertionBody