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

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

-- |
-- Module      : Amazonka.KafkaConnect.CreateConnector
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a connector using the specified properties.
module Amazonka.KafkaConnect.CreateConnector
  ( -- * Creating a Request
    CreateConnector (..),
    newCreateConnector,

    -- * Request Lenses
    createConnector_connectorDescription,
    createConnector_logDelivery,
    createConnector_workerConfiguration,
    createConnector_capacity,
    createConnector_connectorConfiguration,
    createConnector_connectorName,
    createConnector_kafkaCluster,
    createConnector_kafkaClusterClientAuthentication,
    createConnector_kafkaClusterEncryptionInTransit,
    createConnector_kafkaConnectVersion,
    createConnector_plugins,
    createConnector_serviceExecutionRoleArn,

    -- * Destructuring the Response
    CreateConnectorResponse (..),
    newCreateConnectorResponse,

    -- * Response Lenses
    createConnectorResponse_connectorArn,
    createConnectorResponse_connectorName,
    createConnectorResponse_connectorState,
    createConnectorResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.KafkaConnect.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateConnector' smart constructor.
data CreateConnector = CreateConnector'
  { -- | A summary description of the connector.
    CreateConnector -> Maybe Text
connectorDescription :: Prelude.Maybe Prelude.Text,
    -- | Details about log delivery.
    CreateConnector -> Maybe LogDelivery
logDelivery :: Prelude.Maybe LogDelivery,
    -- | Specifies which worker configuration to use with the connector.
    CreateConnector -> Maybe WorkerConfiguration
workerConfiguration :: Prelude.Maybe WorkerConfiguration,
    -- | Information about the capacity allocated to the connector. Exactly one
    -- of the two properties must be specified.
    CreateConnector -> Capacity
capacity :: Capacity,
    -- | A map of keys to values that represent the configuration for the
    -- connector.
    CreateConnector -> Sensitive (HashMap Text Text)
connectorConfiguration :: Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The name of the connector.
    CreateConnector -> Text
connectorName :: Prelude.Text,
    -- | Specifies which Apache Kafka cluster to connect to.
    CreateConnector -> KafkaCluster
kafkaCluster :: KafkaCluster,
    -- | Details of the client authentication used by the Apache Kafka cluster.
    CreateConnector -> KafkaClusterClientAuthentication
kafkaClusterClientAuthentication :: KafkaClusterClientAuthentication,
    -- | Details of encryption in transit to the Apache Kafka cluster.
    CreateConnector -> KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit :: KafkaClusterEncryptionInTransit,
    -- | The version of Kafka Connect. It has to be compatible with both the
    -- Apache Kafka cluster\'s version and the plugins.
    CreateConnector -> Text
kafkaConnectVersion :: Prelude.Text,
    -- | Specifies which plugins to use for the connector.
    CreateConnector -> [Plugin]
plugins :: [Plugin],
    -- | The Amazon Resource Name (ARN) of the IAM role used by the connector to
    -- access the Amazon Web Services resources that it needs. The types of
    -- resources depends on the logic of the connector. For example, a
    -- connector that has Amazon S3 as a destination must have permissions that
    -- allow it to write to the S3 destination bucket.
    CreateConnector -> Text
serviceExecutionRoleArn :: Prelude.Text
  }
  deriving (CreateConnector -> CreateConnector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConnector -> CreateConnector -> Bool
$c/= :: CreateConnector -> CreateConnector -> Bool
== :: CreateConnector -> CreateConnector -> Bool
$c== :: CreateConnector -> CreateConnector -> Bool
Prelude.Eq, Int -> CreateConnector -> ShowS
[CreateConnector] -> ShowS
CreateConnector -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConnector] -> ShowS
$cshowList :: [CreateConnector] -> ShowS
show :: CreateConnector -> String
$cshow :: CreateConnector -> String
showsPrec :: Int -> CreateConnector -> ShowS
$cshowsPrec :: Int -> CreateConnector -> ShowS
Prelude.Show, forall x. Rep CreateConnector x -> CreateConnector
forall x. CreateConnector -> Rep CreateConnector x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateConnector x -> CreateConnector
$cfrom :: forall x. CreateConnector -> Rep CreateConnector x
Prelude.Generic)

