{-# 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.Kafka.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.Kafka.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.Kafka.Types.ClusterState
import Amazonka.Kafka.Types.ClusterType
import Amazonka.Kafka.Types.Provisioned
import Amazonka.Kafka.Types.Serverless
import Amazonka.Kafka.Types.StateInfo
import qualified Amazonka.Prelude as Prelude

-- | Returns information about a cluster.
--
-- /See:/ 'newCluster' smart constructor.
data Cluster = Cluster'
  { -- | The Amazon Resource Name (ARN) that uniquely identifies a cluster
    -- operation.
    Cluster -> Maybe Text
activeOperationArn :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) that uniquely identifies the cluster.
    Cluster -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the cluster.
    Cluster -> Maybe Text
clusterName :: Prelude.Maybe Prelude.Text,
    -- | Cluster Type.
    Cluster -> Maybe ClusterType
clusterType :: Prelude.Maybe ClusterType,
    -- | The time when the cluster was created.
    Cluster -> Maybe ISO8601
creationTime :: Prelude.Maybe Data.ISO8601,
    -- | The current version of the MSK cluster.
    Cluster -> Maybe Text
currentVersion :: Prelude.Maybe Prelude.Text,
    -- | Information about the provisioned cluster.
    Cluster -> Maybe Provisioned
provisioned :: Prelude.Maybe Provisioned,
    -- | Information about the serverless cluster.
    Cluster -> Maybe Serverless
serverless :: Prelude.Maybe Serverless,
    -- | The state of the cluster. The possible states are ACTIVE, CREATING,
    -- DELETING, FAILED, HEALING, MAINTENANCE, REBOOTING_BROKER, and UPDATING.
    Cluster -> Maybe ClusterState
state :: Prelude.Maybe ClusterState,
    -- | State Info for the Amazon MSK cluster.
    Cluster -> Maybe StateInfo
stateInfo :: Prelude.Maybe StateInfo,
    -- | Tags attached to the cluster.
    Cluster -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text)
  }
  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:
--
-- 'activeOperationArn', 'cluster_activeOperationArn' - The Amazon Resource Name (ARN) that uniquely identifies a cluster
-- operation.
--
-- 'clusterArn', 'cluster_clusterArn' - The Amazon Resource Name (ARN) that uniquely identifies the cluster.
--
-- 'clusterName', 'cluster_clusterName' - The name of the cluster.
--
-- 'clusterType', 'cluster_clusterType' - Cluster Type.
--
-- 'creationTime', 'cluster_creationTime' - The time when the cluster was created.
--
-- 'currentVersion', 'cluster_currentVersion' - The current version of the MSK cluster.
--
-- 'provisioned', 'cluster_provisioned' - Information about the provisioned cluster.
--
-- 'serverless', 'cluster_serverless' - Information about the serverless cluster.
--
-- 'state', 'cluster_state' - The state of the cluster. The possible states are ACTIVE, CREATING,
-- DELETING, FAILED, HEALING, MAINTENANCE, REBOOTING_BROKER, and UPDATING.
--
-- 'stateInfo', 'cluster_stateInfo' - State Info for the Amazon MSK cluster.
--
-- 'tags', 'cluster_tags' - Tags attached to the cluster.
newCluster ::
  Cluster
newCluster :: Cluster
newCluster =
  Cluster'
    { $sel:activeOperationArn:Cluster' :: Maybe Text
activeOperationArn = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterArn:Cluster' :: Maybe Text
clusterArn = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterName:Cluster' :: Maybe Text
clusterName = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterType:Cluster' :: Maybe ClusterType
clusterType = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:Cluster' :: Maybe ISO8601
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:currentVersion:Cluster' :: Maybe Text
currentVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:provisioned:Cluster' :: Maybe Provisioned
provisioned = forall a. Maybe a
Prelude.Nothing,
      $sel:serverless:Cluster' :: Maybe Serverless
serverless = forall a. Maybe a
Prelude.Nothing,
      $sel:state:Cluster' :: Maybe ClusterState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:stateInfo:Cluster' :: Maybe StateInfo
stateInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Cluster' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) that uniquely identifies a cluster
-- operation.
cluster_activeOperationArn :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_activeOperationArn :: Lens' Cluster (Maybe Text)
cluster_activeOperationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
activeOperationArn :: Maybe Text
$sel:activeOperationArn:Cluster' :: Cluster -> Maybe Text
activeOperationArn} -> Maybe Text
activeOperationArn) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:activeOperationArn:Cluster' :: Maybe Text
activeOperationArn = Maybe Text
a} :: Cluster)

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

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

-- | Cluster Type.
cluster_clusterType :: Lens.Lens' Cluster (Prelude.Maybe ClusterType)
cluster_clusterType :: Lens' Cluster (Maybe ClusterType)
cluster_clusterType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe ClusterType
clusterType :: Maybe ClusterType
$sel:clusterType:Cluster' :: Cluster -> Maybe ClusterType
clusterType} -> Maybe ClusterType
clusterType) (\s :: Cluster
s@Cluster' {} Maybe ClusterType
a -> Cluster
s {$sel:clusterType:Cluster' :: Maybe ClusterType
clusterType = Maybe ClusterType
a} :: Cluster)

-- | The time when the cluster was created.
cluster_creationTime :: Lens.Lens' Cluster (Prelude.Maybe Prelude.UTCTime)
cluster_creationTime :: Lens' Cluster (Maybe UTCTime)
cluster_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe ISO8601
creationTime :: Maybe ISO8601
$sel:creationTime:Cluster' :: Cluster -> Maybe ISO8601
creationTime} -> Maybe ISO8601
creationTime) (\s :: Cluster
s@Cluster' {} Maybe ISO8601
a -> Cluster
s {$sel:creationTime:Cluster' :: Maybe ISO8601
creationTime = Maybe ISO8601
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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The current version of the MSK cluster.
cluster_currentVersion :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_currentVersion :: Lens' Cluster (Maybe Text)
cluster_currentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
currentVersion :: Maybe Text
$sel:currentVersion:Cluster' :: Cluster -> Maybe Text
currentVersion} -> Maybe Text
currentVersion) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:currentVersion:Cluster' :: Maybe Text
currentVersion = Maybe Text
a} :: Cluster)

-- | Information about the provisioned cluster.
cluster_provisioned :: Lens.Lens' Cluster (Prelude.Maybe Provisioned)
cluster_provisioned :: Lens' Cluster (Maybe Provisioned)
cluster_provisioned = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Provisioned
provisioned :: Maybe Provisioned
$sel:provisioned:Cluster' :: Cluster -> Maybe Provisioned
provisioned} -> Maybe Provisioned
provisioned) (\s :: Cluster
s@Cluster' {} Maybe Provisioned
a -> Cluster
s {$sel:provisioned:Cluster' :: Maybe Provisioned
provisioned = Maybe Provisioned
a} :: Cluster)

-- | Information about the serverless cluster.
cluster_serverless :: Lens.Lens' Cluster (Prelude.Maybe Serverless)
cluster_serverless :: Lens' Cluster (Maybe Serverless)
cluster_serverless = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Serverless
serverless :: Maybe Serverless
$sel:serverless:Cluster' :: Cluster -> Maybe Serverless
serverless} -> Maybe Serverless
serverless) (\s :: Cluster
s@Cluster' {} Maybe Serverless
a -> Cluster
s {$sel:serverless:Cluster' :: Maybe Serverless
serverless = Maybe Serverless
a} :: Cluster)

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

-- | State Info for the Amazon MSK cluster.
cluster_stateInfo :: Lens.Lens' Cluster (Prelude.Maybe StateInfo)
cluster_stateInfo :: Lens' Cluster (Maybe StateInfo)
cluster_stateInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe StateInfo
stateInfo :: Maybe StateInfo
$sel:stateInfo:Cluster' :: Cluster -> Maybe StateInfo
stateInfo} -> Maybe StateInfo
stateInfo) (\s :: Cluster
s@Cluster' {} Maybe StateInfo
a -> Cluster
s {$sel:stateInfo:Cluster' :: Maybe StateInfo
stateInfo = Maybe StateInfo
a} :: Cluster)

-- | Tags attached to the cluster.
cluster_tags :: Lens.Lens' Cluster (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
cluster_tags :: Lens' Cluster (Maybe (HashMap Text Text))
cluster_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:Cluster' :: Cluster -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: Cluster
s@Cluster' {} Maybe (HashMap Text Text)
a -> Cluster
s {$sel:tags:Cluster' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
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

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 Text
-> Maybe ClusterType
-> Maybe ISO8601
-> Maybe Text
-> Maybe Provisioned
-> Maybe Serverless
-> Maybe ClusterState
-> Maybe StateInfo
-> Maybe (HashMap Text Text)
-> 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
"activeOperationArn")
            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
"clusterArn")
            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
"clusterName")
            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
"clusterType")
            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
"creationTime")
            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
"currentVersion")
            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
"provisioned")
            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
"serverless")
            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
"state")
            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
"stateInfo")
            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
"tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable Cluster where
  hashWithSalt :: Int -> Cluster -> Int
hashWithSalt Int
_salt Cluster' {Maybe Text
Maybe (HashMap Text Text)
Maybe ISO8601
Maybe ClusterState
Maybe ClusterType
Maybe StateInfo
Maybe Provisioned
Maybe Serverless
tags :: Maybe (HashMap Text Text)
stateInfo :: Maybe StateInfo
state :: Maybe ClusterState
serverless :: Maybe Serverless
provisioned :: Maybe Provisioned
currentVersion :: Maybe Text
creationTime :: Maybe ISO8601
clusterType :: Maybe ClusterType
clusterName :: Maybe Text
clusterArn :: Maybe Text
activeOperationArn :: Maybe Text
$sel:tags:Cluster' :: Cluster -> Maybe (HashMap Text Text)
$sel:stateInfo:Cluster' :: Cluster -> Maybe StateInfo
$sel:state:Cluster' :: Cluster -> Maybe ClusterState
$sel:serverless:Cluster' :: Cluster -> Maybe Serverless
$sel:provisioned:Cluster' :: Cluster -> Maybe Provisioned
$sel:currentVersion:Cluster' :: Cluster -> Maybe Text
$sel:creationTime:Cluster' :: Cluster -> Maybe ISO8601
$sel:clusterType:Cluster' :: Cluster -> Maybe ClusterType
$sel:clusterName:Cluster' :: Cluster -> Maybe Text
$sel:clusterArn:Cluster' :: Cluster -> Maybe Text
$sel:activeOperationArn:Cluster' :: Cluster -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
activeOperationArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterType
clusterType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
creationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
currentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Provisioned
provisioned
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Serverless
serverless
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ClusterState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StateInfo
stateInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags

instance Prelude.NFData Cluster where
  rnf :: Cluster -> ()
rnf Cluster' {Maybe Text
Maybe (HashMap Text Text)
Maybe ISO8601
Maybe ClusterState
Maybe ClusterType
Maybe StateInfo
Maybe Provisioned
Maybe Serverless
tags :: Maybe (HashMap Text Text)
stateInfo :: Maybe StateInfo
state :: Maybe ClusterState
serverless :: Maybe Serverless
provisioned :: Maybe Provisioned
currentVersion :: Maybe Text
creationTime :: Maybe ISO8601
clusterType :: Maybe ClusterType
clusterName :: Maybe Text
clusterArn :: Maybe Text
activeOperationArn :: Maybe Text
$sel:tags:Cluster' :: Cluster -> Maybe (HashMap Text Text)
$sel:stateInfo:Cluster' :: Cluster -> Maybe StateInfo
$sel:state:Cluster' :: Cluster -> Maybe ClusterState
$sel:serverless:Cluster' :: Cluster -> Maybe Serverless
$sel:provisioned:Cluster' :: Cluster -> Maybe Provisioned
$sel:currentVersion:Cluster' :: Cluster -> Maybe Text
$sel:creationTime:Cluster' :: Cluster -> Maybe ISO8601
$sel:clusterType:Cluster' :: Cluster -> Maybe ClusterType
$sel:clusterName:Cluster' :: Cluster -> Maybe Text
$sel:clusterArn:Cluster' :: Cluster -> Maybe Text
$sel:activeOperationArn:Cluster' :: Cluster -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
activeOperationArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 ClusterType
clusterType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
currentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Provisioned
provisioned
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Serverless
serverless
      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 Maybe StateInfo
stateInfo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags