{-# 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.DAX.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 DAX cluster. All nodes in the cluster run the same DAX caching
-- software.
module Amazonka.DAX.CreateCluster
  ( -- * Creating a Request
    CreateCluster (..),
    newCreateCluster,

    -- * Request Lenses
    createCluster_availabilityZones,
    createCluster_clusterEndpointEncryptionType,
    createCluster_description,
    createCluster_notificationTopicArn,
    createCluster_parameterGroupName,
    createCluster_preferredMaintenanceWindow,
    createCluster_sSESpecification,
    createCluster_securityGroupIds,
    createCluster_subnetGroupName,
    createCluster_tags,
    createCluster_clusterName,
    createCluster_nodeType,
    createCluster_replicationFactor,
    createCluster_iamRoleArn,

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

    -- * Response Lenses
    createClusterResponse_cluster,
    createClusterResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.DAX.Types
import qualified Amazonka.Data as Data
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'
  { -- | The Availability Zones (AZs) in which the cluster nodes will reside
    -- after the cluster has been created or updated. If provided, the length
    -- of this list must equal the @ReplicationFactor@ parameter. If you omit
    -- this parameter, DAX will spread the nodes across Availability Zones for
    -- the highest availability.
    CreateCluster -> Maybe [Text]
availabilityZones :: Prelude.Maybe [Prelude.Text],
    -- | The type of encryption the cluster\'s endpoint should support. Values
    -- are:
    --
    -- -   @NONE@ for no encryption
    --
    -- -   @TLS@ for Transport Layer Security
    CreateCluster -> Maybe ClusterEndpointEncryptionType
clusterEndpointEncryptionType :: Prelude.Maybe ClusterEndpointEncryptionType,
    -- | A description of the cluster.
    CreateCluster -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Amazon SNS topic to which
    -- notifications will be sent.
    --
    -- The Amazon SNS topic owner must be same as the DAX cluster owner.
    CreateCluster -> Maybe Text
notificationTopicArn :: Prelude.Maybe Prelude.Text,
    -- | The parameter group to be associated with the DAX cluster.
    CreateCluster -> Maybe Text
parameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | Specifies the weekly time range during which maintenance on the DAX
    -- cluster is performed. It is specified as a range in the format
    -- ddd:hh24:mi-ddd:hh24:mi (24H Clock UTC). The minimum maintenance window
    -- is a 60 minute period. Valid values for @ddd@ are:
    --
    -- -   @sun@
    --
    -- -   @mon@
    --
    -- -   @tue@
    --
    -- -   @wed@
    --
    -- -   @thu@
    --
    -- -   @fri@
    --
    -- -   @sat@
    --
    -- Example: @sun:05:00-sun:09:00@
    --
    -- If you don\'t specify a preferred maintenance window when you create or
    -- modify a cache cluster, DAX assigns a 60-minute maintenance window on a
    -- randomly selected day of the week.
    CreateCluster -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | Represents the settings used to enable server-side encryption on the
    -- cluster.
    CreateCluster -> Maybe SSESpecification
sSESpecification :: Prelude.Maybe SSESpecification,
    -- | A list of security group IDs to be assigned to each node in the DAX
    -- cluster. (Each of the security group ID is system-generated.)
    --
    -- If this parameter is not specified, DAX assigns the default VPC security
    -- group to each node.
    CreateCluster -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The name of the subnet group to be used for the replication group.
    --
    -- DAX clusters can only run in an Amazon VPC environment. All of the
    -- subnets that you specify in a subnet group must exist in the same VPC.
    CreateCluster -> Maybe Text
subnetGroupName :: Prelude.Maybe Prelude.Text,
    -- | A set of tags to associate with the DAX cluster.
    CreateCluster -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The cluster identifier. This parameter is stored as a lowercase string.
    --
    -- __Constraints:__
    --
    -- -   A name must contain from 1 to 20 alphanumeric characters or hyphens.
    --
    -- -   The first character must be a letter.
    --
    -- -   A name cannot end with a hyphen or contain two consecutive hyphens.
    CreateCluster -> Text
clusterName :: Prelude.Text,
    -- | The compute and memory capacity of the nodes in the cluster.
    CreateCluster -> Text
nodeType :: Prelude.Text,
    -- | The number of nodes in the DAX cluster. A replication factor of 1 will
    -- create a single-node cluster, without any read replicas. For additional
    -- fault tolerance, you can create a multiple node cluster with one or more
    -- read replicas. To do this, set @ReplicationFactor@ to a number between 3
    -- (one primary and two read replicas) and 10 (one primary and nine read
    -- replicas). @If the AvailabilityZones@ parameter is provided, its length
    -- must equal the @ReplicationFactor@.
    --
    -- AWS recommends that you have at least two read replicas per cluster.
    CreateCluster -> Int
replicationFactor :: Prelude.Int,
    -- | A valid Amazon Resource Name (ARN) that identifies an IAM role. At
    -- runtime, DAX will assume this role and use the role\'s permissions to
    -- access DynamoDB on your behalf.
    CreateCluster -> Text
iamRoleArn :: 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:
--
-- 'availabilityZones', 'createCluster_availabilityZones' - The Availability Zones (AZs) in which the cluster nodes will reside
-- after the cluster has been created or updated. If provided, the length
-- of this list must equal the @ReplicationFactor@ parameter. If you omit
-- this parameter, DAX will spread the nodes across Availability Zones for
-- the highest availability.
--
-- 'clusterEndpointEncryptionType', 'createCluster_clusterEndpointEncryptionType' - The type of encryption the cluster\'s endpoint should support. Values
-- are:
--
-- -   @NONE@ for no encryption
--
-- -   @TLS@ for Transport Layer Security
--
-- 'description', 'createCluster_description' - A description of the cluster.
--
-- 'notificationTopicArn', 'createCluster_notificationTopicArn' - The Amazon Resource Name (ARN) of the Amazon SNS topic to which
-- notifications will be sent.
--
-- The Amazon SNS topic owner must be same as the DAX cluster owner.
--
-- 'parameterGroupName', 'createCluster_parameterGroupName' - The parameter group to be associated with the DAX cluster.
--
-- 'preferredMaintenanceWindow', 'createCluster_preferredMaintenanceWindow' - Specifies the weekly time range during which maintenance on the DAX
-- cluster is performed. It is specified as a range in the format
-- ddd:hh24:mi-ddd:hh24:mi (24H Clock UTC). The minimum maintenance window
-- is a 60 minute period. Valid values for @ddd@ are:
--
-- -   @sun@
--
-- -   @mon@
--
-- -   @tue@
--
-- -   @wed@
--
-- -   @thu@
--
-- -   @fri@
--
-- -   @sat@
--
-- Example: @sun:05:00-sun:09:00@
--
-- If you don\'t specify a preferred maintenance window when you create or
-- modify a cache cluster, DAX assigns a 60-minute maintenance window on a
-- randomly selected day of the week.
--
-- 'sSESpecification', 'createCluster_sSESpecification' - Represents the settings used to enable server-side encryption on the
-- cluster.
--
-- 'securityGroupIds', 'createCluster_securityGroupIds' - A list of security group IDs to be assigned to each node in the DAX
-- cluster. (Each of the security group ID is system-generated.)
--
-- If this parameter is not specified, DAX assigns the default VPC security
-- group to each node.
--
-- 'subnetGroupName', 'createCluster_subnetGroupName' - The name of the subnet group to be used for the replication group.
--
-- DAX clusters can only run in an Amazon VPC environment. All of the
-- subnets that you specify in a subnet group must exist in the same VPC.
--
-- 'tags', 'createCluster_tags' - A set of tags to associate with the DAX cluster.
--
-- 'clusterName', 'createCluster_clusterName' - The cluster identifier. This parameter is stored as a lowercase string.
--
-- __Constraints:__
--
-- -   A name must contain from 1 to 20 alphanumeric characters or hyphens.
--
-- -   The first character must be a letter.
--
-- -   A name cannot end with a hyphen or contain two consecutive hyphens.
--
-- 'nodeType', 'createCluster_nodeType' - The compute and memory capacity of the nodes in the cluster.
--
-- 'replicationFactor', 'createCluster_replicationFactor' - The number of nodes in the DAX cluster. A replication factor of 1 will
-- create a single-node cluster, without any read replicas. For additional
-- fault tolerance, you can create a multiple node cluster with one or more
-- read replicas. To do this, set @ReplicationFactor@ to a number between 3
-- (one primary and two read replicas) and 10 (one primary and nine read
-- replicas). @If the AvailabilityZones@ parameter is provided, its length
-- must equal the @ReplicationFactor@.
--
-- AWS recommends that you have at least two read replicas per cluster.
--
-- 'iamRoleArn', 'createCluster_iamRoleArn' - A valid Amazon Resource Name (ARN) that identifies an IAM role. At
-- runtime, DAX will assume this role and use the role\'s permissions to
-- access DynamoDB on your behalf.
newCreateCluster ::
  -- | 'clusterName'
  Prelude.Text ->
  -- | 'nodeType'
  Prelude.Text ->
  -- | 'replicationFactor'
  Prelude.Int ->
  -- | 'iamRoleArn'
  Prelude.Text ->
  CreateCluster
newCreateCluster :: Text -> Text -> Int -> Text -> CreateCluster
newCreateCluster
  Text
pClusterName_
  Text
pNodeType_
  Int
pReplicationFactor_
  Text
pIamRoleArn_ =
    CreateCluster'
      { $sel:availabilityZones:CreateCluster' :: Maybe [Text]
availabilityZones = forall a. Maybe a
Prelude.Nothing,
        $sel:clusterEndpointEncryptionType:CreateCluster' :: Maybe ClusterEndpointEncryptionType
clusterEndpointEncryptionType = forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateCluster' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:notificationTopicArn:CreateCluster' :: Maybe Text
notificationTopicArn = forall a. Maybe a
Prelude.Nothing,
        $sel:parameterGroupName:CreateCluster' :: Maybe Text
parameterGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:preferredMaintenanceWindow:CreateCluster' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
        $sel:sSESpecification:CreateCluster' :: Maybe SSESpecification
sSESpecification = forall a. Maybe a
Prelude.Nothing,
        $sel:securityGroupIds:CreateCluster' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
        $sel:subnetGroupName:CreateCluster' :: Maybe Text
subnetGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateCluster' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:clusterName:CreateCluster' :: Text
clusterName = Text
pClusterName_,
        $sel:nodeType:CreateCluster' :: Text
nodeType = Text
pNodeType_,
        $sel:replicationFactor:CreateCluster' :: Int
replicationFactor = Int
pReplicationFactor_,
        $sel:iamRoleArn:CreateCluster' :: Text
iamRoleArn = Text
pIamRoleArn_
      }

-- | The Availability Zones (AZs) in which the cluster nodes will reside
-- after the cluster has been created or updated. If provided, the length
-- of this list must equal the @ReplicationFactor@ parameter. If you omit
-- this parameter, DAX will spread the nodes across Availability Zones for
-- the highest availability.
createCluster_availabilityZones :: Lens.Lens' CreateCluster (Prelude.Maybe [Prelude.Text])
createCluster_availabilityZones :: Lens' CreateCluster (Maybe [Text])
createCluster_availabilityZones = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe [Text]
availabilityZones :: Maybe [Text]
$sel:availabilityZones:CreateCluster' :: CreateCluster -> Maybe [Text]
availabilityZones} -> Maybe [Text]
availabilityZones) (\s :: CreateCluster
s@CreateCluster' {} Maybe [Text]
a -> CreateCluster
s {$sel:availabilityZones:CreateCluster' :: Maybe [Text]
availabilityZones = Maybe [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

-- | The type of encryption the cluster\'s endpoint should support. Values
-- are:
--
-- -   @NONE@ for no encryption
--
-- -   @TLS@ for Transport Layer Security
createCluster_clusterEndpointEncryptionType :: Lens.Lens' CreateCluster (Prelude.Maybe ClusterEndpointEncryptionType)
createCluster_clusterEndpointEncryptionType :: Lens' CreateCluster (Maybe ClusterEndpointEncryptionType)
createCluster_clusterEndpointEncryptionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe ClusterEndpointEncryptionType
clusterEndpointEncryptionType :: Maybe ClusterEndpointEncryptionType
$sel:clusterEndpointEncryptionType:CreateCluster' :: CreateCluster -> Maybe ClusterEndpointEncryptionType
clusterEndpointEncryptionType} -> Maybe ClusterEndpointEncryptionType
clusterEndpointEncryptionType) (\s :: CreateCluster
s@CreateCluster' {} Maybe ClusterEndpointEncryptionType
a -> CreateCluster
s {$sel:clusterEndpointEncryptionType:CreateCluster' :: Maybe ClusterEndpointEncryptionType
clusterEndpointEncryptionType = Maybe ClusterEndpointEncryptionType
a} :: CreateCluster)

-- | A description of the cluster.
createCluster_description :: Lens.Lens' CreateCluster (Prelude.Maybe Prelude.Text)
createCluster_description :: Lens' CreateCluster (Maybe Text)
createCluster_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe Text
description :: Maybe Text
$sel:description:CreateCluster' :: CreateCluster -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateCluster
s@CreateCluster' {} Maybe Text
a -> CreateCluster
s {$sel:description:CreateCluster' :: Maybe Text
description = Maybe Text
a} :: CreateCluster)

-- | The Amazon Resource Name (ARN) of the Amazon SNS topic to which
-- notifications will be sent.
--
-- The Amazon SNS topic owner must be same as the DAX cluster owner.
createCluster_notificationTopicArn :: Lens.Lens' CreateCluster (Prelude.Maybe Prelude.Text)
createCluster_notificationTopicArn :: Lens' CreateCluster (Maybe Text)
createCluster_notificationTopicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe Text
notificationTopicArn :: Maybe Text
$sel:notificationTopicArn:CreateCluster' :: CreateCluster -> Maybe Text
notificationTopicArn} -> Maybe Text
notificationTopicArn) (\s :: CreateCluster
s@CreateCluster' {} Maybe Text
a -> CreateCluster
s {$sel:notificationTopicArn:CreateCluster' :: Maybe Text
notificationTopicArn = Maybe Text
a} :: CreateCluster)

