    {-# 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