-- |
-- Create a value of 'CreateConnector' 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:
--
-- 'connectorDescription', 'createConnector_connectorDescription' - A summary description of the connector.
--
-- 'logDelivery', 'createConnector_logDelivery' - Details about log delivery.
--
-- 'workerConfiguration', 'createConnector_workerConfiguration' - Specifies which worker configuration to use with the connector.
--
-- 'capacity', 'createConnector_capacity' - Information about the capacity allocated to the connector. Exactly one
-- of the two properties must be specified.
--
-- 'connectorConfiguration', 'createConnector_connectorConfiguration' - A map of keys to values that represent the configuration for the
-- connector.
--
-- 'connectorName', 'createConnector_connectorName' - The name of the connector.
--
-- 'kafkaCluster', 'createConnector_kafkaCluster' - Specifies which Apache Kafka cluster to connect to.
--
-- 'kafkaClusterClientAuthentication', 'createConnector_kafkaClusterClientAuthentication' - Details of the client authentication used by the Apache Kafka cluster.
--
-- 'kafkaClusterEncryptionInTransit', 'createConnector_kafkaClusterEncryptionInTransit' - Details of encryption in transit to the Apache Kafka cluster.
--
-- 'kafkaConnectVersion', 'createConnector_kafkaConnectVersion' - The version of Kafka Connect. It has to be compatible with both the
-- Apache Kafka cluster\'s version and the plugins.
--
-- 'plugins', 'createConnector_plugins' - Specifies which plugins to use for the connector.
--
-- 'serviceExecutionRoleArn', 'createConnector_serviceExecutionRoleArn' - The Amazon Resource Name (ARN) of the IAM role used by the connector to
-- access the Amazon Web Services resources that it needs. The types of
-- resources depends on the logic of the connector. For example, a
-- connector that has Amazon S3 as a destination must have permissions that
-- allow it to write to the S3 destination bucket.
newCreateConnector ::
  -- | 'capacity'
  Capacity ->
  -- | 'connectorName'
  Prelude.Text ->
  -- | 'kafkaCluster'
  KafkaCluster ->
  -- | 'kafkaClusterClientAuthentication'
  KafkaClusterClientAuthentication ->
  -- | 'kafkaClusterEncryptionInTransit'
  KafkaClusterEncryptionInTransit ->
  -- | 'kafkaConnectVersion'
  Prelude.Text ->
  -- | 'serviceExecutionRoleArn'
  Prelude.Text ->
  CreateConnector
newCreateConnector :: Capacity
-> Text
-> KafkaCluster
-> KafkaClusterClientAuthentication
-> KafkaClusterEncryptionInTransit
-> Text
-> Text
-> CreateConnector
newCreateConnector
  Capacity
pCapacity_
  Text
pConnectorName_
  KafkaCluster
pKafkaCluster_
  KafkaClusterClientAuthentication
pKafkaClusterClientAuthentication_
  KafkaClusterEncryptionInTransit
pKafkaClusterEncryptionInTransit_
  Text
pKafkaConnectVersion_
  Text
pServiceExecutionRoleArn_ =
    CreateConnector'
      { $sel:connectorDescription:CreateConnector' :: Maybe Text
connectorDescription =
          forall a. Maybe a
Prelude.Nothing,
        $sel:logDelivery:CreateConnector' :: Maybe LogDelivery
logDelivery = forall a. Maybe a
Prelude.Nothing,
        $sel:workerConfiguration:CreateConnector' :: Maybe WorkerConfiguration
workerConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:capacity:CreateConnector' :: Capacity
capacity = Capacity
pCapacity_,
        $sel:connectorConfiguration:CreateConnector' :: Sensitive (HashMap Text Text)
connectorConfiguration = forall a. Monoid a => a
Prelude.mempty,
        $sel:connectorName:CreateConnector' :: Text
connectorName = Text
pConnectorName_,
        $sel:kafkaCluster:CreateConnector' :: KafkaCluster
kafkaCluster = KafkaCluster
pKafkaCluster_,
        $sel:kafkaClusterClientAuthentication:CreateConnector' :: KafkaClusterClientAuthentication
kafkaClusterClientAuthentication =
          KafkaClusterClientAuthentication
pKafkaClusterClientAuthentication_,
        $sel:kafkaClusterEncryptionInTransit:CreateConnector' :: KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit =
          KafkaClusterEncryptionInTransit
pKafkaClusterEncryptionInTransit_,
        $sel:kafkaConnectVersion:CreateConnector' :: Text
kafkaConnectVersion = Text
pKafkaConnectVersion_,
        $sel:plugins:CreateConnector' :: [Plugin]
plugins = forall a. Monoid a => a
Prelude.mempty,
        $sel:serviceExecutionRoleArn:CreateConnector' :: Text
serviceExecutionRoleArn = Text
pServiceExecutionRoleArn_
      }

