{-# 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.Kafka.CreateCluster
-- 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 new MSK cluster.
module Amazonka.Kafka.CreateCluster
  ( -- * Creating a Request
    CreateCluster (..),
    newCreateCluster,

    -- * Request Lenses
    createCluster_clientAuthentication,
    createCluster_configurationInfo,
    createCluster_encryptionInfo,
    createCluster_enhancedMonitoring,
    createCluster_loggingInfo,
    createCluster_openMonitoring,
    createCluster_storageMode,
    createCluster_tags,
    createCluster_brokerNodeGroupInfo,
    createCluster_kafkaVersion,
    createCluster_numberOfBrokerNodes,
    createCluster_clusterName,

    -- * Destructuring the Response
    CreateClusterResponse (..),
    newCreateClusterResponse,

    -- * Response Lenses
    createClusterResponse_clusterArn,
    createClusterResponse_clusterName,
    createClusterResponse_state,
    createClusterResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateCluster' smart constructor.
data CreateCluster = CreateCluster'
  { -- | Includes all client authentication related information.
    CreateCluster -> Maybe ClientAuthentication
clientAuthentication :: Prelude.Maybe ClientAuthentication,
    -- | Represents the configuration that you want MSK to use for the brokers in
    -- a cluster.
    CreateCluster -> Maybe ConfigurationInfo
configurationInfo :: Prelude.Maybe ConfigurationInfo,
    -- | Includes all encryption-related information.
    CreateCluster -> Maybe EncryptionInfo
encryptionInfo :: Prelude.Maybe EncryptionInfo,
    -- | Specifies the level of monitoring for the MSK cluster. The possible
    -- values are DEFAULT, PER_BROKER, PER_TOPIC_PER_BROKER, and
    -- PER_TOPIC_PER_PARTITION.
    CreateCluster -> Maybe EnhancedMonitoring
enhancedMonitoring :: Prelude.Maybe EnhancedMonitoring,
    CreateCluster -> Maybe LoggingInfo
loggingInfo :: Prelude.Maybe LoggingInfo,
    -- | The settings for open monitoring.
    CreateCluster -> Maybe OpenMonitoringInfo
openMonitoring :: Prelude.Maybe OpenMonitoringInfo,
    -- | This controls storage mode for supported storage tiers.
    CreateCluster -> Maybe StorageMode
storageMode :: Prelude.Maybe StorageMode,
    -- | Create tags when creating the cluster.
    CreateCluster -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Information about the broker nodes in the cluster.
    CreateCluster -> BrokerNodeGroupInfo
brokerNodeGroupInfo :: BrokerNodeGroupInfo,
    -- | The version of Apache Kafka.
    CreateCluster -> Text
kafkaVersion :: Prelude.Text,
    -- | The number of broker nodes in the cluster.
    CreateCluster -> Natural
numberOfBrokerNodes :: Prelude.Natural,
    -- | The name of the cluster.
    CreateCluster -> Text
clusterName :: Prelude.Text
  }
  deriving (CreateCluster -> CreateCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCluster -> CreateCluster -> Bool
$c/= :: CreateCluster -> CreateCluster -> Bool
== :: CreateCluster -> CreateCluster -> Bool
$c== :: CreateCluster -> CreateCluster -> Bool
Prelude.Eq, ReadPrec [CreateCluster]
ReadPrec CreateCluster
Int -> ReadS CreateCluster
ReadS [CreateCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCluster]
$creadListPrec :: ReadPrec [CreateCluster]
readPrec :: ReadPrec CreateCluster
$creadPrec :: ReadPrec CreateCluster
readList :: ReadS [CreateCluster]
$creadList :: ReadS [CreateCluster]
readsPrec :: Int -> ReadS CreateCluster
$creadsPrec :: Int -> ReadS CreateCluster
Prelude.Read, Int -> CreateCluster -> ShowS
[CreateCluster] -> ShowS
CreateCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCluster] -> ShowS
$cshowList :: [CreateCluster] -> ShowS
show :: CreateCluster -> String
$cshow :: CreateCluster -> String
showsPrec :: Int -> CreateCluster -> ShowS
$cshowsPrec :: Int -> CreateCluster -> ShowS
Prelude.Show, forall x. Rep CreateCluster x -> CreateCluster
forall x. CreateCluster -> Rep CreateCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCluster x -> CreateCluster
$cfrom :: forall x. CreateCluster -> Rep CreateCluster x
Prelude.Generic)

-- |
-- Create a value of 'CreateCluster' 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:
--
-- 'clientAuthentication', 'createCluster_clientAuthentication' - Includes all client authentication related information.
--
-- 'configurationInfo', 'createCluster_configurationInfo' - Represents the configuration that you want MSK to use for the brokers in
-- a cluster.
--
-- 'encryptionInfo', 'createCluster_encryptionInfo' - Includes all encryption-related information.
--
-- 'enhancedMonitoring', 'createCluster_enhancedMonitoring' - Specifies the level of monitoring for the MSK cluster. The possible
-- values are DEFAULT, PER_BROKER, PER_TOPIC_PER_BROKER, and
-- PER_TOPIC_PER_PARTITION.
--
-- 'loggingInfo', 'createCluster_loggingInfo' - Undocumented member.
--
-- 'openMonitoring', 'createCluster_openMonitoring' - The settings for open monitoring.
--
-- 'storageMode', 'createCluster_storageMode' - This controls storage mode for supported storage tiers.
--
-- 'tags', 'createCluster_tags' - Create tags when creating the cluster.
--
-- 'brokerNodeGroupInfo', 'createCluster_brokerNodeGroupInfo' - Information about the broker nodes in the cluster.
--
-- 'kafkaVersion', 'createCluster_kafkaVersion' - The version of Apache Kafka.
--
-- 'numberOfBrokerNodes', 'createCluster_numberOfBrokerNodes' - The number of broker nodes in the cluster.
--
-- 'clusterName', 'createCluster_clusterName' - The name of the cluster.
newCreateCluster ::
  -- | 'brokerNodeGroupInfo'
  BrokerNodeGroupInfo ->
  -- | 'kafkaVersion'
  Prelude.Text ->
  -- | 'numberOfBrokerNodes'
  Prelude.Natural ->
  -- | 'clusterName'
  Prelude.Text ->
  CreateCluster
newCreateCluster :: BrokerNodeGroupInfo -> Text -> Natural -> Text -> CreateCluster
newCreateCluster
  BrokerNodeGroupInfo
pBrokerNodeGroupInfo_
  Text
pKafkaVersion_
  Natural
pNumberOfBrokerNodes_
  Text
pClusterName_ =
    CreateCluster'
      { $sel:clientAuthentication:CreateCluster' :: Maybe ClientAuthentication
clientAuthentication =
          forall a. Maybe a
Prelude.Nothing,
        $sel:configurationInfo:CreateCluster' :: Maybe ConfigurationInfo
configurationInfo = forall a. Maybe a
Prelude.Nothing,
        $sel:encryptionInfo:CreateCluster' :: Maybe EncryptionInfo
encryptionInfo = forall a. Maybe a
Prelude.Nothing,
        $sel:enhancedMonitoring:CreateCluster' :: Maybe EnhancedMonitoring
enhancedMonitoring = forall a. Maybe a
Prelude.Nothing,
        $sel:loggingInfo:CreateCluster' :: Maybe LoggingInfo
loggingInfo = forall a. Maybe a
Prelude.Nothing,
        $sel:openMonitoring:CreateCluster' :: Maybe OpenMonitoringInfo
openMonitoring = forall a. Maybe a
Prelude.Nothing,
        $sel:storageMode:CreateCluster' :: Maybe StorageMode
storageMode = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateCluster' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:brokerNodeGroupInfo:CreateCluster' :: BrokerNodeGroupInfo
brokerNodeGroupInfo = BrokerNodeGroupInfo
pBrokerNodeGroupInfo_,
        $sel:kafkaVersion:CreateCluster' :: Text
kafkaVersion = Text
pKafkaVersion_,
        $sel:numberOfBrokerNodes:CreateCluster' :: Natural
numberOfBrokerNodes = Natural
pNumberOfBrokerNodes_,
        $sel:clusterName:CreateCluster' :: Text
clusterName = Text
pClusterName_
      }

-- | Includes all client authentication related information.
createCluster_clientAuthentication :: Lens.Lens' CreateCluster (Prelude.Maybe ClientAuthentication)
createCluster_clientAuthentication :: Lens' CreateCluster (Maybe ClientAuthentication)
createCluster_clientAuthentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe ClientAuthentication
clientAuthentication :: Maybe ClientAuthentication
$sel:clientAuthentication:CreateCluster' :: CreateCluster -> Maybe ClientAuthentication
clientAuthentication} -> Maybe ClientAuthentication
clientAuthentication) (\s :: CreateCluster
s@CreateCluster' {} Maybe ClientAuthentication
a -> CreateCluster
s {$sel:clientAuthentication:CreateCluster' :: Maybe ClientAuthentication
clientAuthentication = Maybe ClientAuthentication
a} :: CreateCluster)

-- | Represents the configuration that you want MSK to use for the brokers in
-- a cluster.
createCluster_configurationInfo :: Lens.Lens' CreateCluster (Prelude.Maybe ConfigurationInfo)
createCluster_configurationInfo :: Lens' CreateCluster (Maybe ConfigurationInfo)
createCluster_configurationInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe ConfigurationInfo
configurationInfo :: Maybe ConfigurationInfo
$sel:configurationInfo:CreateCluster' :: CreateCluster -> Maybe ConfigurationInfo
configurationInfo} -> Maybe ConfigurationInfo
configurationInfo) (\s :: CreateCluster
s@CreateCluster' {} Maybe ConfigurationInfo
a -> CreateCluster
s {$sel:configurationInfo:CreateCluster' :: Maybe ConfigurationInfo
configurationInfo = Maybe ConfigurationInfo
a} :: CreateCluster)

-- | Includes all encryption-related information.
createCluster_encryptionInfo :: Lens.Lens' CreateCluster (Prelude.Maybe EncryptionInfo)
createCluster_encryptionInfo :: Lens' CreateCluster (Maybe EncryptionInfo)
createCluster_encryptionInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe EncryptionInfo
encryptionInfo :: Maybe EncryptionInfo
$sel:encryptionInfo:CreateCluster' :: CreateCluster -> Maybe EncryptionInfo
encryptionInfo} -> Maybe EncryptionInfo
encryptionInfo) (\s :: CreateCluster
s@CreateCluster' {} Maybe EncryptionInfo
a -> CreateCluster
s {$sel:encryptionInfo:CreateCluster' :: Maybe EncryptionInfo
encryptionInfo = Maybe EncryptionInfo
a} :: CreateCluster)

-- | Specifies the level of monitoring for the MSK cluster. The possible
-- values are DEFAULT, PER_BROKER, PER_TOPIC_PER_BROKER, and
-- PER_TOPIC_PER_PARTITION.
createCluster_enhancedMonitoring :: Lens.Lens' CreateCluster (Prelude.Maybe EnhancedMonitoring)
createCluster_enhancedMonitoring :: Lens' CreateCluster (Maybe EnhancedMonitoring)
createCluster_enhancedMonitoring = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe EnhancedMonitoring
enhancedMonitoring :: Maybe EnhancedMonitoring
$sel:enhancedMonitoring:CreateCluster' :: CreateCluster -> Maybe EnhancedMonitoring
enhancedMonitoring} -> Maybe EnhancedMonitoring
enhancedMonitoring) (\s :: CreateCluster
s@CreateCluster' {} Maybe EnhancedMonitoring
a -> CreateCluster
s {$sel:enhancedMonitoring:CreateCluster' :: Maybe EnhancedMonitoring
enhancedMonitoring = Maybe EnhancedMonitoring
a} :: CreateCluster)

-- | Undocumented member.
createCluster_loggingInfo :: Lens.Lens' CreateCluster (Prelude.Maybe LoggingInfo)
createCluster_loggingInfo :: Lens' CreateCluster (Maybe LoggingInfo)
createCluster_loggingInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe LoggingInfo
loggingInfo :: Maybe LoggingInfo
$sel:loggingInfo:CreateCluster' :: CreateCluster -> Maybe LoggingInfo
loggingInfo} -> Maybe LoggingInfo
loggingInfo) (\s :: CreateCluster
s@CreateCluster' {} Maybe LoggingInfo
a -> CreateCluster
s {$sel:loggingInfo:CreateCluster' :: Maybe LoggingInfo
loggingInfo = Maybe LoggingInfo
a} :: CreateCluster)

-- | The settings for open monitoring.
createCluster_openMonitoring :: Lens.Lens' CreateCluster (Prelude.Maybe OpenMonitoringInfo)
createCluster_openMonitoring :: Lens' CreateCluster (Maybe OpenMonitoringInfo)
createCluster_openMonitoring = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe OpenMonitoringInfo
openMonitoring :: Maybe OpenMonitoringInfo
$sel:openMonitoring:CreateCluster' :: CreateCluster -> Maybe OpenMonitoringInfo
openMonitoring} -> Maybe OpenMonitoringInfo
openMonitoring) (\s :: CreateCluster
s@CreateCluster' {} Maybe OpenMonitoringInfo
a -> CreateCluster
s {$sel:openMonitoring:CreateCluster' :: Maybe OpenMonitoringInfo
openMonitoring = Maybe OpenMonitoringInfo
a} :: CreateCluster)

-- | This controls storage mode for supported storage tiers.
createCluster_storageMode :: Lens.Lens' CreateCluster (Prelude.Maybe StorageMode)
createCluster_storageMode :: Lens' CreateCluster (Maybe StorageMode)
createCluster_storageMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe StorageMode
storageMode :: Maybe StorageMode
$sel:storageMode:CreateCluster' :: CreateCluster -> Maybe StorageMode
storageMode} -> Maybe StorageMode
storageMode) (\s :: CreateCluster
s@CreateCluster' {} Maybe StorageMode
a -> CreateCluster
s {$sel:storageMode:CreateCluster' :: Maybe StorageMode
storageMode = Maybe StorageMode
a} :: CreateCluster)

-- | Create tags when creating the cluster.
createCluster_tags :: Lens.Lens' CreateCluster (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createCluster_tags :: Lens' CreateCluster (Maybe (HashMap Text Text))
createCluster_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateCluster' :: CreateCluster -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateCluster
s@CreateCluster' {} Maybe (HashMap Text Text)
a -> CreateCluster
s {$sel:tags:CreateCluster' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateCluster) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Information about the broker nodes in the cluster.
createCluster_brokerNodeGroupInfo :: Lens.Lens' CreateCluster BrokerNodeGroupInfo
createCluster_brokerNodeGroupInfo :: Lens' CreateCluster BrokerNodeGroupInfo
createCluster_brokerNodeGroupInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {BrokerNodeGroupInfo
brokerNodeGroupInfo :: BrokerNodeGroupInfo
$sel:brokerNodeGroupInfo:CreateCluster' :: CreateCluster -> BrokerNodeGroupInfo
brokerNodeGroupInfo} -> BrokerNodeGroupInfo
brokerNodeGroupInfo) (\s :: CreateCluster
s@CreateCluster' {} BrokerNodeGroupInfo
a -> CreateCluster
s {$sel:brokerNodeGroupInfo:CreateCluster' :: BrokerNodeGroupInfo
brokerNodeGroupInfo = BrokerNodeGroupInfo
a} :: CreateCluster)

-- | The version of Apache Kafka.
createCluster_kafkaVersion :: Lens.Lens' CreateCluster Prelude.Text
createCluster_kafkaVersion :: Lens' CreateCluster Text
createCluster_kafkaVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Text
kafkaVersion :: Text
$sel:kafkaVersion:CreateCluster' :: CreateCluster -> Text
kafkaVersion} -> Text
kafkaVersion) (\s :: CreateCluster
s@CreateCluster' {} Text
a -> CreateCluster
s {$sel:kafkaVersion:CreateCluster' :: Text
kafkaVersion = Text
a} :: CreateCluster)

-- | The number of broker nodes in the cluster.
createCluster_numberOfBrokerNodes :: Lens.Lens' CreateCluster Prelude.Natural
createCluster_numberOfBrokerNodes :: Lens' CreateCluster Natural
createCluster_numberOfBrokerNodes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Natural
numberOfBrokerNodes :: Natural
$sel:numberOfBrokerNodes:CreateCluster' :: CreateCluster -> Natural
numberOfBrokerNodes} -> Natural
numberOfBrokerNodes) (\s :: CreateCluster
s@CreateCluster' {} Natural
a -> CreateCluster
s {$sel:numberOfBrokerNodes:CreateCluster' :: Natural
numberOfBrokerNodes = Natural
a} :: CreateCluster)

-- | The name of the cluster.
createCluster_clusterName :: Lens.Lens' CreateCluster Prelude.Text
createCluster_clusterName :: Lens' CreateCluster Text
createCluster_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Text
clusterName :: Text
$sel:clusterName:CreateCluster' :: CreateCluster -> Text
clusterName} -> Text
clusterName) (\s :: CreateCluster
s@CreateCluster' {} Text
a -> CreateCluster
s {$sel:clusterName:CreateCluster' :: Text
clusterName = Text
a} :: CreateCluster)

instance Core.AWSRequest CreateCluster where
  type
    AWSResponse CreateCluster =
      CreateClusterResponse
  request :: (Service -> Service) -> CreateCluster -> Request CreateCluster
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 CreateCluster
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateCluster)))
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 ClusterState -> Int -> CreateClusterResponse
CreateClusterResponse'
            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
"clusterArn")
            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
"clusterName")
            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
"state")
            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 CreateCluster where
  hashWithSalt :: Int -> CreateCluster -> Int
hashWithSalt Int
_salt CreateCluster' {Natural
Maybe (HashMap Text Text)
Maybe ConfigurationInfo
Maybe EncryptionInfo
Maybe EnhancedMonitoring
Maybe OpenMonitoringInfo
Maybe LoggingInfo
Maybe StorageMode
Maybe ClientAuthentication
Text
BrokerNodeGroupInfo
clusterName :: Text
numberOfBrokerNodes :: Natural
kafkaVersion :: Text
brokerNodeGroupInfo :: BrokerNodeGroupInfo
tags :: Maybe (HashMap Text Text)
storageMode :: Maybe StorageMode
openMonitoring :: Maybe OpenMonitoringInfo
loggingInfo :: Maybe LoggingInfo
enhancedMonitoring :: Maybe EnhancedMonitoring
encryptionInfo :: Maybe EncryptionInfo
configurationInfo :: Maybe ConfigurationInfo
clientAuthentication :: Maybe ClientAuthentication
$sel:clusterName:CreateCluster' :: CreateCluster -> Text
$sel:numberOfBrokerNodes:CreateCluster' :: CreateCluster -> Natural
$sel:kafkaVersion:CreateCluster' :: CreateCluster -> Text
$sel:brokerNodeGroupInfo:CreateCluster' :: CreateCluster -> BrokerNodeGroupInfo
$sel:tags:CreateCluster' :: CreateCluster -> Maybe (HashMap Text Text)
$sel:storageMode:CreateCluster' :: CreateCluster -> Maybe StorageMode
$sel:openMonitoring:CreateCluster' :: CreateCluster -> Maybe OpenMonitoringInfo
$sel:loggingInfo:CreateCluster' :: CreateCluster -> Maybe LoggingInfo
$sel:enhancedMonitoring:CreateCluster' :: CreateCluster -> Maybe EnhancedMonitoring
$sel:encryptionInfo:CreateCluster' :: CreateCluster -> Maybe EncryptionInfo
$sel:configurationInfo:CreateCluster' :: CreateCluster -> Maybe ConfigurationInfo
$sel:clientAuthentication:CreateCluster' :: CreateCluster -> Maybe ClientAuthentication
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClientAuthentication
clientAuthentication
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ConfigurationInfo
configurationInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionInfo
encryptionInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EnhancedMonitoring
enhancedMonitoring
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LoggingInfo
loggingInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OpenMonitoringInfo
openMonitoring
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StorageMode
storageMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BrokerNodeGroupInfo
brokerNodeGroupInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
kafkaVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
numberOfBrokerNodes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterName

instance Prelude.NFData CreateCluster where
  rnf :: CreateCluster -> ()
rnf CreateCluster' {Natural
Maybe (HashMap Text Text)
Maybe ConfigurationInfo
Maybe EncryptionInfo
Maybe EnhancedMonitoring
Maybe OpenMonitoringInfo
Maybe LoggingInfo
Maybe StorageMode
Maybe ClientAuthentication
Text
BrokerNodeGroupInfo
clusterName :: Text
numberOfBrokerNodes :: Natural
kafkaVersion :: Text
brokerNodeGroupInfo :: BrokerNodeGroupInfo
tags :: Maybe (HashMap Text Text)
storageMode :: Maybe StorageMode
openMonitoring :: Maybe OpenMonitoringInfo
loggingInfo :: Maybe LoggingInfo
enhancedMonitoring :: Maybe EnhancedMonitoring
encryptionInfo :: Maybe EncryptionInfo
configurationInfo :: Maybe ConfigurationInfo
clientAuthentication :: Maybe ClientAuthentication
$sel:clusterName:CreateCluster' :: CreateCluster -> Text
$sel:numberOfBrokerNodes:CreateCluster' :: CreateCluster -> Natural
$sel:kafkaVersion:CreateCluster' :: CreateCluster -> Text
$sel:brokerNodeGroupInfo:CreateCluster' :: CreateCluster -> BrokerNodeGroupInfo
$sel:tags:CreateCluster' :: CreateCluster -> Maybe (HashMap Text Text)
$sel:storageMode:CreateCluster' :: CreateCluster -> Maybe StorageMode
$sel:openMonitoring:CreateCluster' :: CreateCluster -> Maybe OpenMonitoringInfo
$sel:loggingInfo:CreateCluster' :: CreateCluster -> Maybe LoggingInfo
$sel:enhancedMonitoring:CreateCluster' :: CreateCluster -> Maybe EnhancedMonitoring
$sel:encryptionInfo:CreateCluster' :: CreateCluster -> Maybe EncryptionInfo
$sel:configurationInfo:CreateCluster' :: CreateCluster -> Maybe ConfigurationInfo
$sel:clientAuthentication:CreateCluster' :: CreateCluster -> Maybe ClientAuthentication
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ClientAuthentication
clientAuthentication
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ConfigurationInfo
configurationInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionInfo
encryptionInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EnhancedMonitoring
enhancedMonitoring
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LoggingInfo
loggingInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OpenMonitoringInfo
openMonitoring
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageMode
storageMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BrokerNodeGroupInfo
brokerNodeGroupInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
kafkaVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
numberOfBrokerNodes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterName

instance Data.ToHeaders CreateCluster where
  toHeaders :: CreateCluster -> 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 CreateCluster where
  toJSON :: CreateCluster -> Value
toJSON CreateCluster' {Natural
Maybe (HashMap Text Text)
Maybe ConfigurationInfo
Maybe EncryptionInfo
Maybe EnhancedMonitoring
Maybe OpenMonitoringInfo
Maybe LoggingInfo
Maybe StorageMode
Maybe ClientAuthentication
Text
BrokerNodeGroupInfo
clusterName :: Text
numberOfBrokerNodes :: Natural
kafkaVersion :: Text
brokerNodeGroupInfo :: BrokerNodeGroupInfo
tags :: Maybe (HashMap Text Text)
storageMode :: Maybe StorageMode
openMonitoring :: Maybe OpenMonitoringInfo
loggingInfo :: Maybe LoggingInfo
enhancedMonitoring :: Maybe EnhancedMonitoring
encryptionInfo :: Maybe EncryptionInfo
configurationInfo :: Maybe ConfigurationInfo
clientAuthentication :: Maybe ClientAuthentication
$sel:clusterName:CreateCluster' :: CreateCluster -> Text
$sel:numberOfBrokerNodes:CreateCluster' :: CreateCluster -> Natural
$sel:kafkaVersion:CreateCluster' :: CreateCluster -> Text
$sel:brokerNodeGroupInfo:CreateCluster' :: CreateCluster -> BrokerNodeGroupInfo
$sel:tags:CreateCluster' :: CreateCluster -> Maybe (HashMap Text Text)
$sel:storageMode:CreateCluster' :: CreateCluster -> Maybe StorageMode
$sel:openMonitoring:CreateCluster' :: CreateCluster -> Maybe OpenMonitoringInfo
$sel:loggingInfo:CreateCluster' :: CreateCluster -> Maybe LoggingInfo
$sel:enhancedMonitoring:CreateCluster' :: CreateCluster -> Maybe EnhancedMonitoring
$sel:encryptionInfo:CreateCluster' :: CreateCluster -> Maybe EncryptionInfo
$sel:configurationInfo:CreateCluster' :: CreateCluster -> Maybe ConfigurationInfo
$sel:clientAuthentication:CreateCluster' :: CreateCluster -> Maybe ClientAuthentication
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientAuthentication" 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 ClientAuthentication
clientAuthentication,
            (Key
"configurationInfo" 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 ConfigurationInfo
configurationInfo,
            (Key
"encryptionInfo" 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 EncryptionInfo
encryptionInfo,
            (Key
"enhancedMonitoring" 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 EnhancedMonitoring
enhancedMonitoring,
            (Key
"loggingInfo" 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 LoggingInfo
loggingInfo,
            (Key
"openMonitoring" 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 OpenMonitoringInfo
openMonitoring,
            (Key
"storageMode" 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 StorageMode
storageMode,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"brokerNodeGroupInfo" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= BrokerNodeGroupInfo
brokerNodeGroupInfo),
            forall a. a -> Maybe a
Prelude.Just (Key
"kafkaVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
kafkaVersion),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"numberOfBrokerNodes" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
numberOfBrokerNodes),
            forall a. a -> Maybe a
Prelude.Just (Key
"clusterName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterName)
          ]
      )

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

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

-- | /See:/ 'newCreateClusterResponse' smart constructor.
data CreateClusterResponse = CreateClusterResponse'
  { -- | The Amazon Resource Name (ARN) of the cluster.
    CreateClusterResponse -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the MSK cluster.
    CreateClusterResponse -> Maybe Text
clusterName :: Prelude.Maybe Prelude.Text,
    -- | The state of the cluster. The possible states are ACTIVE, CREATING,
    -- DELETING, FAILED, HEALING, MAINTENANCE, REBOOTING_BROKER, and UPDATING.
    CreateClusterResponse -> Maybe ClusterState
state :: Prelude.Maybe ClusterState,
    -- | The response's http status code.
    CreateClusterResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateClusterResponse -> CreateClusterResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateClusterResponse -> CreateClusterResponse -> Bool
$c/= :: CreateClusterResponse -> CreateClusterResponse -> Bool
== :: CreateClusterResponse -> CreateClusterResponse -> Bool
$c== :: CreateClusterResponse -> CreateClusterResponse -> Bool
Prelude.Eq, ReadPrec [CreateClusterResponse]
ReadPrec CreateClusterResponse
Int -> ReadS CreateClusterResponse
ReadS [CreateClusterResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateClusterResponse]
$creadListPrec :: ReadPrec [CreateClusterResponse]
readPrec :: ReadPrec CreateClusterResponse
$creadPrec :: ReadPrec CreateClusterResponse
readList :: ReadS [CreateClusterResponse]
$creadList :: ReadS [CreateClusterResponse]
readsPrec :: Int -> ReadS CreateClusterResponse
$creadsPrec :: Int -> ReadS CreateClusterResponse
Prelude.Read, Int -> CreateClusterResponse -> ShowS
[CreateClusterResponse] -> ShowS
CreateClusterResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateClusterResponse] -> ShowS
$cshowList :: [CreateClusterResponse] -> ShowS
show :: CreateClusterResponse -> String
$cshow :: CreateClusterResponse -> String
showsPrec :: Int -> CreateClusterResponse -> ShowS
$cshowsPrec :: Int -> CreateClusterResponse -> ShowS
Prelude.Show, forall x. Rep CreateClusterResponse x -> CreateClusterResponse
forall x. CreateClusterResponse -> Rep CreateClusterResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateClusterResponse x -> CreateClusterResponse
$cfrom :: forall x. CreateClusterResponse -> Rep CreateClusterResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateClusterResponse' 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:
--
-- 'clusterArn', 'createClusterResponse_clusterArn' - The Amazon Resource Name (ARN) of the cluster.
--
-- 'clusterName', 'createClusterResponse_clusterName' - The name of the MSK cluster.
--
-- 'state', 'createClusterResponse_state' - The state of the cluster. The possible states are ACTIVE, CREATING,
-- DELETING, FAILED, HEALING, MAINTENANCE, REBOOTING_BROKER, and UPDATING.
--
-- 'httpStatus', 'createClusterResponse_httpStatus' - The response's http status code.
newCreateClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateClusterResponse
newCreateClusterResponse :: Int -> CreateClusterResponse
newCreateClusterResponse Int
pHttpStatus_ =
  CreateClusterResponse'
    { $sel:clusterArn:CreateClusterResponse' :: Maybe Text
clusterArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clusterName:CreateClusterResponse' :: Maybe Text
clusterName = forall a. Maybe a
Prelude.Nothing,
      $sel:state:CreateClusterResponse' :: Maybe ClusterState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateClusterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the cluster.
createClusterResponse_clusterArn :: Lens.Lens' CreateClusterResponse (Prelude.Maybe Prelude.Text)
createClusterResponse_clusterArn :: Lens' CreateClusterResponse (Maybe Text)
createClusterResponse_clusterArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterResponse' {Maybe Text
clusterArn :: Maybe Text
$sel:clusterArn:CreateClusterResponse' :: CreateClusterResponse -> Maybe Text
clusterArn} -> Maybe Text
clusterArn) (\s :: CreateClusterResponse
s@CreateClusterResponse' {} Maybe Text
a -> CreateClusterResponse
s {$sel:clusterArn:CreateClusterResponse' :: Maybe Text
clusterArn = Maybe Text
a} :: CreateClusterResponse)

-- | The name of the MSK cluster.
createClusterResponse_clusterName :: Lens.Lens' CreateClusterResponse (Prelude.Maybe Prelude.Text)
createClusterResponse_clusterName :: Lens' CreateClusterResponse (Maybe Text)
createClusterResponse_clusterName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterResponse' {Maybe Text
clusterName :: Maybe Text
$sel:clusterName:CreateClusterResponse' :: CreateClusterResponse -> Maybe Text
clusterName} -> Maybe Text
clusterName) (\s :: CreateClusterResponse
s@CreateClusterResponse' {} Maybe Text
a -> CreateClusterResponse
s {$sel:clusterName:CreateClusterResponse' :: Maybe Text
clusterName = Maybe Text
a} :: CreateClusterResponse)

-- | The state of the cluster. The possible states are ACTIVE, CREATING,
-- DELETING, FAILED, HEALING, MAINTENANCE, REBOOTING_BROKER, and UPDATING.
createClusterResponse_state :: Lens.Lens' CreateClusterResponse (Prelude.Maybe ClusterState)
createClusterResponse_state :: Lens' CreateClusterResponse (Maybe ClusterState)
createClusterResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterResponse' {Maybe ClusterState
state :: Maybe ClusterState
$sel:state:CreateClusterResponse' :: CreateClusterResponse -> Maybe ClusterState
state} -> Maybe ClusterState
state) (\s :: CreateClusterResponse
s@CreateClusterResponse' {} Maybe ClusterState
a -> CreateClusterResponse
s {$sel:state:CreateClusterResponse' :: Maybe ClusterState
state = Maybe ClusterState
a} :: CreateClusterResponse)

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

instance Prelude.NFData CreateClusterResponse where
  rnf :: CreateClusterResponse -> ()
rnf CreateClusterResponse' {Int
Maybe Text
Maybe ClusterState
httpStatus :: Int
state :: Maybe ClusterState
clusterName :: Maybe Text
clusterArn :: Maybe Text
$sel:httpStatus:CreateClusterResponse' :: CreateClusterResponse -> Int
$sel:state:CreateClusterResponse' :: CreateClusterResponse -> Maybe ClusterState
$sel:clusterName:CreateClusterResponse' :: CreateClusterResponse -> Maybe Text
$sel:clusterArn:CreateClusterResponse' :: CreateClusterResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus