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

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

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

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MemoryDb.Types.AZStatus
import Amazonka.MemoryDb.Types.ClusterPendingUpdates
import Amazonka.MemoryDb.Types.DataTieringStatus
import Amazonka.MemoryDb.Types.Endpoint
import Amazonka.MemoryDb.Types.SecurityGroupMembership
import Amazonka.MemoryDb.Types.Shard
import qualified Amazonka.Prelude as Prelude

-- | Contains all of the attributes of a specific cluster.
--
-- /See:/ 'newCluster' smart constructor.
data Cluster = Cluster'
  { -- | The name of the Access Control List associated with this cluster.
    Cluster -> Maybe Text
aCLName :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the cluster.
    Cluster -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | When set to true, the cluster will automatically receive minor engine
    -- version upgrades after launch.
    Cluster -> Maybe Bool
autoMinorVersionUpgrade :: Prelude.Maybe Prelude.Bool,
    -- | Indicates if the cluster has a Multi-AZ configuration (multiaz) or not
    -- (singleaz).
    Cluster -> Maybe AZStatus
availabilityMode :: Prelude.Maybe AZStatus,
    -- | The cluster\'s configuration endpoint
    Cluster -> Maybe Endpoint
clusterEndpoint :: Prelude.Maybe Endpoint,
    -- | Enables data tiering. Data tiering is only supported for clusters using
    -- the r6gd node type. This parameter must be set when using r6gd nodes.
    -- For more information, see
    -- <https://docs.aws.amazon.com/memorydb/latest/devguide/data-tiering.html Data tiering>.
    Cluster -> Maybe DataTieringStatus
dataTiering :: Prelude.Maybe DataTieringStatus,
    -- | A description of the cluster
    Cluster -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The Redis engine patch version used by the cluster
    Cluster -> Maybe Text
enginePatchVersion :: Prelude.Maybe Prelude.Text,
    -- | The Redis engine version used by the cluster
    Cluster -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The ID of the KMS key used to encrypt the cluster
    Cluster -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Specifies the weekly time range during which maintenance on the 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.
    Cluster -> Maybe Text
maintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | The user-supplied name of the cluster. This identifier is a unique key
    -- that identifies a cluster.
    Cluster -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The cluster\'s node type
    Cluster -> Maybe Text
nodeType :: Prelude.Maybe Prelude.Text,
    -- | The number of shards in the cluster
    Cluster -> Maybe Int
numberOfShards :: Prelude.Maybe Prelude.Int,
    -- | The name of the parameter group used by the cluster
    Cluster -> Maybe Text
parameterGroupName :: Prelude.Maybe Prelude.Text,
    -- | The status of the parameter group used by the cluster, for example
    -- \'active\' or \'applying\'.
    Cluster -> Maybe Text
parameterGroupStatus :: Prelude.Maybe Prelude.Text,
    -- | A group of settings that are currently being applied.
    Cluster -> Maybe ClusterPendingUpdates
pendingUpdates :: Prelude.Maybe ClusterPendingUpdates,
    -- | A list of security groups used by the cluster
    Cluster -> Maybe [SecurityGroupMembership]
securityGroups :: Prelude.Maybe [SecurityGroupMembership],
    -- | A list of shards that are members of the cluster.
    Cluster -> Maybe [Shard]
shards :: Prelude.Maybe [Shard],
    -- | The number of days for which MemoryDB retains automatic snapshots before
    -- deleting them. For example, if you set SnapshotRetentionLimit to 5, a
    -- snapshot that was taken today is retained for 5 days before being
    -- deleted.
    Cluster -> Maybe Int
snapshotRetentionLimit :: Prelude.Maybe Prelude.Int,
    -- | The daily time range (in UTC) during which MemoryDB begins taking a
    -- daily snapshot of your shard. Example: 05:00-09:00 If you do not specify
    -- this parameter, MemoryDB automatically chooses an appropriate time
    -- range.
    Cluster -> Maybe Text
snapshotWindow :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the SNS notification topic
    Cluster -> Maybe Text
snsTopicArn :: Prelude.Maybe Prelude.Text,
    -- | The SNS topic must be in Active status to receive notifications
    Cluster -> Maybe Text
snsTopicStatus :: Prelude.Maybe Prelude.Text,
    -- | The status of the cluster. For example, Available, Updating, Creating.
    Cluster -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    -- | The name of the subnet group used by the cluster
    Cluster -> Maybe Text
subnetGroupName :: Prelude.Maybe Prelude.Text,
    -- | A flag to indicate if In-transit encryption is enabled
    Cluster -> Maybe Bool
tLSEnabled :: Prelude.Maybe Prelude.Bool
  }
  deriving (Cluster -> Cluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cluster -> Cluster -> Bool
$c/= :: Cluster -> Cluster -> Bool
== :: Cluster -> Cluster -> Bool
$c== :: Cluster -> Cluster -> Bool
Prelude.Eq, ReadPrec [Cluster]
ReadPrec Cluster
Int -> ReadS Cluster
ReadS [Cluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Cluster]
$creadListPrec :: ReadPrec [Cluster]
readPrec :: ReadPrec Cluster
$creadPrec :: ReadPrec Cluster
readList :: ReadS [Cluster]
$creadList :: ReadS [Cluster]
readsPrec :: Int -> ReadS Cluster
$creadsPrec :: Int -> ReadS Cluster
Prelude.Read, Int -> Cluster -> ShowS
[Cluster] -> ShowS
Cluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cluster] -> ShowS
$cshowList :: [Cluster] -> ShowS
show :: Cluster -> String
$cshow :: Cluster -> String
showsPrec :: Int -> Cluster -> ShowS
$cshowsPrec :: Int -> Cluster -> ShowS
Prelude.Show, forall x. Rep Cluster x -> Cluster
forall x. Cluster -> Rep Cluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cluster x -> Cluster
$cfrom :: forall x. Cluster -> Rep Cluster x
Prelude.Generic)