-- | The parameter group to be associated with the DAX cluster.
createCluster_parameterGroupName :: Lens.Lens' CreateCluster (Prelude.Maybe Prelude.Text)
createCluster_parameterGroupName :: Lens' CreateCluster (Maybe Text)
createCluster_parameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe Text
parameterGroupName :: Maybe Text
$sel:parameterGroupName:CreateCluster' :: CreateCluster -> Maybe Text
parameterGroupName} -> Maybe Text
parameterGroupName) (\s :: CreateCluster
s@CreateCluster' {} Maybe Text
a -> CreateCluster
s {$sel:parameterGroupName:CreateCluster' :: Maybe Text
parameterGroupName = Maybe Text
a} :: CreateCluster)

-- | Specifies the weekly time range during which maintenance on the DAX
-- cluster is performed. It is specified as a range in the format
-- ddd:hh24:mi-ddd:hh24:mi (24H Clock UTC). The minimum maintenance window
-- is a 60 minute period. Valid values for @ddd@ are:
--
-- -   @sun@
--
-- -   @mon@
--
-- -   @tue@
--
-- -   @wed@
--
-- -   @thu@
--
-- -   @fri@
--
-- -   @sat@
--
-- Example: @sun:05:00-sun:09:00@
--
-- If you don\'t specify a preferred maintenance window when you create or
-- modify a cache cluster, DAX assigns a 60-minute maintenance window on a
-- randomly selected day of the week.
createCluster_preferredMaintenanceWindow :: Lens.Lens' CreateCluster (Prelude.Maybe Prelude.Text)
createCluster_preferredMaintenanceWindow :: Lens' CreateCluster (Maybe Text)
createCluster_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:CreateCluster' :: CreateCluster -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: CreateCluster
s@CreateCluster' {} Maybe Text
a -> CreateCluster
s {$sel:preferredMaintenanceWindow:CreateCluster' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: CreateCluster)

-- | Represents the settings used to enable server-side encryption on the
-- cluster.
createCluster_sSESpecification :: Lens.Lens' CreateCluster (Prelude.Maybe SSESpecification)
createCluster_sSESpecification :: Lens' CreateCluster (Maybe SSESpecification)
createCluster_sSESpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe SSESpecification
sSESpecification :: Maybe SSESpecification
$sel:sSESpecification:CreateCluster' :: CreateCluster -> Maybe SSESpecification
sSESpecification} -> Maybe SSESpecification
sSESpecification) (\s :: CreateCluster
s@CreateCluster' {} Maybe SSESpecification
a -> CreateCluster
s {$sel:sSESpecification:CreateCluster' :: Maybe SSESpecification
sSESpecification = Maybe SSESpecification
a} :: CreateCluster)