-- | A summary description of the connector.
createConnector_connectorDescription :: Lens.Lens' CreateConnector (Prelude.Maybe Prelude.Text)
createConnector_connectorDescription :: Lens' CreateConnector (Maybe Text)
createConnector_connectorDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {Maybe Text
connectorDescription :: Maybe Text
$sel:connectorDescription:CreateConnector' :: CreateConnector -> Maybe Text
connectorDescription} -> Maybe Text
connectorDescription) (\s :: CreateConnector
s@CreateConnector' {} Maybe Text
a -> CreateConnector
s {$sel:connectorDescription:CreateConnector' :: Maybe Text
connectorDescription = Maybe Text
a} :: CreateConnector)

-- | Details about log delivery.
createConnector_logDelivery :: Lens.Lens' CreateConnector (Prelude.Maybe LogDelivery)
createConnector_logDelivery :: Lens' CreateConnector (Maybe LogDelivery)
createConnector_logDelivery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {Maybe LogDelivery
logDelivery :: Maybe LogDelivery
$sel:logDelivery:CreateConnector' :: CreateConnector -> Maybe LogDelivery
logDelivery} -> Maybe LogDelivery
logDelivery) (\s :: CreateConnector
s@CreateConnector' {} Maybe LogDelivery
a -> CreateConnector
s {$sel:logDelivery:CreateConnector' :: Maybe LogDelivery
logDelivery = Maybe LogDelivery
a} :: CreateConnector)

-- | Specifies which worker configuration to use with the connector.
createConnector_workerConfiguration :: Lens.Lens' CreateConnector (Prelude.Maybe WorkerConfiguration)
createConnector_workerConfiguration :: Lens' CreateConnector (Maybe WorkerConfiguration)
createConnector_workerConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {Maybe WorkerConfiguration
workerConfiguration :: Maybe WorkerConfiguration
$sel:workerConfiguration:CreateConnector' :: CreateConnector -> Maybe WorkerConfiguration
workerConfiguration} -> Maybe WorkerConfiguration
workerConfiguration) (\s :: CreateConnector
s@CreateConnector' {} Maybe WorkerConfiguration
a -> CreateConnector
s {$sel:workerConfiguration:CreateConnector' :: Maybe WorkerConfiguration
workerConfiguration = Maybe WorkerConfiguration
a} :: CreateConnector)

-- | Information about the capacity allocated to the connector. Exactly one
-- of the two properties must be specified.
createConnector_capacity :: Lens.Lens' CreateConnector Capacity
createConnector_capacity :: Lens' CreateConnector Capacity
createConnector_capacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {Capacity
capacity :: Capacity
$sel:capacity:CreateConnector' :: CreateConnector -> Capacity
capacity} -> Capacity
capacity) (\s :: CreateConnector
s@CreateConnector' {} Capacity
a -> CreateConnector
s {$sel:capacity:CreateConnector' :: Capacity
capacity = Capacity
a} :: CreateConnector)

-- | A map of keys to values that represent the configuration for the
-- connector.
createConnector_connectorConfiguration :: Lens.Lens' CreateConnector (Prelude.HashMap Prelude.Text Prelude.Text)
createConnector_connectorConfiguration :: Lens' CreateConnector (HashMap Text Text)
createConnector_connectorConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {Sensitive (HashMap Text Text)
connectorConfiguration :: Sensitive (HashMap Text Text)
$sel:connectorConfiguration:CreateConnector' :: CreateConnector -> Sensitive (HashMap Text Text)
connectorConfiguration} -> Sensitive (HashMap Text Text)
connectorConfiguration) (\s :: CreateConnector
s@CreateConnector' {} Sensitive (HashMap Text Text)
a -> CreateConnector
s {$sel:connectorConfiguration:CreateConnector' :: Sensitive (HashMap Text Text)
connectorConfiguration = Sensitive (HashMap Text Text)
a} :: CreateConnector) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the connector.
createConnector_connectorName :: Lens.Lens' CreateConnector Prelude.Text
createConnector_connectorName :: Lens' CreateConnector Text
createConnector_connectorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {Text
connectorName :: Text
$sel:connectorName:CreateConnector' :: CreateConnector -> Text
connectorName} -> Text
connectorName) (\s :: CreateConnector
s@CreateConnector' {} Text
a -> CreateConnector
s {$sel:connectorName:CreateConnector' :: Text
connectorName = Text
a} :: CreateConnector)

-- | Specifies which Apache Kafka cluster to connect to.
createConnector_kafkaCluster :: Lens.Lens' CreateConnector KafkaCluster
createConnector_kafkaCluster :: Lens' CreateConnector KafkaCluster
createConnector_kafkaCluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {KafkaCluster
kafkaCluster :: KafkaCluster
$sel:kafkaCluster:CreateConnector' :: CreateConnector -> KafkaCluster
kafkaCluster} -> KafkaCluster
kafkaCluster) (\s :: CreateConnector
s@CreateConnector' {} KafkaCluster
a -> CreateConnector
s {$sel:kafkaCluster:CreateConnector' :: KafkaCluster
kafkaCluster = KafkaCluster
a} :: CreateConnector)

-- | Details of the client authentication used by the Apache Kafka cluster.
createConnector_kafkaClusterClientAuthentication :: Lens.Lens' CreateConnector KafkaClusterClientAuthentication
createConnector_kafkaClusterClientAuthentication :: Lens' CreateConnector KafkaClusterClientAuthentication
createConnector_kafkaClusterClientAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {KafkaClusterClientAuthentication
kafkaClusterClientAuthentication :: KafkaClusterClientAuthentication
$sel:kafkaClusterClientAuthentication:CreateConnector' :: CreateConnector -> KafkaClusterClientAuthentication
kafkaClusterClientAuthentication} -> KafkaClusterClientAuthentication
kafkaClusterClientAuthentication) (\s :: CreateConnector
s@CreateConnector' {} KafkaClusterClientAuthentication
a -> CreateConnector
s {$sel:kafkaClusterClientAuthentication:CreateConnector' :: KafkaClusterClientAuthentication
kafkaClusterClientAuthentication = KafkaClusterClientAuthentication
a} :: CreateConnector)

-- | Details of encryption in transit to the Apache Kafka cluster.
createConnector_kafkaClusterEncryptionInTransit :: Lens.Lens' CreateConnector KafkaClusterEncryptionInTransit
createConnector_kafkaClusterEncryptionInTransit :: Lens' CreateConnector KafkaClusterEncryptionInTransit
createConnector_kafkaClusterEncryptionInTransit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit :: KafkaClusterEncryptionInTransit
$sel:kafkaClusterEncryptionInTransit:CreateConnector' :: CreateConnector -> KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit} -> KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit) (\s :: CreateConnector
s@CreateConnector' {} KafkaClusterEncryptionInTransit
a -> CreateConnector
s {$sel:kafkaClusterEncryptionInTransit:CreateConnector' :: KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit = KafkaClusterEncryptionInTransit
a} :: CreateConnector)

-- | The version of Kafka Connect. It has to be compatible with both the
-- Apache Kafka cluster\'s version and the plugins.
createConnector_kafkaConnectVersion :: Lens.Lens' CreateConnector Prelude.Text
createConnector_kafkaConnectVersion :: Lens' CreateConnector Text
createConnector_kafkaConnectVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {Text
kafkaConnectVersion :: Text
$sel:kafkaConnectVersion:CreateConnector' :: CreateConnector -> Text
kafkaConnectVersion} -> Text
kafkaConnectVersion) (\s :: CreateConnector
s@CreateConnector' {} Text
a -> CreateConnector
s {$sel:kafkaConnectVersion:CreateConnector' :: Text
kafkaConnectVersion = Text
a} :: CreateConnector)