-- |
-- Create a value of 'Cluster' 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:
--
-- 'aCLName', 'cluster_aCLName' - The name of the Access Control List associated with this cluster.
--
-- 'arn', 'cluster_arn' - The Amazon Resource Name (ARN) of the cluster.
--
-- 'autoMinorVersionUpgrade', 'cluster_autoMinorVersionUpgrade' - When set to true, the cluster will automatically receive minor engine
-- version upgrades after launch.
--
-- 'availabilityMode', 'cluster_availabilityMode' - Indicates if the cluster has a Multi-AZ configuration (multiaz) or not
-- (singleaz).
--
-- 'clusterEndpoint', 'cluster_clusterEndpoint' - The cluster\'s configuration endpoint
--
-- 'dataTiering', 'cluster_dataTiering' - Enables data tiering. Data tiering is only supported for clusters using
-- the r6gd node type. This parameter must be set when using r6gd nodes.
-- For more information, see
-- <https://docs.aws.amazon.com/memorydb/latest/devguide/data-tiering.html Data tiering>.
--
-- 'description', 'cluster_description' - A description of the cluster
--
-- 'enginePatchVersion', 'cluster_enginePatchVersion' - The Redis engine patch version used by the cluster
--
-- 'engineVersion', 'cluster_engineVersion' - The Redis engine version used by the cluster
--
-- 'kmsKeyId', 'cluster_kmsKeyId' - The ID of the KMS key used to encrypt the cluster
--
-- 'maintenanceWindow', 'cluster_maintenanceWindow' - Specifies the weekly time range during which maintenance on the 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.
--
-- 'name', 'cluster_name' - The user-supplied name of the cluster. This identifier is a unique key
-- that identifies a cluster.
--
-- 'nodeType', 'cluster_nodeType' - The cluster\'s node type
--
-- 'numberOfShards', 'cluster_numberOfShards' - The number of shards in the cluster
--
-- 'parameterGroupName', 'cluster_parameterGroupName' - The name of the parameter group used by the cluster
--
-- 'parameterGroupStatus', 'cluster_parameterGroupStatus' - The status of the parameter group used by the cluster, for example
-- \'active\' or \'applying\'.
--
-- 'pendingUpdates', 'cluster_pendingUpdates' - A group of settings that are currently being applied.
--
-- 'securityGroups', 'cluster_securityGroups' - A list of security groups used by the cluster
--
-- 'shards', 'cluster_shards' - A list of shards that are members of the cluster.
--
-- 'snapshotRetentionLimit', 'cluster_snapshotRetentionLimit' - The number of days for which MemoryDB retains automatic snapshots before
-- deleting them. For example, if you set SnapshotRetentionLimit to 5, a
-- snapshot that was taken today is retained for 5 days before being
-- deleted.
--
-- 'snapshotWindow', 'cluster_snapshotWindow' - The daily time range (in UTC) during which MemoryDB begins taking a
-- daily snapshot of your shard. Example: 05:00-09:00 If you do not specify
-- this parameter, MemoryDB automatically chooses an appropriate time
-- range.
--
-- 'snsTopicArn', 'cluster_snsTopicArn' - The Amazon Resource Name (ARN) of the SNS notification topic
--
-- 'snsTopicStatus', 'cluster_snsTopicStatus' - The SNS topic must be in Active status to receive notifications
--
-- 'status', 'cluster_status' - The status of the cluster. For example, Available, Updating, Creating.
--
-- 'subnetGroupName', 'cluster_subnetGroupName' - The name of the subnet group used by the cluster
--
-- 'tLSEnabled', 'cluster_tLSEnabled' - A flag to indicate if In-transit encryption is enabled
newCluster ::
  Cluster
newCluster :: Cluster
newCluster =
  Cluster'
    { $sel:aCLName:Cluster' :: Maybe Text
aCLName = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:Cluster' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:autoMinorVersionUpgrade:Cluster' :: Maybe Bool
autoMinorVersionUpgrade = forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityMode:Cluster' :: Maybe AZStatus
availabilityMode = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterEndpoint:Cluster' :: Maybe Endpoint
clusterEndpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:dataTiering:Cluster' :: Maybe DataTieringStatus
dataTiering = forall a. Maybe a
Prelude.Nothing,
      $sel:description:Cluster' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:enginePatchVersion:Cluster' :: Maybe Text
enginePatchVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:Cluster' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:Cluster' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceWindow:Cluster' :: Maybe Text
maintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Cluster' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:nodeType:Cluster' :: Maybe Text
nodeType = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfShards:Cluster' :: Maybe Int
numberOfShards = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterGroupName:Cluster' :: Maybe Text
parameterGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterGroupStatus:Cluster' :: Maybe Text
parameterGroupStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:pendingUpdates:Cluster' :: Maybe ClusterPendingUpdates
pendingUpdates = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:Cluster' :: Maybe [SecurityGroupMembership]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:shards:Cluster' :: Maybe [Shard]
shards = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotRetentionLimit:Cluster' :: Maybe Int
snapshotRetentionLimit = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotWindow:Cluster' :: Maybe Text
snapshotWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:snsTopicArn:Cluster' :: Maybe Text
snsTopicArn = forall a. Maybe a
Prelude.Nothing,
      $sel:snsTopicStatus:Cluster' :: Maybe Text
snsTopicStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Cluster' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetGroupName:Cluster' :: Maybe Text
subnetGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:tLSEnabled:Cluster' :: Maybe Bool
tLSEnabled = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the Access Control List associated with this cluster.
cluster_aCLName :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_aCLName :: Lens' Cluster (Maybe Text)
cluster_aCLName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
aCLName :: Maybe Text
$sel:aCLName:Cluster' :: Cluster -> Maybe Text
aCLName} -> Maybe Text
aCLName) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:aCLName:Cluster' :: Maybe Text
aCLName = Maybe Text
a} :: Cluster)

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

-- | When set to true, the cluster will automatically receive minor engine
-- version upgrades after launch.
cluster_autoMinorVersionUpgrade :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Bool)
cluster_autoMinorVersionUpgrade :: Lens' Cluster (Maybe Bool)
cluster_autoMinorVersionUpgrade = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Bool
autoMinorVersionUpgrade :: Maybe Bool
$sel:autoMinorVersionUpgrade:Cluster' :: Cluster -> Maybe Bool
autoMinorVersionUpgrade} -> Maybe Bool
autoMinorVersionUpgrade) (\s :: Cluster
s@Cluster' {} Maybe Bool
a -> Cluster
s {$sel:autoMinorVersionUpgrade:Cluster' :: Maybe Bool
autoMinorVersionUpgrade = Maybe Bool
a} :: Cluster)

-- | Indicates if the cluster has a Multi-AZ configuration (multiaz) or not
-- (singleaz).
cluster_availabilityMode :: Lens.Lens' Cluster (Prelude.Maybe AZStatus)
cluster_availabilityMode :: Lens' Cluster (Maybe AZStatus)
cluster_availabilityMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe AZStatus
availabilityMode :: Maybe AZStatus
$sel:availabilityMode:Cluster' :: Cluster -> Maybe AZStatus
availabilityMode} -> Maybe AZStatus
availabilityMode) (\s :: Cluster
s@Cluster' {} Maybe AZStatus
a -> Cluster
s {$sel:availabilityMode:Cluster' :: Maybe AZStatus
availabilityMode = Maybe AZStatus
a} :: Cluster)

-- | The cluster\'s configuration endpoint
cluster_clusterEndpoint :: Lens.Lens' Cluster (Prelude.Maybe Endpoint)
cluster_clusterEndpoint :: Lens' Cluster (Maybe Endpoint)
cluster_clusterEndpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Endpoint
clusterEndpoint :: Maybe Endpoint
$sel:clusterEndpoint:Cluster' :: Cluster -> Maybe Endpoint
clusterEndpoint} -> Maybe Endpoint
clusterEndpoint) (\s :: Cluster
s@Cluster' {} Maybe Endpoint
a -> Cluster
s {$sel:clusterEndpoint:Cluster' :: Maybe Endpoint
clusterEndpoint = Maybe Endpoint
a} :: Cluster)

-- | Enables data tiering. Data tiering is only supported for clusters using
-- the r6gd node type. This parameter must be set when using r6gd nodes.
-- For more information, see
-- <https://docs.aws.amazon.com/memorydb/latest/devguide/data-tiering.html Data tiering>.
cluster_dataTiering :: Lens.Lens' Cluster (Prelude.Maybe DataTieringStatus)
cluster_dataTiering :: Lens' Cluster (Maybe DataTieringStatus)
cluster_dataTiering = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe DataTieringStatus
dataTiering :: Maybe DataTieringStatus
$sel:dataTiering:Cluster' :: Cluster -> Maybe DataTieringStatus
dataTiering} -> Maybe DataTieringStatus
dataTiering) (\s :: Cluster
s@Cluster' {} Maybe DataTieringStatus
a -> Cluster
s {$sel:dataTiering:Cluster' :: Maybe DataTieringStatus
dataTiering = Maybe DataTieringStatus
a} :: Cluster)

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

-- | The Redis engine patch version used by the cluster
cluster_enginePatchVersion :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_enginePatchVersion :: Lens' Cluster (Maybe Text)
cluster_enginePatchVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
enginePatchVersion :: Maybe Text
$sel:enginePatchVersion:Cluster' :: Cluster -> Maybe Text
enginePatchVersion} -> Maybe Text
enginePatchVersion) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:enginePatchVersion:Cluster' :: Maybe Text
enginePatchVersion = Maybe Text
a} :: Cluster)

-- | The Redis engine version used by the cluster
cluster_engineVersion :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_engineVersion :: Lens' Cluster (Maybe Text)
cluster_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:Cluster' :: Cluster -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:engineVersion:Cluster' :: Maybe Text
engineVersion = Maybe Text
a} :: Cluster)

-- | The ID of the KMS key used to encrypt the cluster
cluster_kmsKeyId :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_kmsKeyId :: Lens' Cluster (Maybe Text)
cluster_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:Cluster' :: Cluster -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:kmsKeyId:Cluster' :: Maybe Text
kmsKeyId = Maybe Text
a} :: Cluster)

-- | Specifies the weekly time range during which maintenance on the 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.
cluster_maintenanceWindow :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_maintenanceWindow :: Lens' Cluster (Maybe Text)
cluster_maintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
maintenanceWindow :: Maybe Text
$sel:maintenanceWindow:Cluster' :: Cluster -> Maybe Text
maintenanceWindow} -> Maybe Text
maintenanceWindow) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:maintenanceWindow:Cluster' :: Maybe Text
maintenanceWindow = Maybe Text
a} :: Cluster)

-- | The user-supplied name of the cluster. This identifier is a unique key
-- that identifies a cluster.
cluster_name :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_name :: Lens' Cluster (Maybe Text)
cluster_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
name :: Maybe Text
$sel:name:Cluster' :: Cluster -> Maybe Text
name} -> Maybe Text
name) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:name:Cluster' :: Maybe Text
name = Maybe Text
a} :: Cluster)

-- | The cluster\'s node type
cluster_nodeType :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_nodeType :: Lens' Cluster (Maybe Text)
cluster_nodeType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
nodeType :: Maybe Text
$sel:nodeType:Cluster' :: Cluster -> Maybe Text
nodeType} -> Maybe Text
nodeType) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:nodeType:Cluster' :: Maybe Text
nodeType = Maybe Text
a} :: Cluster)

-- | The number of shards in the cluster
cluster_numberOfShards :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Int)
cluster_numberOfShards :: Lens' Cluster (Maybe Int)
cluster_numberOfShards = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Int
numberOfShards :: Maybe Int
$sel:numberOfShards:Cluster' :: Cluster -> Maybe Int
numberOfShards} -> Maybe Int
numberOfShards) (\s :: Cluster
s@Cluster' {} Maybe Int
a -> Cluster
s {$sel:numberOfShards:Cluster' :: Maybe Int
numberOfShards = Maybe Int
a} :: Cluster)

-- | The name of the parameter group used by the cluster
cluster_parameterGroupName :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_parameterGroupName :: Lens' Cluster (Maybe Text)
cluster_parameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
parameterGroupName :: Maybe Text
$sel:parameterGroupName:Cluster' :: Cluster -> Maybe Text
parameterGroupName} -> Maybe Text
parameterGroupName) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:parameterGroupName:Cluster' :: Maybe Text
parameterGroupName = Maybe Text
a} :: Cluster)

-- | The status of the parameter group used by the cluster, for example
-- \'active\' or \'applying\'.
cluster_parameterGroupStatus :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_parameterGroupStatus :: Lens' Cluster (Maybe Text)
cluster_parameterGroupStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
parameterGroupStatus :: Maybe Text
$sel:parameterGroupStatus:Cluster' :: Cluster -> Maybe Text
parameterGroupStatus} -> Maybe Text
parameterGroupStatus) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:parameterGroupStatus:Cluster' :: Maybe Text
parameterGroupStatus = Maybe Text
a} :: Cluster)

-- | A group of settings that are currently being applied.
cluster_pendingUpdates :: Lens.Lens' Cluster (Prelude.Maybe ClusterPendingUpdates)
cluster_pendingUpdates :: Lens' Cluster (Maybe ClusterPendingUpdates)
cluster_pendingUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe ClusterPendingUpdates
pendingUpdates :: Maybe ClusterPendingUpdates
$sel:pendingUpdates:Cluster' :: Cluster -> Maybe ClusterPendingUpdates
pendingUpdates} -> Maybe ClusterPendingUpdates
pendingUpdates) (\s :: Cluster
s@Cluster' {} Maybe ClusterPendingUpdates
a -> Cluster
s {$sel:pendingUpdates:Cluster' :: Maybe ClusterPendingUpdates
pendingUpdates = Maybe ClusterPendingUpdates
a} :: Cluster)

-- | A list of security groups used by the cluster
cluster_securityGroups :: Lens.Lens' Cluster (Prelude.Maybe [SecurityGroupMembership])
cluster_securityGroups :: Lens' Cluster (Maybe [SecurityGroupMembership])
cluster_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe [SecurityGroupMembership]
securityGroups :: Maybe [SecurityGroupMembership]
$sel:securityGroups:Cluster' :: Cluster -> Maybe [SecurityGroupMembership]
securityGroups} -> Maybe [SecurityGroupMembership]
securityGroups) (\s :: Cluster
s@Cluster' {} Maybe [SecurityGroupMembership]
a -> Cluster
s {$sel:securityGroups:Cluster' :: Maybe [SecurityGroupMembership]
securityGroups = Maybe [SecurityGroupMembership]
a} :: Cluster) 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

-- | A list of shards that are members of the cluster.
cluster_shards :: Lens.Lens' Cluster (Prelude.Maybe [Shard])
cluster_shards :: Lens' Cluster (Maybe [Shard])
cluster_shards = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe [Shard]
shards :: Maybe [Shard]
$sel:shards:Cluster' :: Cluster -> Maybe [Shard]
shards} -> Maybe [Shard]
shards) (\s :: Cluster
s@Cluster' {} Maybe [Shard]
a -> Cluster
s {$sel:shards:Cluster' :: Maybe [Shard]
shards = Maybe [Shard]
a} :: Cluster) 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 number of days for which MemoryDB retains automatic snapshots before
-- deleting them. For example, if you set SnapshotRetentionLimit to 5, a
-- snapshot that was taken today is retained for 5 days before being
-- deleted.
cluster_snapshotRetentionLimit :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Int)
cluster_snapshotRetentionLimit :: Lens' Cluster (Maybe Int)
cluster_snapshotRetentionLimit = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Int
snapshotRetentionLimit :: Maybe Int
$sel:snapshotRetentionLimit:Cluster' :: Cluster -> Maybe Int
snapshotRetentionLimit} -> Maybe Int
snapshotRetentionLimit) (\s :: Cluster
s@Cluster' {} Maybe Int
a -> Cluster
s {$sel:snapshotRetentionLimit:Cluster' :: Maybe Int
snapshotRetentionLimit = Maybe Int
a} :: Cluster)

-- | The daily time range (in UTC) during which MemoryDB begins taking a
-- daily snapshot of your shard. Example: 05:00-09:00 If you do not specify
-- this parameter, MemoryDB automatically chooses an appropriate time
-- range.
cluster_snapshotWindow :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_snapshotWindow :: Lens' Cluster (Maybe Text)
cluster_snapshotWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
snapshotWindow :: Maybe Text
$sel:snapshotWindow:Cluster' :: Cluster -> Maybe Text
snapshotWindow} -> Maybe Text
snapshotWindow) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:snapshotWindow:Cluster' :: Maybe Text
snapshotWindow = Maybe Text
a} :: Cluster)

-- | The Amazon Resource Name (ARN) of the SNS notification topic
cluster_snsTopicArn :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_snsTopicArn :: Lens' Cluster (Maybe Text)
cluster_snsTopicArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
snsTopicArn :: Maybe Text
$sel:snsTopicArn:Cluster' :: Cluster -> Maybe Text
snsTopicArn} -> Maybe Text
snsTopicArn) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:snsTopicArn:Cluster' :: Maybe Text
snsTopicArn = Maybe Text
a} :: Cluster)

-- | The SNS topic must be in Active status to receive notifications
cluster_snsTopicStatus :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_snsTopicStatus :: Lens' Cluster (Maybe Text)
cluster_snsTopicStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
snsTopicStatus :: Maybe Text
$sel:snsTopicStatus:Cluster' :: Cluster -> Maybe Text
snsTopicStatus} -> Maybe Text
snsTopicStatus) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:snsTopicStatus:Cluster' :: Maybe Text
snsTopicStatus = Maybe Text
a} :: Cluster)

-- | The status of the cluster. For example, Available, Updating, Creating.
cluster_status :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_status :: Lens' Cluster (Maybe Text)
cluster_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
status :: Maybe Text
$sel:status:Cluster' :: Cluster -> Maybe Text
status} -> Maybe Text
status) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:status:Cluster' :: Maybe Text
status = Maybe Text
a} :: Cluster)

-- | The name of the subnet group used by the cluster
cluster_subnetGroupName :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_subnetGroupName :: Lens' Cluster (Maybe Text)
cluster_subnetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
subnetGroupName :: Maybe Text
$sel:subnetGroupName:Cluster' :: Cluster -> Maybe Text
subnetGroupName} -> Maybe Text
subnetGroupName) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:subnetGroupName:Cluster' :: Maybe Text
subnetGroupName = Maybe Text
a} :: Cluster)

-- | A flag to indicate if In-transit encryption is enabled
cluster_tLSEnabled :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Bool)
cluster_tLSEnabled :: Lens' Cluster (Maybe Bool)
cluster_tLSEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Bool
tLSEnabled :: Maybe Bool
$sel:tLSEnabled:Cluster' :: Cluster -> Maybe Bool
tLSEnabled} -> Maybe Bool
tLSEnabled) (\s :: Cluster
s@Cluster' {} Maybe Bool
a -> Cluster
s {$sel:tLSEnabled:Cluster' :: Maybe Bool
tLSEnabled = Maybe Bool
a} :: Cluster)

instance Data.FromJSON Cluster where
  parseJSON :: Value -> Parser Cluster
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Cluster"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe AZStatus
-> Maybe Endpoint
-> Maybe DataTieringStatus
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe ClusterPendingUpdates
-> Maybe [SecurityGroupMembership]
-> Maybe [Shard]
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Cluster
Cluster'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ACLName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ARN")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AutoMinorVersionUpgrade")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AvailabilityMode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ClusterEndpoint")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DataTiering")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EnginePatchVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EngineVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"KmsKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"MaintenanceWindow")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"NodeType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"NumberOfShards")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ParameterGroupName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ParameterGroupStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"PendingUpdates")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SecurityGroups" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Shards" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SnapshotRetentionLimit")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SnapshotWindow")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SnsTopicArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SnsTopicStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SubnetGroupName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"TLSEnabled")
      )

instance Prelude.Hashable Cluster where
  hashWithSalt :: Int -> Cluster -> Int
hashWithSalt Int
_salt Cluster' {Maybe Bool
Maybe Int
Maybe [SecurityGroupMembership]
Maybe [Shard]
Maybe Text
Maybe AZStatus
Maybe DataTieringStatus
Maybe Endpoint
Maybe ClusterPendingUpdates
tLSEnabled :: Maybe Bool
subnetGroupName :: Maybe Text
status :: Maybe Text
snsTopicStatus :: Maybe Text
snsTopicArn :: Maybe Text
snapshotWindow :: Maybe Text
snapshotRetentionLimit :: Maybe Int
shards :: Maybe [Shard]
securityGroups :: Maybe [SecurityGroupMembership]
pendingUpdates :: Maybe ClusterPendingUpdates
parameterGroupStatus :: Maybe Text
parameterGroupName :: Maybe Text
numberOfShards :: Maybe Int
nodeType :: Maybe Text
name :: Maybe Text
maintenanceWindow :: Maybe Text
kmsKeyId :: Maybe Text
engineVersion :: Maybe Text
enginePatchVersion :: Maybe Text
description :: Maybe Text
dataTiering :: Maybe DataTieringStatus
clusterEndpoint :: Maybe Endpoint
availabilityMode :: Maybe AZStatus
autoMinorVersionUpgrade :: Maybe Bool
arn :: Maybe Text
aCLName :: Maybe Text
$sel:tLSEnabled:Cluster' :: Cluster -> Maybe Bool
$sel:subnetGroupName:Cluster' :: Cluster -> Maybe Text
$sel:status:Cluster' :: Cluster -> Maybe Text
$sel:snsTopicStatus:Cluster' :: Cluster -> Maybe Text
$sel:snsTopicArn:Cluster' :: Cluster -> Maybe Text
$sel:snapshotWindow:Cluster' :: Cluster -> Maybe Text
$sel:snapshotRetentionLimit:Cluster' :: Cluster -> Maybe Int
$sel:shards:Cluster' :: Cluster -> Maybe [Shard]
$sel:securityGroups:Cluster' :: Cluster -> Maybe [SecurityGroupMembership]
$sel:pendingUpdates:Cluster' :: Cluster -> Maybe ClusterPendingUpdates
$sel:parameterGroupStatus:Cluster' :: Cluster -> Maybe Text
$sel:parameterGroupName:Cluster' :: Cluster -> Maybe Text
$sel:numberOfShards:Cluster' :: Cluster -> Maybe Int
$sel:nodeType:Cluster' :: Cluster -> Maybe Text
$sel:name:Cluster' :: Cluster -> Maybe Text
$sel:maintenanceWindow:Cluster' :: Cluster -> Maybe Text
$sel:kmsKeyId:Cluster' :: Cluster -> Maybe Text
$sel:engineVersion:Cluster' :: Cluster -> Maybe Text
$sel:enginePatchVersion:Cluster' :: Cluster -> Maybe Text
$sel:description:Cluster' :: Cluster -> Maybe Text
$sel:dataTiering:Cluster' :: Cluster -> Maybe DataTieringStatus
$sel:clusterEndpoint:Cluster' :: Cluster -> Maybe Endpoint
$sel:availabilityMode:Cluster' :: Cluster -> Maybe AZStatus
$sel:autoMinorVersionUpgrade:Cluster' :: Cluster -> Maybe Bool
$sel:arn:Cluster' :: Cluster -> Maybe Text
$sel:aCLName:Cluster' :: Cluster -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
aCLName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoMinorVersionUpgrade
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AZStatus
availabilityMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Endpoint
clusterEndpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataTieringStatus
dataTiering
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
enginePatchVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nodeType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
numberOfShards
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parameterGroupStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterPendingUpdates
pendingUpdates
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SecurityGroupMembership]
securityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Shard]
shards
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
snapshotRetentionLimit
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snsTopicArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snsTopicStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subnetGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
tLSEnabled

instance Prelude.NFData Cluster where
  rnf :: Cluster -> ()
rnf Cluster' {Maybe Bool
Maybe Int
Maybe [SecurityGroupMembership]
Maybe [Shard]
Maybe Text
Maybe AZStatus
Maybe DataTieringStatus
Maybe Endpoint
Maybe ClusterPendingUpdates
tLSEnabled :: Maybe Bool
subnetGroupName :: Maybe Text
status :: Maybe Text
snsTopicStatus :: Maybe Text
snsTopicArn :: Maybe Text
snapshotWindow :: Maybe Text
snapshotRetentionLimit :: Maybe Int
shards :: Maybe [Shard]
securityGroups :: Maybe [SecurityGroupMembership]
pendingUpdates :: Maybe ClusterPendingUpdates
parameterGroupStatus :: Maybe Text
parameterGroupName :: Maybe Text
numberOfShards :: Maybe Int
nodeType :: Maybe Text
name :: Maybe Text
maintenanceWindow :: Maybe Text
kmsKeyId :: Maybe Text
engineVersion :: Maybe Text
enginePatchVersion :: Maybe Text
description :: Maybe Text
dataTiering :: Maybe DataTieringStatus
clusterEndpoint :: Maybe Endpoint
availabilityMode :: Maybe AZStatus
autoMinorVersionUpgrade :: Maybe Bool
arn :: Maybe Text
aCLName :: Maybe Text
$sel:tLSEnabled:Cluster' :: Cluster -> Maybe Bool
$sel:subnetGroupName:Cluster' :: Cluster -> Maybe Text
$sel:status:Cluster' :: Cluster -> Maybe Text
$sel:snsTopicStatus:Cluster' :: Cluster -> Maybe Text
$sel:snsTopicArn:Cluster' :: Cluster -> Maybe Text
$sel:snapshotWindow:Cluster' :: Cluster -> Maybe Text
$sel:snapshotRetentionLimit:Cluster' :: Cluster -> Maybe Int
$sel:shards:Cluster' :: Cluster -> Maybe [Shard]
$sel:securityGroups:Cluster' :: Cluster -> Maybe [SecurityGroupMembership]
$sel:pendingUpdates:Cluster' :: Cluster -> Maybe ClusterPendingUpdates
$sel:parameterGroupStatus:Cluster' :: Cluster -> Maybe Text
$sel:parameterGroupName:Cluster' :: Cluster -> Maybe Text
$sel:numberOfShards:Cluster' :: Cluster -> Maybe Int
$sel:nodeType:Cluster' :: Cluster -> Maybe Text
$sel:name:Cluster' :: Cluster -> Maybe Text
$sel:maintenanceWindow:Cluster' :: Cluster -> Maybe Text
$sel:kmsKeyId:Cluster' :: Cluster -> Maybe Text
$sel:engineVersion:Cluster' :: Cluster -> Maybe Text
$sel:enginePatchVersion:Cluster' :: Cluster -> Maybe Text
$sel:description:Cluster' :: Cluster -> Maybe Text
$sel:dataTiering:Cluster' :: Cluster -> Maybe DataTieringStatus
$sel:clusterEndpoint:Cluster' :: Cluster -> Maybe Endpoint
$sel:availabilityMode:Cluster' :: Cluster -> Maybe AZStatus
$sel:autoMinorVersionUpgrade:Cluster' :: Cluster -> Maybe Bool
$sel:arn:Cluster' :: Cluster -> Maybe Text
$sel:aCLName:Cluster' :: Cluster -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
aCLName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoMinorVersionUpgrade
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AZStatus
availabilityMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Endpoint
clusterEndpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DataTieringStatus
dataTiering
      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
enginePatchVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nodeType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
numberOfShards
      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
parameterGroupStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ClusterPendingUpdates
pendingUpdates
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SecurityGroupMembership]
securityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Shard]
shards
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Int
snapshotRetentionLimit
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snsTopicArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
snsTopicStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      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 Bool
tLSEnabled