-- | A list of security group IDs to be assigned to each node in the DAX
-- cluster. (Each of the security group ID is system-generated.)
--
-- If this parameter is not specified, DAX assigns the default VPC security
-- group to each node.
createCluster_securityGroupIds :: Lens.Lens' CreateCluster (Prelude.Maybe [Prelude.Text])
createCluster_securityGroupIds :: Lens' CreateCluster (Maybe [Text])
createCluster_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:CreateCluster' :: CreateCluster -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: CreateCluster
s@CreateCluster' {} Maybe [Text]
a -> CreateCluster
s {$sel:securityGroupIds:CreateCluster' :: Maybe [Text]
securityGroupIds = Maybe [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

-- | The name of the subnet group to be used for the replication group.
--
-- DAX clusters can only run in an Amazon VPC environment. All of the
-- subnets that you specify in a subnet group must exist in the same VPC.
createCluster_subnetGroupName :: Lens.Lens' CreateCluster (Prelude.Maybe Prelude.Text)
createCluster_subnetGroupName :: Lens' CreateCluster (Maybe Text)
createCluster_subnetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe Text
subnetGroupName :: Maybe Text
$sel:subnetGroupName:CreateCluster' :: CreateCluster -> Maybe Text
subnetGroupName} -> Maybe Text
subnetGroupName) (\s :: CreateCluster
s@CreateCluster' {} Maybe Text
a -> CreateCluster
s {$sel:subnetGroupName:CreateCluster' :: Maybe Text
subnetGroupName = Maybe Text
a} :: CreateCluster)

-- | A set of tags to associate with the DAX cluster.
createCluster_tags :: Lens.Lens' CreateCluster (Prelude.Maybe [Tag])
createCluster_tags :: Lens' CreateCluster (Maybe [Tag])
createCluster_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCluster' :: CreateCluster -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCluster
s@CreateCluster' {} Maybe [Tag]
a -> CreateCluster
s {$sel:tags:CreateCluster' :: Maybe [Tag]
tags = Maybe [Tag]
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

-- | The cluster identifier. This parameter is stored as a lowercase string.
--
-- __Constraints:__
--
-- -   A name must contain from 1 to 20 alphanumeric characters or hyphens.
--
-- -   The first character must be a letter.
--
-- -   A name cannot end with a hyphen or contain two consecutive hyphens.
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)

-- | The compute and memory capacity of the nodes in the cluster.
createCluster_nodeType :: Lens.Lens' CreateCluster Prelude.Text
createCluster_nodeType :: Lens' CreateCluster Text
createCluster_nodeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Text
nodeType :: Text
$sel:nodeType:CreateCluster' :: CreateCluster -> Text
nodeType} -> Text
nodeType) (\s :: CreateCluster
s@CreateCluster' {} Text
a -> CreateCluster
s {$sel:nodeType:CreateCluster' :: Text
nodeType = Text
a} :: CreateCluster)

-- | The number of nodes in the DAX cluster. A replication factor of 1 will
-- create a single-node cluster, without any read replicas. For additional
-- fault tolerance, you can create a multiple node cluster with one or more
-- read replicas. To do this, set @ReplicationFactor@ to a number between 3
-- (one primary and two read replicas) and 10 (one primary and nine read
-- replicas). @If the AvailabilityZones@ parameter is provided, its length
-- must equal the @ReplicationFactor@.
--
-- AWS recommends that you have at least two read replicas per cluster.
createCluster_replicationFactor :: Lens.Lens' CreateCluster Prelude.Int
createCluster_replicationFactor :: Lens' CreateCluster Int
createCluster_replicationFactor = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Int
replicationFactor :: Int
$sel:replicationFactor:CreateCluster' :: CreateCluster -> Int
replicationFactor} -> Int
replicationFactor) (\s :: CreateCluster
s@CreateCluster' {} Int
a -> CreateCluster
s {$sel:replicationFactor:CreateCluster' :: Int
replicationFactor = Int
a} :: CreateCluster)

-- | A valid Amazon Resource Name (ARN) that identifies an IAM role. At
-- runtime, DAX will assume this role and use the role\'s permissions to
-- access DynamoDB on your behalf.
createCluster_iamRoleArn :: Lens.Lens' CreateCluster Prelude.Text
createCluster_iamRoleArn :: Lens' CreateCluster Text
createCluster_iamRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCluster' {Text
iamRoleArn :: Text
$sel:iamRoleArn:CreateCluster' :: CreateCluster -> Text
iamRoleArn} -> Text
iamRoleArn) (\s :: CreateCluster
s@CreateCluster' {} Text
a -> CreateCluster
s {$sel:iamRoleArn:CreateCluster' :: Text
iamRoleArn = 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 Cluster -> 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
"Cluster")
            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' {Int
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ClusterEndpointEncryptionType
Maybe SSESpecification
Text
iamRoleArn :: Text
replicationFactor :: Int
nodeType :: Text
clusterName :: Text
tags :: Maybe [Tag]
subnetGroupName :: Maybe Text
securityGroupIds :: Maybe [Text]
sSESpecification :: Maybe SSESpecification
preferredMaintenanceWindow :: Maybe Text
parameterGroupName :: Maybe Text
notificationTopicArn :: Maybe Text
description :: Maybe Text
clusterEndpointEncryptionType :: Maybe ClusterEndpointEncryptionType
availabilityZones :: Maybe [Text]
$sel:iamRoleArn:CreateCluster' :: CreateCluster -> Text
$sel:replicationFactor:CreateCluster' :: CreateCluster -> Int
$sel:nodeType:CreateCluster' :: CreateCluster -> Text
$sel:clusterName:CreateCluster' :: CreateCluster -> Text
$sel:tags:CreateCluster' :: CreateCluster -> Maybe [Tag]
$sel:subnetGroupName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:securityGroupIds:CreateCluster' :: CreateCluster -> Maybe [Text]
$sel:sSESpecification:CreateCluster' :: CreateCluster -> Maybe SSESpecification
$sel:preferredMaintenanceWindow:CreateCluster' :: CreateCluster -> Maybe Text
$sel:parameterGroupName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:notificationTopicArn:CreateCluster' :: CreateCluster -> Maybe Text
$sel:description:CreateCluster' :: CreateCluster -> Maybe Text
$sel:clusterEndpointEncryptionType:CreateCluster' :: CreateCluster -> Maybe ClusterEndpointEncryptionType
$sel:availabilityZones:CreateCluster' :: CreateCluster -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
availabilityZones
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterEndpointEncryptionType
clusterEndpointEncryptionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
notificationTopicArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SSESpecification
sSESpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subnetGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
nodeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
replicationFactor
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
iamRoleArn

instance Prelude.NFData CreateCluster where
  rnf :: CreateCluster -> ()
rnf CreateCluster' {Int
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ClusterEndpointEncryptionType
Maybe SSESpecification
Text
iamRoleArn :: Text
replicationFactor :: Int
nodeType :: Text
clusterName :: Text
tags :: Maybe [Tag]
subnetGroupName :: Maybe Text
securityGroupIds :: Maybe [Text]
sSESpecification :: Maybe SSESpecification
preferredMaintenanceWindow :: Maybe Text
parameterGroupName :: Maybe Text
notificationTopicArn :: Maybe Text
description :: Maybe Text
clusterEndpointEncryptionType :: Maybe ClusterEndpointEncryptionType
availabilityZones :: Maybe [Text]
$sel:iamRoleArn:CreateCluster' :: CreateCluster -> Text
$sel:replicationFactor:CreateCluster' :: CreateCluster -> Int
$sel:nodeType:CreateCluster' :: CreateCluster -> Text
$sel:clusterName:CreateCluster' :: CreateCluster -> Text
$sel:tags:CreateCluster' :: CreateCluster -> Maybe [Tag]
$sel:subnetGroupName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:securityGroupIds:CreateCluster' :: CreateCluster -> Maybe [Text]
$sel:sSESpecification:CreateCluster' :: CreateCluster -> Maybe SSESpecification
$sel:preferredMaintenanceWindow:CreateCluster' :: CreateCluster -> Maybe Text
$sel:parameterGroupName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:notificationTopicArn:CreateCluster' :: CreateCluster -> Maybe Text
$sel:description:CreateCluster' :: CreateCluster -> Maybe Text
$sel:clusterEndpointEncryptionType:CreateCluster' :: CreateCluster -> Maybe ClusterEndpointEncryptionType
$sel:availabilityZones:CreateCluster' :: CreateCluster -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
availabilityZones
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterEndpointEncryptionType
clusterEndpointEncryptionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
notificationTopicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SSESpecification
sSESpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subnetGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
nodeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
replicationFactor
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
iamRoleArn

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
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"AmazonDAXV3.CreateCluster" :: Prelude.ByteString),
            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' {Int
Maybe [Text]
Maybe [Tag]
Maybe Text
Maybe ClusterEndpointEncryptionType
Maybe SSESpecification
Text
iamRoleArn :: Text
replicationFactor :: Int
nodeType :: Text
clusterName :: Text
tags :: Maybe [Tag]
subnetGroupName :: Maybe Text
securityGroupIds :: Maybe [Text]
sSESpecification :: Maybe SSESpecification
preferredMaintenanceWindow :: Maybe Text
parameterGroupName :: Maybe Text
notificationTopicArn :: Maybe Text
description :: Maybe Text
clusterEndpointEncryptionType :: Maybe ClusterEndpointEncryptionType
availabilityZones :: Maybe [Text]
$sel:iamRoleArn:CreateCluster' :: CreateCluster -> Text
$sel:replicationFactor:CreateCluster' :: CreateCluster -> Int
$sel:nodeType:CreateCluster' :: CreateCluster -> Text
$sel:clusterName:CreateCluster' :: CreateCluster -> Text
$sel:tags:CreateCluster' :: CreateCluster -> Maybe [Tag]
$sel:subnetGroupName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:securityGroupIds:CreateCluster' :: CreateCluster -> Maybe [Text]
$sel:sSESpecification:CreateCluster' :: CreateCluster -> Maybe SSESpecification
$sel:preferredMaintenanceWindow:CreateCluster' :: CreateCluster -> Maybe Text
$sel:parameterGroupName:CreateCluster' :: CreateCluster -> Maybe Text
$sel:notificationTopicArn:CreateCluster' :: CreateCluster -> Maybe Text
$sel:description:CreateCluster' :: CreateCluster -> Maybe Text
$sel:clusterEndpointEncryptionType:CreateCluster' :: CreateCluster -> Maybe ClusterEndpointEncryptionType
$sel:availabilityZones:CreateCluster' :: CreateCluster -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AvailabilityZones" 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]
availabilityZones,
            (Key
"ClusterEndpointEncryptionType" 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 ClusterEndpointEncryptionType
clusterEndpointEncryptionType,
            (Key
"Description" 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
description,
            (Key
"NotificationTopicArn" 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
notificationTopicArn,
            (Key
"ParameterGroupName" 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
parameterGroupName,
            (Key
"PreferredMaintenanceWindow" 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
preferredMaintenanceWindow,
            (Key
"SSESpecification" 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 SSESpecification
sSESpecification,
            (Key
"SecurityGroupIds" 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]
securityGroupIds,
            (Key
"SubnetGroupName" 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
subnetGroupName,
            (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 [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"ClusterName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clusterName),
            forall a. a -> Maybe a
Prelude.Just (Key
"NodeType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
nodeType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ReplicationFactor" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Int
replicationFactor),
            forall a. a -> Maybe a
Prelude.Just (Key
"IamRoleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
iamRoleArn)
          ]
      )

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

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'
  { -- | A description of the DAX cluster that you have created.
    CreateClusterResponse -> Maybe Cluster
cluster :: Prelude.Maybe Cluster,
    -- | 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:
--
-- 'cluster', 'createClusterResponse_cluster' - A description of the DAX cluster that you have created.
--
-- 'httpStatus', 'createClusterResponse_httpStatus' - The response's http status code.
newCreateClusterResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateClusterResponse
newCreateClusterResponse :: Int -> CreateClusterResponse
newCreateClusterResponse Int
pHttpStatus_ =
  CreateClusterResponse'
    { $sel:cluster:CreateClusterResponse' :: Maybe Cluster
cluster = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateClusterResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A description of the DAX cluster that you have created.
createClusterResponse_cluster :: Lens.Lens' CreateClusterResponse (Prelude.Maybe Cluster)
createClusterResponse_cluster :: Lens' CreateClusterResponse (Maybe Cluster)
createClusterResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:CreateClusterResponse' :: CreateClusterResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: CreateClusterResponse
s@CreateClusterResponse' {} Maybe Cluster
a -> CreateClusterResponse
s {$sel:cluster:CreateClusterResponse' :: Maybe Cluster
cluster = Maybe Cluster
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 Cluster
httpStatus :: Int
cluster :: Maybe Cluster
$sel:httpStatus:CreateClusterResponse' :: CreateClusterResponse -> Int
$sel:cluster:CreateClusterResponse' :: CreateClusterResponse -> Maybe Cluster
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Cluster
cluster
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus