content: {-# 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.OAuth2 (ClientAuthenticationMethod (..))
  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
    { ccClientId :: ClientId
    , ccClientSecret :: ClientSecret
    , ccName :: Text
    , ccScope :: Set Scope
    , ccTokenRequestExtraParams :: Map Text Text
    , ccClientAuthenticationMethod :: ClientAuthenticationMethod
    }
  
  instance HasClientAuthenticationMethod ClientCredentialsApplication where
    getClientAuthenticationMethod :: ClientCredentialsApplication -> ClientAuthenticationMethod
    getClientAuthenticationMethod ClientCredentialsApplication {..} = ccClientAuthenticationMethod
  
    addClientAuthToHeader ClientCredentialsApplication {..} = addSecretToHeader ccClientId ccClientSecret
  
  -- | https://www.rfc-editor.org/rfc/rfc6749#section-4.4.2
  instance HasTokenRequest ClientCredentialsApplication where
    type ExchangeTokenInfo ClientCredentialsApplication = NoNeedExchangeToken
    data TokenRequest ClientCredentialsApplication = ClientCredentialsTokenRequest
      { trScope :: Set Scope
      , trGrantType :: GrantTypeValue
      , trClientSecret :: ClientSecret
      , trClientId :: ClientId
      , trExtraParams :: Map Text Text
      , trClientAuthenticationMethod :: ClientAuthenticationMethod
      }
  
    mkTokenRequestParam :: ClientCredentialsApplication -> NoNeedExchangeToken -> TokenRequest ClientCredentialsApplication
    mkTokenRequestParam ClientCredentialsApplication {..} _ =
      ClientCredentialsTokenRequest
        { trScope = ccScope
        , trGrantType = GTClientCredentials
        , trClientSecret = ccClientSecret
        , trClientAuthenticationMethod = ccClientAuthenticationMethod
        , trExtraParams = ccTokenRequestExtraParams
        , trClientId = ccClientId
        }
  
  instance ToQueryParam (TokenRequest ClientCredentialsApplication) where
    toQueryParam :: TokenRequest ClientCredentialsApplication -> Map Text Text
    toQueryParam ClientCredentialsTokenRequest {..} =
      let extraBodyBasedOnClientAuthMethod =
            case trClientAuthenticationMethod of
              ClientAssertionJwt ->
                [ Map.fromList
                    [ ("client_assertion_type", "urn:ietf:params:oauth:client-assertion-type:jwt-bearer")
                    , ("client_assertion", bs8ToLazyText $ tlToBS $ unClientSecret trClientSecret)
                    ]
                ]
              ClientSecretPost -> [toQueryParam trClientId, toQueryParam trClientSecret]
              ClientSecretBasic -> []
       in Map.unions $
            [ toQueryParam trGrantType
            , toQueryParam trScope
            , trExtraParams
            ]
              ++ extraBodyBasedOnClientAuthMethod
  