{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.AppFlow.Types.CustomConnectorProfileCredentials
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.AppFlow.Types.CustomConnectorProfileCredentials where

import Amazonka.AppFlow.Types.ApiKeyCredentials
import Amazonka.AppFlow.Types.AuthenticationType
import Amazonka.AppFlow.Types.BasicAuthCredentials
import Amazonka.AppFlow.Types.CustomAuthCredentials
import Amazonka.AppFlow.Types.OAuth2Credentials
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | The connector-specific profile credentials that are required when using
-- the custom connector.
--
-- /See:/ 'newCustomConnectorProfileCredentials' smart constructor.
data CustomConnectorProfileCredentials = CustomConnectorProfileCredentials'
  { -- | The API keys required for the authentication of the user.
    CustomConnectorProfileCredentials -> Maybe ApiKeyCredentials
apiKey :: Prelude.Maybe ApiKeyCredentials,
    -- | The basic credentials that are required for the authentication of the
    -- user.
    CustomConnectorProfileCredentials -> Maybe BasicAuthCredentials
basic :: Prelude.Maybe BasicAuthCredentials,
    -- | If the connector uses the custom authentication mechanism, this holds
    -- the required credentials.
    CustomConnectorProfileCredentials -> Maybe CustomAuthCredentials
custom :: Prelude.Maybe CustomAuthCredentials,
    -- | The OAuth 2.0 credentials required for the authentication of the user.
    CustomConnectorProfileCredentials -> Maybe OAuth2Credentials
oauth2 :: Prelude.Maybe OAuth2Credentials,
    -- | The authentication type that the custom connector uses for
    -- authenticating while creating a connector profile.
    CustomConnectorProfileCredentials -> AuthenticationType
authenticationType :: AuthenticationType
  }
  deriving (CustomConnectorProfileCredentials
-> CustomConnectorProfileCredentials -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CustomConnectorProfileCredentials
-> CustomConnectorProfileCredentials -> Bool
$c/= :: CustomConnectorProfileCredentials
-> CustomConnectorProfileCredentials -> Bool
== :: CustomConnectorProfileCredentials
-> CustomConnectorProfileCredentials -> Bool
$c== :: CustomConnectorProfileCredentials
-> CustomConnectorProfileCredentials -> Bool
Prelude.Eq, Int -> CustomConnectorProfileCredentials -> ShowS
[CustomConnectorProfileCredentials] -> ShowS
CustomConnectorProfileCredentials -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CustomConnectorProfileCredentials] -> ShowS
$cshowList :: [CustomConnectorProfileCredentials] -> ShowS
show :: CustomConnectorProfileCredentials -> String
$cshow :: CustomConnectorProfileCredentials -> String
showsPrec :: Int -> CustomConnectorProfileCredentials -> ShowS
$cshowsPrec :: Int -> CustomConnectorProfileCredentials -> ShowS
Prelude.Show, forall x.
Rep CustomConnectorProfileCredentials x
-> CustomConnectorProfileCredentials
forall x.
CustomConnectorProfileCredentials
-> Rep CustomConnectorProfileCredentials x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CustomConnectorProfileCredentials x
-> CustomConnectorProfileCredentials
$cfrom :: forall x.
CustomConnectorProfileCredentials
-> Rep CustomConnectorProfileCredentials x
Prelude.Generic)

-- |
-- Create a value of 'CustomConnectorProfileCredentials' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'apiKey', 'customConnectorProfileCredentials_apiKey' - The API keys required for the authentication of the user.
--
-- 'basic', 'customConnectorProfileCredentials_basic' - The basic credentials that are required for the authentication of the
-- user.
--
-- 'custom', 'customConnectorProfileCredentials_custom' - If the connector uses the custom authentication mechanism, this holds
-- the required credentials.
--
-- 'oauth2', 'customConnectorProfileCredentials_oauth2' - The OAuth 2.0 credentials required for the authentication of the user.
--
-- 'authenticationType', 'customConnectorProfileCredentials_authenticationType' - The authentication type that the custom connector uses for
-- authenticating while creating a connector profile.
newCustomConnectorProfileCredentials ::
  -- | 'authenticationType'
  AuthenticationType ->
  CustomConnectorProfileCredentials
newCustomConnectorProfileCredentials :: AuthenticationType -> CustomConnectorProfileCredentials
newCustomConnectorProfileCredentials
  AuthenticationType
pAuthenticationType_ =
    CustomConnectorProfileCredentials'
      { $sel:apiKey:CustomConnectorProfileCredentials' :: Maybe ApiKeyCredentials
apiKey =
          forall a. Maybe a
Prelude.Nothing,
        $sel:basic:CustomConnectorProfileCredentials' :: Maybe BasicAuthCredentials
basic = forall a. Maybe a
Prelude.Nothing,
        $sel:custom:CustomConnectorProfileCredentials' :: Maybe CustomAuthCredentials
custom = forall a. Maybe a
Prelude.Nothing,
        $sel:oauth2:CustomConnectorProfileCredentials' :: Maybe OAuth2Credentials
oauth2 = forall a. Maybe a
Prelude.Nothing,
        $sel:authenticationType:CustomConnectorProfileCredentials' :: AuthenticationType
authenticationType =
          AuthenticationType
pAuthenticationType_
      }

-- | The API keys required for the authentication of the user.
customConnectorProfileCredentials_apiKey :: Lens.Lens' CustomConnectorProfileCredentials (Prelude.Maybe ApiKeyCredentials)
customConnectorProfileCredentials_apiKey :: Lens' CustomConnectorProfileCredentials (Maybe ApiKeyCredentials)
customConnectorProfileCredentials_apiKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CustomConnectorProfileCredentials' {Maybe ApiKeyCredentials
apiKey :: Maybe ApiKeyCredentials
$sel:apiKey:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe ApiKeyCredentials
apiKey} -> Maybe ApiKeyCredentials
apiKey) (\s :: CustomConnectorProfileCredentials
s@CustomConnectorProfileCredentials' {} Maybe ApiKeyCredentials
a -> CustomConnectorProfileCredentials
s {$sel:apiKey:CustomConnectorProfileCredentials' :: Maybe ApiKeyCredentials
apiKey = Maybe ApiKeyCredentials
a} :: CustomConnectorProfileCredentials)

-- | The basic credentials that are required for the authentication of the
-- user.
customConnectorProfileCredentials_basic :: Lens.Lens' CustomConnectorProfileCredentials (Prelude.Maybe BasicAuthCredentials)
customConnectorProfileCredentials_basic :: Lens'
  CustomConnectorProfileCredentials (Maybe BasicAuthCredentials)
customConnectorProfileCredentials_basic = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CustomConnectorProfileCredentials' {Maybe BasicAuthCredentials
basic :: Maybe BasicAuthCredentials
$sel:basic:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe BasicAuthCredentials
basic} -> Maybe BasicAuthCredentials
basic) (\s :: CustomConnectorProfileCredentials
s@CustomConnectorProfileCredentials' {} Maybe BasicAuthCredentials
a -> CustomConnectorProfileCredentials
s {$sel:basic:CustomConnectorProfileCredentials' :: Maybe BasicAuthCredentials
basic = Maybe BasicAuthCredentials
a} :: CustomConnectorProfileCredentials)

-- | If the connector uses the custom authentication mechanism, this holds
-- the required credentials.
customConnectorProfileCredentials_custom :: Lens.Lens' CustomConnectorProfileCredentials (Prelude.Maybe CustomAuthCredentials)
customConnectorProfileCredentials_custom :: Lens'
  CustomConnectorProfileCredentials (Maybe CustomAuthCredentials)
customConnectorProfileCredentials_custom = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CustomConnectorProfileCredentials' {Maybe CustomAuthCredentials
custom :: Maybe CustomAuthCredentials
$sel:custom:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe CustomAuthCredentials
custom} -> Maybe CustomAuthCredentials
custom) (\s :: CustomConnectorProfileCredentials
s@CustomConnectorProfileCredentials' {} Maybe CustomAuthCredentials
a -> CustomConnectorProfileCredentials
s {$sel:custom:CustomConnectorProfileCredentials' :: Maybe CustomAuthCredentials
custom = Maybe CustomAuthCredentials
a} :: CustomConnectorProfileCredentials)

-- | The OAuth 2.0 credentials required for the authentication of the user.
customConnectorProfileCredentials_oauth2 :: Lens.Lens' CustomConnectorProfileCredentials (Prelude.Maybe OAuth2Credentials)
customConnectorProfileCredentials_oauth2 :: Lens' CustomConnectorProfileCredentials (Maybe OAuth2Credentials)
customConnectorProfileCredentials_oauth2 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CustomConnectorProfileCredentials' {Maybe OAuth2Credentials
oauth2 :: Maybe OAuth2Credentials
$sel:oauth2:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe OAuth2Credentials
oauth2} -> Maybe OAuth2Credentials
oauth2) (\s :: CustomConnectorProfileCredentials
s@CustomConnectorProfileCredentials' {} Maybe OAuth2Credentials
a -> CustomConnectorProfileCredentials
s {$sel:oauth2:CustomConnectorProfileCredentials' :: Maybe OAuth2Credentials
oauth2 = Maybe OAuth2Credentials
a} :: CustomConnectorProfileCredentials)

-- | The authentication type that the custom connector uses for
-- authenticating while creating a connector profile.
customConnectorProfileCredentials_authenticationType :: Lens.Lens' CustomConnectorProfileCredentials AuthenticationType
customConnectorProfileCredentials_authenticationType :: Lens' CustomConnectorProfileCredentials AuthenticationType
customConnectorProfileCredentials_authenticationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CustomConnectorProfileCredentials' {AuthenticationType
authenticationType :: AuthenticationType
$sel:authenticationType:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> AuthenticationType
authenticationType} -> AuthenticationType
authenticationType) (\s :: CustomConnectorProfileCredentials
s@CustomConnectorProfileCredentials' {} AuthenticationType
a -> CustomConnectorProfileCredentials
s {$sel:authenticationType:CustomConnectorProfileCredentials' :: AuthenticationType
authenticationType = AuthenticationType
a} :: CustomConnectorProfileCredentials)

instance
  Prelude.Hashable
    CustomConnectorProfileCredentials
  where
  hashWithSalt :: Int -> CustomConnectorProfileCredentials -> Int
hashWithSalt
    Int
_salt
    CustomConnectorProfileCredentials' {Maybe ApiKeyCredentials
Maybe BasicAuthCredentials
Maybe CustomAuthCredentials
Maybe OAuth2Credentials
AuthenticationType
authenticationType :: AuthenticationType
oauth2 :: Maybe OAuth2Credentials
custom :: Maybe CustomAuthCredentials
basic :: Maybe BasicAuthCredentials
apiKey :: Maybe ApiKeyCredentials
$sel:authenticationType:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> AuthenticationType
$sel:oauth2:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe OAuth2Credentials
$sel:custom:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe CustomAuthCredentials
$sel:basic:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe BasicAuthCredentials
$sel:apiKey:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe ApiKeyCredentials
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ApiKeyCredentials
apiKey
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BasicAuthCredentials
basic
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CustomAuthCredentials
custom
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OAuth2Credentials
oauth2
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AuthenticationType
authenticationType

instance
  Prelude.NFData
    CustomConnectorProfileCredentials
  where
  rnf :: CustomConnectorProfileCredentials -> ()
rnf CustomConnectorProfileCredentials' {Maybe ApiKeyCredentials
Maybe BasicAuthCredentials
Maybe CustomAuthCredentials
Maybe OAuth2Credentials
AuthenticationType
authenticationType :: AuthenticationType
oauth2 :: Maybe OAuth2Credentials
custom :: Maybe CustomAuthCredentials
basic :: Maybe BasicAuthCredentials
apiKey :: Maybe ApiKeyCredentials
$sel:authenticationType:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> AuthenticationType
$sel:oauth2:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe OAuth2Credentials
$sel:custom:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe CustomAuthCredentials
$sel:basic:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe BasicAuthCredentials
$sel:apiKey:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe ApiKeyCredentials
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ApiKeyCredentials
apiKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BasicAuthCredentials
basic
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CustomAuthCredentials
custom
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OAuth2Credentials
oauth2
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AuthenticationType
authenticationType

instance
  Data.ToJSON
    CustomConnectorProfileCredentials
  where
  toJSON :: CustomConnectorProfileCredentials -> Value
toJSON CustomConnectorProfileCredentials' {Maybe ApiKeyCredentials
Maybe BasicAuthCredentials
Maybe CustomAuthCredentials
Maybe OAuth2Credentials
AuthenticationType
authenticationType :: AuthenticationType
oauth2 :: Maybe OAuth2Credentials
custom :: Maybe CustomAuthCredentials
basic :: Maybe BasicAuthCredentials
apiKey :: Maybe ApiKeyCredentials
$sel:authenticationType:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> AuthenticationType
$sel:oauth2:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe OAuth2Credentials
$sel:custom:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe CustomAuthCredentials
$sel:basic:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe BasicAuthCredentials
$sel:apiKey:CustomConnectorProfileCredentials' :: CustomConnectorProfileCredentials -> Maybe ApiKeyCredentials
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"apiKey" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ApiKeyCredentials
apiKey,
            (Key
"basic" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe BasicAuthCredentials
basic,
            (Key
"custom" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CustomAuthCredentials
custom,
            (Key
"oauth2" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe OAuth2Credentials
oauth2,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"authenticationType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AuthenticationType
authenticationType)
          ]
      )