-- | Specifies which plugins to use for the connector.
createConnector_plugins :: Lens.Lens' CreateConnector [Plugin]
createConnector_plugins :: Lens' CreateConnector [Plugin]
createConnector_plugins = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {[Plugin]
plugins :: [Plugin]
$sel:plugins:CreateConnector' :: CreateConnector -> [Plugin]
plugins} -> [Plugin]
plugins) (\s :: CreateConnector
s@CreateConnector' {} [Plugin]
a -> CreateConnector
s {$sel:plugins:CreateConnector' :: [Plugin]
plugins = [Plugin]
a} :: CreateConnector) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon Resource Name (ARN) of the IAM role used by the connector to
-- access the Amazon Web Services resources that it needs. The types of
-- resources depends on the logic of the connector. For example, a
-- connector that has Amazon S3 as a destination must have permissions that
-- allow it to write to the S3 destination bucket.
createConnector_serviceExecutionRoleArn :: Lens.Lens' CreateConnector Prelude.Text
createConnector_serviceExecutionRoleArn :: Lens' CreateConnector Text
createConnector_serviceExecutionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnector' {Text
serviceExecutionRoleArn :: Text
$sel:serviceExecutionRoleArn:CreateConnector' :: CreateConnector -> Text
serviceExecutionRoleArn} -> Text
serviceExecutionRoleArn) (\s :: CreateConnector
s@CreateConnector' {} Text
a -> CreateConnector
s {$sel:serviceExecutionRoleArn:CreateConnector' :: Text
serviceExecutionRoleArn = Text
a} :: CreateConnector)

instance Core.AWSRequest CreateConnector where
  type
    AWSResponse CreateConnector =
      CreateConnectorResponse
  request :: (Service -> Service) -> CreateConnector -> Request CreateConnector
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateConnector
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateConnector)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe ConnectorState
-> Int
-> CreateConnectorResponse
CreateConnectorResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"connectorArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"connectorName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"connectorState")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateConnector where
  hashWithSalt :: Int -> CreateConnector -> Int
hashWithSalt Int
_salt CreateConnector' {[Plugin]
Maybe Text
Maybe WorkerConfiguration
Maybe LogDelivery
Text
Sensitive (HashMap Text Text)
KafkaClusterClientAuthentication
KafkaClusterEncryptionInTransit
Capacity
KafkaCluster
serviceExecutionRoleArn :: Text
plugins :: [Plugin]
kafkaConnectVersion :: Text
kafkaClusterEncryptionInTransit :: KafkaClusterEncryptionInTransit
kafkaClusterClientAuthentication :: KafkaClusterClientAuthentication
kafkaCluster :: KafkaCluster
connectorName :: Text
connectorConfiguration :: Sensitive (HashMap Text Text)
capacity :: Capacity
workerConfiguration :: Maybe WorkerConfiguration
logDelivery :: Maybe LogDelivery
connectorDescription :: Maybe Text
$sel:serviceExecutionRoleArn:CreateConnector' :: CreateConnector -> Text
$sel:plugins:CreateConnector' :: CreateConnector -> [Plugin]
$sel:kafkaConnectVersion:CreateConnector' :: CreateConnector -> Text
$sel:kafkaClusterEncryptionInTransit:CreateConnector' :: CreateConnector -> KafkaClusterEncryptionInTransit
$sel:kafkaClusterClientAuthentication:CreateConnector' :: CreateConnector -> KafkaClusterClientAuthentication
$sel:kafkaCluster:CreateConnector' :: CreateConnector -> KafkaCluster
$sel:connectorName:CreateConnector' :: CreateConnector -> Text
$sel:connectorConfiguration:CreateConnector' :: CreateConnector -> Sensitive (HashMap Text Text)
$sel:capacity:CreateConnector' :: CreateConnector -> Capacity
$sel:workerConfiguration:CreateConnector' :: CreateConnector -> Maybe WorkerConfiguration
$sel:logDelivery:CreateConnector' :: CreateConnector -> Maybe LogDelivery
$sel:connectorDescription:CreateConnector' :: CreateConnector -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
connectorDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LogDelivery
logDelivery
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkerConfiguration
workerConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Capacity
capacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive (HashMap Text Text)
connectorConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
connectorName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` KafkaCluster
kafkaCluster
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` KafkaClusterClientAuthentication
kafkaClusterClientAuthentication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
kafkaConnectVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Plugin]
plugins
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceExecutionRoleArn

instance Prelude.NFData CreateConnector where
  rnf :: CreateConnector -> ()
rnf CreateConnector' {[Plugin]
Maybe Text
Maybe WorkerConfiguration
Maybe LogDelivery
Text
Sensitive (HashMap Text Text)
KafkaClusterClientAuthentication
KafkaClusterEncryptionInTransit
Capacity
KafkaCluster
serviceExecutionRoleArn :: Text
plugins :: [Plugin]
kafkaConnectVersion :: Text
kafkaClusterEncryptionInTransit :: KafkaClusterEncryptionInTransit
kafkaClusterClientAuthentication :: KafkaClusterClientAuthentication
kafkaCluster :: KafkaCluster
connectorName :: Text
connectorConfiguration :: Sensitive (HashMap Text Text)
capacity :: Capacity
workerConfiguration :: Maybe WorkerConfiguration
logDelivery :: Maybe LogDelivery
connectorDescription :: Maybe Text
$sel:serviceExecutionRoleArn:CreateConnector' :: CreateConnector -> Text
$sel:plugins:CreateConnector' :: CreateConnector -> [Plugin]
$sel:kafkaConnectVersion:CreateConnector' :: CreateConnector -> Text
$sel:kafkaClusterEncryptionInTransit:CreateConnector' :: CreateConnector -> KafkaClusterEncryptionInTransit
$sel:kafkaClusterClientAuthentication:CreateConnector' :: CreateConnector -> KafkaClusterClientAuthentication
$sel:kafkaCluster:CreateConnector' :: CreateConnector -> KafkaCluster
$sel:connectorName:CreateConnector' :: CreateConnector -> Text
$sel:connectorConfiguration:CreateConnector' :: CreateConnector -> Sensitive (HashMap Text Text)
$sel:capacity:CreateConnector' :: CreateConnector -> Capacity
$sel:workerConfiguration:CreateConnector' :: CreateConnector -> Maybe WorkerConfiguration
$sel:logDelivery:CreateConnector' :: CreateConnector -> Maybe LogDelivery
$sel:connectorDescription:CreateConnector' :: CreateConnector -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectorDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LogDelivery
logDelivery
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkerConfiguration
workerConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Capacity
capacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive (HashMap Text Text)
connectorConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
connectorName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf KafkaCluster
kafkaCluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf KafkaClusterClientAuthentication
kafkaClusterClientAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
kafkaConnectVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Plugin]
plugins
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceExecutionRoleArn

instance Data.ToHeaders CreateConnector where
  toHeaders :: CreateConnector -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateConnector where
  toJSON :: CreateConnector -> Value
toJSON CreateConnector' {[Plugin]
Maybe Text
Maybe WorkerConfiguration
Maybe LogDelivery
Text
Sensitive (HashMap Text Text)
KafkaClusterClientAuthentication
KafkaClusterEncryptionInTransit
Capacity
KafkaCluster
serviceExecutionRoleArn :: Text
plugins :: [Plugin]
kafkaConnectVersion :: Text
kafkaClusterEncryptionInTransit :: KafkaClusterEncryptionInTransit
kafkaClusterClientAuthentication :: KafkaClusterClientAuthentication
kafkaCluster :: KafkaCluster
connectorName :: Text
connectorConfiguration :: Sensitive (HashMap Text Text)
capacity :: Capacity
workerConfiguration :: Maybe WorkerConfiguration
logDelivery :: Maybe LogDelivery
connectorDescription :: Maybe Text
$sel:serviceExecutionRoleArn:CreateConnector' :: CreateConnector -> Text
$sel:plugins:CreateConnector' :: CreateConnector -> [Plugin]
$sel:kafkaConnectVersion:CreateConnector' :: CreateConnector -> Text
$sel:kafkaClusterEncryptionInTransit:CreateConnector' :: CreateConnector -> KafkaClusterEncryptionInTransit
$sel:kafkaClusterClientAuthentication:CreateConnector' :: CreateConnector -> KafkaClusterClientAuthentication
$sel:kafkaCluster:CreateConnector' :: CreateConnector -> KafkaCluster
$sel:connectorName:CreateConnector' :: CreateConnector -> Text
$sel:connectorConfiguration:CreateConnector' :: CreateConnector -> Sensitive (HashMap Text Text)
$sel:capacity:CreateConnector' :: CreateConnector -> Capacity
$sel:workerConfiguration:CreateConnector' :: CreateConnector -> Maybe WorkerConfiguration
$sel:logDelivery:CreateConnector' :: CreateConnector -> Maybe LogDelivery
$sel:connectorDescription:CreateConnector' :: CreateConnector -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"connectorDescription" 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 Text
connectorDescription,
            (Key
"logDelivery" 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 LogDelivery
logDelivery,
            (Key
"workerConfiguration" 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 WorkerConfiguration
workerConfiguration,
            forall a. a -> Maybe a
Prelude.Just (Key
"capacity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Capacity
capacity),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"connectorConfiguration"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive (HashMap Text Text)
connectorConfiguration
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"connectorName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
connectorName),
            forall a. a -> Maybe a
Prelude.Just (Key
"kafkaCluster" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= KafkaCluster
kafkaCluster),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"kafkaClusterClientAuthentication"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= KafkaClusterClientAuthentication
kafkaClusterClientAuthentication
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"kafkaClusterEncryptionInTransit"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= KafkaClusterEncryptionInTransit
kafkaClusterEncryptionInTransit
              ),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"kafkaConnectVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
kafkaConnectVersion),
            forall a. a -> Maybe a
Prelude.Just (Key
"plugins" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Plugin]
plugins),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"serviceExecutionRoleArn"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceExecutionRoleArn
              )
          ]
      )

instance Data.ToPath CreateConnector where
  toPath :: CreateConnector -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/connectors"

instance Data.ToQuery CreateConnector where
  toQuery :: CreateConnector -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateConnectorResponse' smart constructor.
data CreateConnectorResponse = CreateConnectorResponse'
  { -- | The Amazon Resource Name (ARN) that Amazon assigned to the connector.
    CreateConnectorResponse -> Maybe Text
connectorArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the connector.
    CreateConnectorResponse -> Maybe Text
connectorName :: Prelude.Maybe Prelude.Text,
    -- | The state of the connector.
    CreateConnectorResponse -> Maybe ConnectorState
connectorState :: Prelude.Maybe ConnectorState,
    -- | The response's http status code.
    CreateConnectorResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateConnectorResponse -> CreateConnectorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateConnectorResponse -> CreateConnectorResponse -> Bool
$c/= :: CreateConnectorResponse -> CreateConnectorResponse -> Bool
== :: CreateConnectorResponse -> CreateConnectorResponse -> Bool
$c== :: CreateConnectorResponse -> CreateConnectorResponse -> Bool
Prelude.Eq, ReadPrec [CreateConnectorResponse]
ReadPrec CreateConnectorResponse
Int -> ReadS CreateConnectorResponse
ReadS [CreateConnectorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateConnectorResponse]
$creadListPrec :: ReadPrec [CreateConnectorResponse]
readPrec :: ReadPrec CreateConnectorResponse
$creadPrec :: ReadPrec CreateConnectorResponse
readList :: ReadS [CreateConnectorResponse]
$creadList :: ReadS [CreateConnectorResponse]
readsPrec :: Int -> ReadS CreateConnectorResponse
$creadsPrec :: Int -> ReadS CreateConnectorResponse
Prelude.Read, Int -> CreateConnectorResponse -> ShowS
[CreateConnectorResponse] -> ShowS
CreateConnectorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateConnectorResponse] -> ShowS
$cshowList :: [CreateConnectorResponse] -> ShowS
show :: CreateConnectorResponse -> String
$cshow :: CreateConnectorResponse -> String
showsPrec :: Int -> CreateConnectorResponse -> ShowS
$cshowsPrec :: Int -> CreateConnectorResponse -> ShowS
Prelude.Show, forall x. Rep CreateConnectorResponse x -> CreateConnectorResponse
forall x. CreateConnectorResponse -> Rep CreateConnectorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateConnectorResponse x -> CreateConnectorResponse
$cfrom :: forall x. CreateConnectorResponse -> Rep CreateConnectorResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateConnectorResponse' 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:
--
-- 'connectorArn', 'createConnectorResponse_connectorArn' - The Amazon Resource Name (ARN) that Amazon assigned to the connector.
--
-- 'connectorName', 'createConnectorResponse_connectorName' - The name of the connector.
--
-- 'connectorState', 'createConnectorResponse_connectorState' - The state of the connector.
--
-- 'httpStatus', 'createConnectorResponse_httpStatus' - The response's http status code.
newCreateConnectorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateConnectorResponse
newCreateConnectorResponse :: Int -> CreateConnectorResponse
newCreateConnectorResponse Int
pHttpStatus_ =
  CreateConnectorResponse'
    { $sel:connectorArn:CreateConnectorResponse' :: Maybe Text
connectorArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:connectorName:CreateConnectorResponse' :: Maybe Text
connectorName = forall a. Maybe a
Prelude.Nothing,
      $sel:connectorState:CreateConnectorResponse' :: Maybe ConnectorState
connectorState = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateConnectorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) that Amazon assigned to the connector.
createConnectorResponse_connectorArn :: Lens.Lens' CreateConnectorResponse (Prelude.Maybe Prelude.Text)
createConnectorResponse_connectorArn :: Lens' CreateConnectorResponse (Maybe Text)
createConnectorResponse_connectorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorResponse' {Maybe Text
connectorArn :: Maybe Text
$sel:connectorArn:CreateConnectorResponse' :: CreateConnectorResponse -> Maybe Text
connectorArn} -> Maybe Text
connectorArn) (\s :: CreateConnectorResponse
s@CreateConnectorResponse' {} Maybe Text
a -> CreateConnectorResponse
s {$sel:connectorArn:CreateConnectorResponse' :: Maybe Text
connectorArn = Maybe Text
a} :: CreateConnectorResponse)

-- | The name of the connector.
createConnectorResponse_connectorName :: Lens.Lens' CreateConnectorResponse (Prelude.Maybe Prelude.Text)
createConnectorResponse_connectorName :: Lens' CreateConnectorResponse (Maybe Text)
createConnectorResponse_connectorName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorResponse' {Maybe Text
connectorName :: Maybe Text
$sel:connectorName:CreateConnectorResponse' :: CreateConnectorResponse -> Maybe Text
connectorName} -> Maybe Text
connectorName) (\s :: CreateConnectorResponse
s@CreateConnectorResponse' {} Maybe Text
a -> CreateConnectorResponse
s {$sel:connectorName:CreateConnectorResponse' :: Maybe Text
connectorName = Maybe Text
a} :: CreateConnectorResponse)

-- | The state of the connector.
createConnectorResponse_connectorState :: Lens.Lens' CreateConnectorResponse (Prelude.Maybe ConnectorState)
createConnectorResponse_connectorState :: Lens' CreateConnectorResponse (Maybe ConnectorState)
createConnectorResponse_connectorState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorResponse' {Maybe ConnectorState
connectorState :: Maybe ConnectorState
$sel:connectorState:CreateConnectorResponse' :: CreateConnectorResponse -> Maybe ConnectorState
connectorState} -> Maybe ConnectorState
connectorState) (\s :: CreateConnectorResponse
s@CreateConnectorResponse' {} Maybe ConnectorState
a -> CreateConnectorResponse
s {$sel:connectorState:CreateConnectorResponse' :: Maybe ConnectorState
connectorState = Maybe ConnectorState
a} :: CreateConnectorResponse)

-- | The response's http status code.
createConnectorResponse_httpStatus :: Lens.Lens' CreateConnectorResponse Prelude.Int
createConnectorResponse_httpStatus :: Lens' CreateConnectorResponse Int
createConnectorResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateConnectorResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateConnectorResponse' :: CreateConnectorResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateConnectorResponse
s@CreateConnectorResponse' {} Int
a -> CreateConnectorResponse
s {$sel:httpStatus:CreateConnectorResponse' :: Int
httpStatus = Int
a} :: CreateConnectorResponse)

instance Prelude.NFData CreateConnectorResponse where
  rnf :: CreateConnectorResponse -> ()
rnf CreateConnectorResponse' {Int
Maybe Text
Maybe ConnectorState
httpStatus :: Int
connectorState :: Maybe ConnectorState
connectorName :: Maybe Text
connectorArn :: Maybe Text
$sel:httpStatus:CreateConnectorResponse' :: CreateConnectorResponse -> Int
$sel:connectorState:CreateConnectorResponse' :: CreateConnectorResponse -> Maybe ConnectorState
$sel:connectorName:CreateConnectorResponse' :: CreateConnectorResponse -> Maybe Text
$sel:connectorArn:CreateConnectorResponse' :: CreateConnectorResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectorArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
connectorName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConnectorState
connectorState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus