{-# 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.EMR.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.EMR.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.EMR.Types.Application
import Amazonka.EMR.Types.ClusterStatus
import Amazonka.EMR.Types.Configuration
import Amazonka.EMR.Types.Ec2InstanceAttributes
import Amazonka.EMR.Types.InstanceCollectionType
import Amazonka.EMR.Types.KerberosAttributes
import Amazonka.EMR.Types.PlacementGroupConfig
import Amazonka.EMR.Types.RepoUpgradeOnBoot
import Amazonka.EMR.Types.ScaleDownBehavior
import Amazonka.EMR.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | The detailed description of the cluster.
--
-- /See:/ 'newCluster' smart constructor.
data Cluster = Cluster'
  { -- | The applications installed on this cluster.
    Cluster -> Maybe [Application]
applications :: Prelude.Maybe [Application],
    -- | An IAM role for automatic scaling policies. The default role is
    -- @EMR_AutoScaling_DefaultRole@. The IAM role provides permissions that
    -- the automatic scaling feature requires to launch and terminate EC2
    -- instances in an instance group.
    Cluster -> Maybe Text
autoScalingRole :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether the cluster should terminate after completing all
    -- steps.
    Cluster -> Maybe Bool
autoTerminate :: Prelude.Maybe Prelude.Bool,
    -- | The Amazon Resource Name of the cluster.
    Cluster -> Maybe Text
clusterArn :: Prelude.Maybe Prelude.Text,
    -- | Applies only to Amazon EMR releases 4.x and later. The list of
    -- Configurations supplied to the EMR cluster.
    Cluster -> Maybe [Configuration]
configurations :: Prelude.Maybe [Configuration],
    -- | Available only in Amazon EMR version 5.7.0 and later. The ID of a custom
    -- Amazon EBS-backed Linux AMI if the cluster uses a custom AMI.
    Cluster -> Maybe Text
customAmiId :: Prelude.Maybe Prelude.Text,
    -- | The size, in GiB, of the Amazon EBS root device volume of the Linux AMI
    -- that is used for each EC2 instance. Available in Amazon EMR version 4.x
    -- and later.
    Cluster -> Maybe Int
ebsRootVolumeSize :: Prelude.Maybe Prelude.Int,
    -- | Provides information about the EC2 instances in a cluster grouped by
    -- category. For example, key name, subnet ID, IAM instance profile, and so
    -- on.
    Cluster -> Maybe Ec2InstanceAttributes
ec2InstanceAttributes :: Prelude.Maybe Ec2InstanceAttributes,
    -- | The instance fleet configuration is available only in Amazon EMR
    -- versions 4.8.0 and later, excluding 5.0.x versions.
    --
    -- The instance group configuration of the cluster. A value of
    -- @INSTANCE_GROUP@ indicates a uniform instance group configuration. A
    -- value of @INSTANCE_FLEET@ indicates an instance fleets configuration.
    Cluster -> Maybe InstanceCollectionType
instanceCollectionType :: Prelude.Maybe InstanceCollectionType,
    -- | Attributes for Kerberos configuration when Kerberos authentication is
    -- enabled using a security configuration. For more information see
    -- <https://docs.aws.amazon.com/emr/latest/ManagementGuide/emr-kerberos.html Use Kerberos Authentication>
    -- in the /Amazon EMR Management Guide/.
    Cluster -> Maybe KerberosAttributes
kerberosAttributes :: Prelude.Maybe KerberosAttributes,
    -- | The KMS key used for encrypting log files. This attribute is only
    -- available with EMR version 5.30.0 and later, excluding EMR 6.0.0.
    Cluster -> Maybe Text
logEncryptionKmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The path to the Amazon S3 location where logs for this cluster are
    -- stored.
    Cluster -> Maybe Text
logUri :: Prelude.Maybe Prelude.Text,
    -- | The DNS name of the master node. If the cluster is on a private subnet,
    -- this is the private DNS name. On a public subnet, this is the public DNS
    -- name.
    Cluster -> Maybe Text
masterPublicDnsName :: Prelude.Maybe Prelude.Text,
    -- | An approximation of the cost of the cluster, represented in
    -- m1.small\/hours. This value is incremented one time for every hour an
    -- m1.small instance runs. Larger instances are weighted more, so an EC2
    -- instance that is roughly four times more expensive would result in the
    -- normalized instance hours being incremented by four. This result is only
    -- an approximation and does not reflect the actual billing rate.
    Cluster -> Maybe Int
normalizedInstanceHours :: Prelude.Maybe Prelude.Int,
    -- | The Amazon Linux release specified in a cluster launch RunJobFlow
    -- request. If no Amazon Linux release was specified, the default Amazon
    -- Linux release is shown in the response.
    Cluster -> Maybe Text
oSReleaseLabel :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the Outpost where the cluster is
    -- launched.
    Cluster -> Maybe Text
outpostArn :: Prelude.Maybe Prelude.Text,
    -- | Placement group configured for an Amazon EMR cluster.
    Cluster -> Maybe [PlacementGroupConfig]
placementGroups :: Prelude.Maybe [PlacementGroupConfig],
    -- | The Amazon EMR release label, which determines the version of
    -- open-source application packages installed on the cluster. Release
    -- labels are in the form @emr-x.x.x@, where x.x.x is an Amazon EMR release
    -- version such as @emr-5.14.0@. For more information about Amazon EMR
    -- release versions and included application versions and features, see
    -- <https://docs.aws.amazon.com/emr/latest/ReleaseGuide/>. The release
    -- label applies only to Amazon EMR releases version 4.0 and later. Earlier
    -- versions use @AmiVersion@.
    Cluster -> Maybe Text
releaseLabel :: Prelude.Maybe Prelude.Text,
    -- | Applies only when @CustomAmiID@ is used. Specifies the type of updates
    -- that are applied from the Amazon Linux AMI package repositories when an
    -- instance boots using the AMI.
    Cluster -> Maybe RepoUpgradeOnBoot
repoUpgradeOnBoot :: Prelude.Maybe RepoUpgradeOnBoot,
    -- | The AMI version requested for this cluster.
    Cluster -> Maybe Text
requestedAmiVersion :: Prelude.Maybe Prelude.Text,
    -- | The AMI version running on this cluster.
    Cluster -> Maybe Text
runningAmiVersion :: Prelude.Maybe Prelude.Text,
    -- | The way that individual Amazon EC2 instances terminate when an automatic
    -- scale-in activity occurs or an instance group is resized.
    -- @TERMINATE_AT_INSTANCE_HOUR@ indicates that Amazon EMR terminates nodes
    -- at the instance-hour boundary, regardless of when the request to
    -- terminate the instance was submitted. This option is only available with
    -- Amazon EMR 5.1.0 and later and is the default for clusters created using
    -- that version. @TERMINATE_AT_TASK_COMPLETION@ indicates that Amazon EMR
    -- adds nodes to a deny list and drains tasks from nodes before terminating
    -- the Amazon EC2 instances, regardless of the instance-hour boundary. With
    -- either behavior, Amazon EMR removes the least active nodes first and
    -- blocks instance termination if it could lead to HDFS corruption.
    -- @TERMINATE_AT_TASK_COMPLETION@ is available only in Amazon EMR version
    -- 4.1.0 and later, and is the default for versions of Amazon EMR earlier
    -- than 5.1.0.
    Cluster -> Maybe ScaleDownBehavior
scaleDownBehavior :: Prelude.Maybe ScaleDownBehavior,
    -- | The name of the security configuration applied to the cluster.
    Cluster -> Maybe Text
securityConfiguration :: Prelude.Maybe Prelude.Text,
    -- | The IAM role that Amazon EMR assumes in order to access Amazon Web
    -- Services resources on your behalf.
    Cluster -> Maybe Text
serviceRole :: Prelude.Maybe Prelude.Text,
    -- | Specifies the number of steps that can be executed concurrently.
    Cluster -> Maybe Int
stepConcurrencyLevel :: Prelude.Maybe Prelude.Int,
    -- | A list of tags associated with a cluster.
    Cluster -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | Indicates whether Amazon EMR will lock the cluster to prevent the EC2
    -- instances from being terminated by an API call or user intervention, or
    -- in the event of a cluster error.
    Cluster -> Maybe Bool
terminationProtected :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether the cluster is visible to IAM principals in the Amazon
    -- Web Services account associated with the cluster. When @true@, IAM
    -- principals in the Amazon Web Services account can perform EMR cluster
    -- actions on the cluster that their IAM policies allow. When @false@, only
    -- the IAM principal that created the cluster and the Amazon Web Services
    -- account root user can perform EMR actions, regardless of IAM permissions
    -- policies attached to other IAM principals.
    --
    -- The default value is @true@ if a value is not provided when creating a
    -- cluster using the EMR API RunJobFlow command, the CLI
    -- <https://docs.aws.amazon.com/cli/latest/reference/emr/create-cluster.html create-cluster>
    -- command, or the Amazon Web Services Management Console.
    Cluster -> Maybe Bool
visibleToAllUsers :: Prelude.Maybe Prelude.Bool,
    -- | The unique identifier for the cluster.
    Cluster -> Text
id :: Prelude.Text,
    -- | The name of the cluster.
    Cluster -> Text
name :: Prelude.Text,
    -- | The current status details about the cluster.
    Cluster -> ClusterStatus
status :: ClusterStatus
  }
  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:
--
-- 'applications', 'cluster_applications' - The applications installed on this cluster.
--
-- 'autoScalingRole', 'cluster_autoScalingRole' - An IAM role for automatic scaling policies. The default role is
-- @EMR_AutoScaling_DefaultRole@. The IAM role provides permissions that
-- the automatic scaling feature requires to launch and terminate EC2
-- instances in an instance group.
--
-- 'autoTerminate', 'cluster_autoTerminate' - Specifies whether the cluster should terminate after completing all
-- steps.
--
-- 'clusterArn', 'cluster_clusterArn' - The Amazon Resource Name of the cluster.
--
-- 'configurations', 'cluster_configurations' - Applies only to Amazon EMR releases 4.x and later. The list of
-- Configurations supplied to the EMR cluster.
--
-- 'customAmiId', 'cluster_customAmiId' - Available only in Amazon EMR version 5.7.0 and later. The ID of a custom
-- Amazon EBS-backed Linux AMI if the cluster uses a custom AMI.
--
-- 'ebsRootVolumeSize', 'cluster_ebsRootVolumeSize' - The size, in GiB, of the Amazon EBS root device volume of the Linux AMI
-- that is used for each EC2 instance. Available in Amazon EMR version 4.x
-- and later.
--
-- 'ec2InstanceAttributes', 'cluster_ec2InstanceAttributes' - Provides information about the EC2 instances in a cluster grouped by
-- category. For example, key name, subnet ID, IAM instance profile, and so
-- on.
--
-- 'instanceCollectionType', 'cluster_instanceCollectionType' - The instance fleet configuration is available only in Amazon EMR
-- versions 4.8.0 and later, excluding 5.0.x versions.
--
-- The instance group configuration of the cluster. A value of
-- @INSTANCE_GROUP@ indicates a uniform instance group configuration. A
-- value of @INSTANCE_FLEET@ indicates an instance fleets configuration.
--
-- 'kerberosAttributes', 'cluster_kerberosAttributes' - Attributes for Kerberos configuration when Kerberos authentication is
-- enabled using a security configuration. For more information see
-- <https://docs.aws.amazon.com/emr/latest/ManagementGuide/emr-kerberos.html Use Kerberos Authentication>
-- in the /Amazon EMR Management Guide/.
--
-- 'logEncryptionKmsKeyId', 'cluster_logEncryptionKmsKeyId' - The KMS key used for encrypting log files. This attribute is only
-- available with EMR version 5.30.0 and later, excluding EMR 6.0.0.
--
-- 'logUri', 'cluster_logUri' - The path to the Amazon S3 location where logs for this cluster are
-- stored.
--
-- 'masterPublicDnsName', 'cluster_masterPublicDnsName' - The DNS name of the master node. If the cluster is on a private subnet,
-- this is the private DNS name. On a public subnet, this is the public DNS
-- name.
--
-- 'normalizedInstanceHours', 'cluster_normalizedInstanceHours' - An approximation of the cost of the cluster, represented in
-- m1.small\/hours. This value is incremented one time for every hour an
-- m1.small instance runs. Larger instances are weighted more, so an EC2
-- instance that is roughly four times more expensive would result in the
-- normalized instance hours being incremented by four. This result is only
-- an approximation and does not reflect the actual billing rate.
--
-- 'oSReleaseLabel', 'cluster_oSReleaseLabel' - The Amazon Linux release specified in a cluster launch RunJobFlow
-- request. If no Amazon Linux release was specified, the default Amazon
-- Linux release is shown in the response.
--
-- 'outpostArn', 'cluster_outpostArn' - The Amazon Resource Name (ARN) of the Outpost where the cluster is
-- launched.
--
-- 'placementGroups', 'cluster_placementGroups' - Placement group configured for an Amazon EMR cluster.
--
-- 'releaseLabel', 'cluster_releaseLabel' - The Amazon EMR release label, which determines the version of
-- open-source application packages installed on the cluster. Release
-- labels are in the form @emr-x.x.x@, where x.x.x is an Amazon EMR release
-- version such as @emr-5.14.0@. For more information about Amazon EMR
-- release versions and included application versions and features, see
-- <https://docs.aws.amazon.com/emr/latest/ReleaseGuide/>. The release
-- label applies only to Amazon EMR releases version 4.0 and later. Earlier
-- versions use @AmiVersion@.
--
-- 'repoUpgradeOnBoot', 'cluster_repoUpgradeOnBoot' - Applies only when @CustomAmiID@ is used. Specifies the type of updates
-- that are applied from the Amazon Linux AMI package repositories when an
-- instance boots using the AMI.
--
-- 'requestedAmiVersion', 'cluster_requestedAmiVersion' - The AMI version requested for this cluster.
--
-- 'runningAmiVersion', 'cluster_runningAmiVersion' - The AMI version running on this cluster.
--
-- 'scaleDownBehavior', 'cluster_scaleDownBehavior' - The way that individual Amazon EC2 instances terminate when an automatic
-- scale-in activity occurs or an instance group is resized.
-- @TERMINATE_AT_INSTANCE_HOUR@ indicates that Amazon EMR terminates nodes
-- at the instance-hour boundary, regardless of when the request to
-- terminate the instance was submitted. This option is only available with
-- Amazon EMR 5.1.0 and later and is the default for clusters created using
-- that version. @TERMINATE_AT_TASK_COMPLETION@ indicates that Amazon EMR
-- adds nodes to a deny list and drains tasks from nodes before terminating
-- the Amazon EC2 instances, regardless of the instance-hour boundary. With
-- either behavior, Amazon EMR removes the least active nodes first and
-- blocks instance termination if it could lead to HDFS corruption.
-- @TERMINATE_AT_TASK_COMPLETION@ is available only in Amazon EMR version
-- 4.1.0 and later, and is the default for versions of Amazon EMR earlier
-- than 5.1.0.
--
-- 'securityConfiguration', 'cluster_securityConfiguration' - The name of the security configuration applied to the cluster.
--
-- 'serviceRole', 'cluster_serviceRole' - The IAM role that Amazon EMR assumes in order to access Amazon Web
-- Services resources on your behalf.
--
-- 'stepConcurrencyLevel', 'cluster_stepConcurrencyLevel' - Specifies the number of steps that can be executed concurrently.
--
-- 'tags', 'cluster_tags' - A list of tags associated with a cluster.
--
-- 'terminationProtected', 'cluster_terminationProtected' - Indicates whether Amazon EMR will lock the cluster to prevent the EC2
-- instances from being terminated by an API call or user intervention, or
-- in the event of a cluster error.
--
-- 'visibleToAllUsers', 'cluster_visibleToAllUsers' - Indicates whether the cluster is visible to IAM principals in the Amazon
-- Web Services account associated with the cluster. When @true@, IAM
-- principals in the Amazon Web Services account can perform EMR cluster
-- actions on the cluster that their IAM policies allow. When @false@, only
-- the IAM principal that created the cluster and the Amazon Web Services
-- account root user can perform EMR actions, regardless of IAM permissions
-- policies attached to other IAM principals.
--
-- The default value is @true@ if a value is not provided when creating a
-- cluster using the EMR API RunJobFlow command, the CLI
-- <https://docs.aws.amazon.com/cli/latest/reference/emr/create-cluster.html create-cluster>
-- command, or the Amazon Web Services Management Console.
--
-- 'id', 'cluster_id' - The unique identifier for the cluster.
--
-- 'name', 'cluster_name' - The name of the cluster.
--
-- 'status', 'cluster_status' - The current status details about the cluster.
newCluster ::
  -- | 'id'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  ClusterStatus ->
  Cluster
newCluster :: Text -> Text -> ClusterStatus -> Cluster
newCluster Text
pId_ Text
pName_ ClusterStatus
pStatus_ =
  Cluster'
    { $sel:applications:Cluster' :: Maybe [Application]
applications = forall a. Maybe a
Prelude.Nothing,
      $sel:autoScalingRole:Cluster' :: Maybe Text
autoScalingRole = forall a. Maybe a
Prelude.Nothing,
      $sel:autoTerminate:Cluster' :: Maybe Bool
autoTerminate = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterArn:Cluster' :: Maybe Text
clusterArn = forall a. Maybe a
Prelude.Nothing,
      $sel:configurations:Cluster' :: Maybe [Configuration]
configurations = forall a. Maybe a
Prelude.Nothing,
      $sel:customAmiId:Cluster' :: Maybe Text
customAmiId = forall a. Maybe a
Prelude.Nothing,
      $sel:ebsRootVolumeSize:Cluster' :: Maybe Int
ebsRootVolumeSize = forall a. Maybe a
Prelude.Nothing,
      $sel:ec2InstanceAttributes:Cluster' :: Maybe Ec2InstanceAttributes
ec2InstanceAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceCollectionType:Cluster' :: Maybe InstanceCollectionType
instanceCollectionType = forall a. Maybe a
Prelude.Nothing,
      $sel:kerberosAttributes:Cluster' :: Maybe KerberosAttributes
kerberosAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:logEncryptionKmsKeyId:Cluster' :: Maybe Text
logEncryptionKmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:logUri:Cluster' :: Maybe Text
logUri = forall a. Maybe a
Prelude.Nothing,
      $sel:masterPublicDnsName:Cluster' :: Maybe Text
masterPublicDnsName = forall a. Maybe a
Prelude.Nothing,
      $sel:normalizedInstanceHours:Cluster' :: Maybe Int
normalizedInstanceHours = forall a. Maybe a
Prelude.Nothing,
      $sel:oSReleaseLabel:Cluster' :: Maybe Text
oSReleaseLabel = forall a. Maybe a
Prelude.Nothing,
      $sel:outpostArn:Cluster' :: Maybe Text
outpostArn = forall a. Maybe a
Prelude.Nothing,
      $sel:placementGroups:Cluster' :: Maybe [PlacementGroupConfig]
placementGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:releaseLabel:Cluster' :: Maybe Text
releaseLabel = forall a. Maybe a
Prelude.Nothing,
      $sel:repoUpgradeOnBoot:Cluster' :: Maybe RepoUpgradeOnBoot
repoUpgradeOnBoot = forall a. Maybe a
Prelude.Nothing,
      $sel:requestedAmiVersion:Cluster' :: Maybe Text
requestedAmiVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:runningAmiVersion:Cluster' :: Maybe Text
runningAmiVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:scaleDownBehavior:Cluster' :: Maybe ScaleDownBehavior
scaleDownBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:securityConfiguration:Cluster' :: Maybe Text
securityConfiguration = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRole:Cluster' :: Maybe Text
serviceRole = forall a. Maybe a
Prelude.Nothing,
      $sel:stepConcurrencyLevel:Cluster' :: Maybe Int
stepConcurrencyLevel = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Cluster' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:terminationProtected:Cluster' :: Maybe Bool
terminationProtected = forall a. Maybe a
Prelude.Nothing,
      $sel:visibleToAllUsers:Cluster' :: Maybe Bool
visibleToAllUsers = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Cluster' :: Text
id = Text
pId_,
      $sel:name:Cluster' :: Text
name = Text
pName_,
      $sel:status:Cluster' :: ClusterStatus
status = ClusterStatus
pStatus_
    }

-- | The applications installed on this cluster.
cluster_applications :: Lens.Lens' Cluster (Prelude.Maybe [Application])
cluster_applications :: Lens' Cluster (Maybe [Application])
cluster_applications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe [Application]
applications :: Maybe [Application]
$sel:applications:Cluster' :: Cluster -> Maybe [Application]
applications} -> Maybe [Application]
applications) (\s :: Cluster
s@Cluster' {} Maybe [Application]
a -> Cluster
s {$sel:applications:Cluster' :: Maybe [Application]
applications = Maybe [Application]
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

-- | An IAM role for automatic scaling policies. The default role is
-- @EMR_AutoScaling_DefaultRole@. The IAM role provides permissions that
-- the automatic scaling feature requires to launch and terminate EC2
-- instances in an instance group.
cluster_autoScalingRole :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_autoScalingRole :: Lens' Cluster (Maybe Text)
cluster_autoScalingRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
autoScalingRole :: Maybe Text
$sel:autoScalingRole:Cluster' :: Cluster -> Maybe Text
autoScalingRole} -> Maybe Text
autoScalingRole) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:autoScalingRole:Cluster' :: Maybe Text
autoScalingRole = Maybe Text
a} :: Cluster)

-- | Specifies whether the cluster should terminate after completing all
-- steps.
cluster_autoTerminate :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Bool)
cluster_autoTerminate :: Lens' Cluster (Maybe Bool)
cluster_autoTerminate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Bool
autoTerminate :: Maybe Bool
$sel:autoTerminate:Cluster' :: Cluster -> Maybe Bool
autoTerminate} -> Maybe Bool
autoTerminate) (\s :: Cluster
s@Cluster' {} Maybe Bool
a -> Cluster
s {$sel:autoTerminate:Cluster' :: Maybe Bool
autoTerminate = Maybe Bool
a} :: Cluster)

-- | The Amazon Resource Name of 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)

-- | Applies only to Amazon EMR releases 4.x and later. The list of
-- Configurations supplied to the EMR cluster.
cluster_configurations :: Lens.Lens' Cluster (Prelude.Maybe [Configuration])
cluster_configurations :: Lens' Cluster (Maybe [Configuration])
cluster_configurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe [Configuration]
configurations :: Maybe [Configuration]
$sel:configurations:Cluster' :: Cluster -> Maybe [Configuration]
configurations} -> Maybe [Configuration]
configurations) (\s :: Cluster
s@Cluster' {} Maybe [Configuration]
a -> Cluster
s {$sel:configurations:Cluster' :: Maybe [Configuration]
configurations = Maybe [Configuration]
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

-- | Available only in Amazon EMR version 5.7.0 and later. The ID of a custom
-- Amazon EBS-backed Linux AMI if the cluster uses a custom AMI.
cluster_customAmiId :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_customAmiId :: Lens' Cluster (Maybe Text)
cluster_customAmiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
customAmiId :: Maybe Text
$sel:customAmiId:Cluster' :: Cluster -> Maybe Text
customAmiId} -> Maybe Text
customAmiId) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:customAmiId:Cluster' :: Maybe Text
customAmiId = Maybe Text
a} :: Cluster)

-- | The size, in GiB, of the Amazon EBS root device volume of the Linux AMI
-- that is used for each EC2 instance. Available in Amazon EMR version 4.x
-- and later.
cluster_ebsRootVolumeSize :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Int)
cluster_ebsRootVolumeSize :: Lens' Cluster (Maybe Int)
cluster_ebsRootVolumeSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Int
ebsRootVolumeSize :: Maybe Int
$sel:ebsRootVolumeSize:Cluster' :: Cluster -> Maybe Int
ebsRootVolumeSize} -> Maybe Int
ebsRootVolumeSize) (\s :: Cluster
s@Cluster' {} Maybe Int
a -> Cluster
s {$sel:ebsRootVolumeSize:Cluster' :: Maybe Int
ebsRootVolumeSize = Maybe Int
a} :: Cluster)

-- | Provides information about the EC2 instances in a cluster grouped by
-- category. For example, key name, subnet ID, IAM instance profile, and so
-- on.
cluster_ec2InstanceAttributes :: Lens.Lens' Cluster (Prelude.Maybe Ec2InstanceAttributes)
cluster_ec2InstanceAttributes :: Lens' Cluster (Maybe Ec2InstanceAttributes)
cluster_ec2InstanceAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Ec2InstanceAttributes
ec2InstanceAttributes :: Maybe Ec2InstanceAttributes
$sel:ec2InstanceAttributes:Cluster' :: Cluster -> Maybe Ec2InstanceAttributes
ec2InstanceAttributes} -> Maybe Ec2InstanceAttributes
ec2InstanceAttributes) (\s :: Cluster
s@Cluster' {} Maybe Ec2InstanceAttributes
a -> Cluster
s {$sel:ec2InstanceAttributes:Cluster' :: Maybe Ec2InstanceAttributes
ec2InstanceAttributes = Maybe Ec2InstanceAttributes
a} :: Cluster)

-- | The instance fleet configuration is available only in Amazon EMR
-- versions 4.8.0 and later, excluding 5.0.x versions.
--
-- The instance group configuration of the cluster. A value of
-- @INSTANCE_GROUP@ indicates a uniform instance group configuration. A
-- value of @INSTANCE_FLEET@ indicates an instance fleets configuration.
cluster_instanceCollectionType :: Lens.Lens' Cluster (Prelude.Maybe InstanceCollectionType)
cluster_instanceCollectionType :: Lens' Cluster (Maybe InstanceCollectionType)
cluster_instanceCollectionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe InstanceCollectionType
instanceCollectionType :: Maybe InstanceCollectionType
$sel:instanceCollectionType:Cluster' :: Cluster -> Maybe InstanceCollectionType
instanceCollectionType} -> Maybe InstanceCollectionType
instanceCollectionType) (\s :: Cluster
s@Cluster' {} Maybe InstanceCollectionType
a -> Cluster
s {$sel:instanceCollectionType:Cluster' :: Maybe InstanceCollectionType
instanceCollectionType = Maybe InstanceCollectionType
a} :: Cluster)

-- | Attributes for Kerberos configuration when Kerberos authentication is
-- enabled using a security configuration. For more information see
-- <https://docs.aws.amazon.com/emr/latest/ManagementGuide/emr-kerberos.html Use Kerberos Authentication>
-- in the /Amazon EMR Management Guide/.
cluster_kerberosAttributes :: Lens.Lens' Cluster (Prelude.Maybe KerberosAttributes)
cluster_kerberosAttributes :: Lens' Cluster (Maybe KerberosAttributes)
cluster_kerberosAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe KerberosAttributes
kerberosAttributes :: Maybe KerberosAttributes
$sel:kerberosAttributes:Cluster' :: Cluster -> Maybe KerberosAttributes
kerberosAttributes} -> Maybe KerberosAttributes
kerberosAttributes) (\s :: Cluster
s@Cluster' {} Maybe KerberosAttributes
a -> Cluster
s {$sel:kerberosAttributes:Cluster' :: Maybe KerberosAttributes
kerberosAttributes = Maybe KerberosAttributes
a} :: Cluster)

-- | The KMS key used for encrypting log files. This attribute is only
-- available with EMR version 5.30.0 and later, excluding EMR 6.0.0.
cluster_logEncryptionKmsKeyId :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_logEncryptionKmsKeyId :: Lens' Cluster (Maybe Text)
cluster_logEncryptionKmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
logEncryptionKmsKeyId :: Maybe Text
$sel:logEncryptionKmsKeyId:Cluster' :: Cluster -> Maybe Text
logEncryptionKmsKeyId} -> Maybe Text
logEncryptionKmsKeyId) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:logEncryptionKmsKeyId:Cluster' :: Maybe Text
logEncryptionKmsKeyId = Maybe Text
a} :: Cluster)

-- | The path to the Amazon S3 location where logs for this cluster are
-- stored.
cluster_logUri :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_logUri :: Lens' Cluster (Maybe Text)
cluster_logUri = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
logUri :: Maybe Text
$sel:logUri:Cluster' :: Cluster -> Maybe Text
logUri} -> Maybe Text
logUri) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:logUri:Cluster' :: Maybe Text
logUri = Maybe Text
a} :: Cluster)

-- | The DNS name of the master node. If the cluster is on a private subnet,
-- this is the private DNS name. On a public subnet, this is the public DNS
-- name.
cluster_masterPublicDnsName :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_masterPublicDnsName :: Lens' Cluster (Maybe Text)
cluster_masterPublicDnsName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
masterPublicDnsName :: Maybe Text
$sel:masterPublicDnsName:Cluster' :: Cluster -> Maybe Text
masterPublicDnsName} -> Maybe Text
masterPublicDnsName) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:masterPublicDnsName:Cluster' :: Maybe Text
masterPublicDnsName = Maybe Text
a} :: Cluster)

-- | An approximation of the cost of the cluster, represented in
-- m1.small\/hours. This value is incremented one time for every hour an
-- m1.small instance runs. Larger instances are weighted more, so an EC2
-- instance that is roughly four times more expensive would result in the
-- normalized instance hours being incremented by four. This result is only
-- an approximation and does not reflect the actual billing rate.
cluster_normalizedInstanceHours :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Int)
cluster_normalizedInstanceHours :: Lens' Cluster (Maybe Int)
cluster_normalizedInstanceHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Int
normalizedInstanceHours :: Maybe Int
$sel:normalizedInstanceHours:Cluster' :: Cluster -> Maybe Int
normalizedInstanceHours} -> Maybe Int
normalizedInstanceHours) (\s :: Cluster
s@Cluster' {} Maybe Int
a -> Cluster
s {$sel:normalizedInstanceHours:Cluster' :: Maybe Int
normalizedInstanceHours = Maybe Int
a} :: Cluster)

-- | The Amazon Linux release specified in a cluster launch RunJobFlow
-- request. If no Amazon Linux release was specified, the default Amazon
-- Linux release is shown in the response.
cluster_oSReleaseLabel :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_oSReleaseLabel :: Lens' Cluster (Maybe Text)
cluster_oSReleaseLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
oSReleaseLabel :: Maybe Text
$sel:oSReleaseLabel:Cluster' :: Cluster -> Maybe Text
oSReleaseLabel} -> Maybe Text
oSReleaseLabel) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:oSReleaseLabel:Cluster' :: Maybe Text
oSReleaseLabel = Maybe Text
a} :: Cluster)

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

-- | Placement group configured for an Amazon EMR cluster.
cluster_placementGroups :: Lens.Lens' Cluster (Prelude.Maybe [PlacementGroupConfig])
cluster_placementGroups :: Lens' Cluster (Maybe [PlacementGroupConfig])
cluster_placementGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe [PlacementGroupConfig]
placementGroups :: Maybe [PlacementGroupConfig]
$sel:placementGroups:Cluster' :: Cluster -> Maybe [PlacementGroupConfig]
placementGroups} -> Maybe [PlacementGroupConfig]
placementGroups) (\s :: Cluster
s@Cluster' {} Maybe [PlacementGroupConfig]
a -> Cluster
s {$sel:placementGroups:Cluster' :: Maybe [PlacementGroupConfig]
placementGroups = Maybe [PlacementGroupConfig]
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 Amazon EMR release label, which determines the version of
-- open-source application packages installed on the cluster. Release
-- labels are in the form @emr-x.x.x@, where x.x.x is an Amazon EMR release
-- version such as @emr-5.14.0@. For more information about Amazon EMR
-- release versions and included application versions and features, see
-- <https://docs.aws.amazon.com/emr/latest/ReleaseGuide/>. The release
-- label applies only to Amazon EMR releases version 4.0 and later. Earlier
-- versions use @AmiVersion@.
cluster_releaseLabel :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_releaseLabel :: Lens' Cluster (Maybe Text)
cluster_releaseLabel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
releaseLabel :: Maybe Text
$sel:releaseLabel:Cluster' :: Cluster -> Maybe Text
releaseLabel} -> Maybe Text
releaseLabel) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:releaseLabel:Cluster' :: Maybe Text
releaseLabel = Maybe Text
a} :: Cluster)

-- | Applies only when @CustomAmiID@ is used. Specifies the type of updates
-- that are applied from the Amazon Linux AMI package repositories when an
-- instance boots using the AMI.
cluster_repoUpgradeOnBoot :: Lens.Lens' Cluster (Prelude.Maybe RepoUpgradeOnBoot)
cluster_repoUpgradeOnBoot :: Lens' Cluster (Maybe RepoUpgradeOnBoot)
cluster_repoUpgradeOnBoot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe RepoUpgradeOnBoot
repoUpgradeOnBoot :: Maybe RepoUpgradeOnBoot
$sel:repoUpgradeOnBoot:Cluster' :: Cluster -> Maybe RepoUpgradeOnBoot
repoUpgradeOnBoot} -> Maybe RepoUpgradeOnBoot
repoUpgradeOnBoot) (\s :: Cluster
s@Cluster' {} Maybe RepoUpgradeOnBoot
a -> Cluster
s {$sel:repoUpgradeOnBoot:Cluster' :: Maybe RepoUpgradeOnBoot
repoUpgradeOnBoot = Maybe RepoUpgradeOnBoot
a} :: Cluster)

-- | The AMI version requested for this cluster.
cluster_requestedAmiVersion :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_requestedAmiVersion :: Lens' Cluster (Maybe Text)
cluster_requestedAmiVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
requestedAmiVersion :: Maybe Text
$sel:requestedAmiVersion:Cluster' :: Cluster -> Maybe Text
requestedAmiVersion} -> Maybe Text
requestedAmiVersion) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:requestedAmiVersion:Cluster' :: Maybe Text
requestedAmiVersion = Maybe Text
a} :: Cluster)

-- | The AMI version running on this cluster.
cluster_runningAmiVersion :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_runningAmiVersion :: Lens' Cluster (Maybe Text)
cluster_runningAmiVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
runningAmiVersion :: Maybe Text
$sel:runningAmiVersion:Cluster' :: Cluster -> Maybe Text
runningAmiVersion} -> Maybe Text
runningAmiVersion) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:runningAmiVersion:Cluster' :: Maybe Text
runningAmiVersion = Maybe Text
a} :: Cluster)

-- | The way that individual Amazon EC2 instances terminate when an automatic
-- scale-in activity occurs or an instance group is resized.
-- @TERMINATE_AT_INSTANCE_HOUR@ indicates that Amazon EMR terminates nodes
-- at the instance-hour boundary, regardless of when the request to
-- terminate the instance was submitted. This option is only available with
-- Amazon EMR 5.1.0 and later and is the default for clusters created using
-- that version. @TERMINATE_AT_TASK_COMPLETION@ indicates that Amazon EMR
-- adds nodes to a deny list and drains tasks from nodes before terminating
-- the Amazon EC2 instances, regardless of the instance-hour boundary. With
-- either behavior, Amazon EMR removes the least active nodes first and
-- blocks instance termination if it could lead to HDFS corruption.
-- @TERMINATE_AT_TASK_COMPLETION@ is available only in Amazon EMR version
-- 4.1.0 and later, and is the default for versions of Amazon EMR earlier
-- than 5.1.0.
cluster_scaleDownBehavior :: Lens.Lens' Cluster (Prelude.Maybe ScaleDownBehavior)
cluster_scaleDownBehavior :: Lens' Cluster (Maybe ScaleDownBehavior)
cluster_scaleDownBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe ScaleDownBehavior
scaleDownBehavior :: Maybe ScaleDownBehavior
$sel:scaleDownBehavior:Cluster' :: Cluster -> Maybe ScaleDownBehavior
scaleDownBehavior} -> Maybe ScaleDownBehavior
scaleDownBehavior) (\s :: Cluster
s@Cluster' {} Maybe ScaleDownBehavior
a -> Cluster
s {$sel:scaleDownBehavior:Cluster' :: Maybe ScaleDownBehavior
scaleDownBehavior = Maybe ScaleDownBehavior
a} :: Cluster)

-- | The name of the security configuration applied to the cluster.
cluster_securityConfiguration :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_securityConfiguration :: Lens' Cluster (Maybe Text)
cluster_securityConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
securityConfiguration :: Maybe Text
$sel:securityConfiguration:Cluster' :: Cluster -> Maybe Text
securityConfiguration} -> Maybe Text
securityConfiguration) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:securityConfiguration:Cluster' :: Maybe Text
securityConfiguration = Maybe Text
a} :: Cluster)

-- | The IAM role that Amazon EMR assumes in order to access Amazon Web
-- Services resources on your behalf.
cluster_serviceRole :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Text)
cluster_serviceRole :: Lens' Cluster (Maybe Text)
cluster_serviceRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Text
serviceRole :: Maybe Text
$sel:serviceRole:Cluster' :: Cluster -> Maybe Text
serviceRole} -> Maybe Text
serviceRole) (\s :: Cluster
s@Cluster' {} Maybe Text
a -> Cluster
s {$sel:serviceRole:Cluster' :: Maybe Text
serviceRole = Maybe Text
a} :: Cluster)

-- | Specifies the number of steps that can be executed concurrently.
cluster_stepConcurrencyLevel :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Int)
cluster_stepConcurrencyLevel :: Lens' Cluster (Maybe Int)
cluster_stepConcurrencyLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Int
stepConcurrencyLevel :: Maybe Int
$sel:stepConcurrencyLevel:Cluster' :: Cluster -> Maybe Int
stepConcurrencyLevel} -> Maybe Int
stepConcurrencyLevel) (\s :: Cluster
s@Cluster' {} Maybe Int
a -> Cluster
s {$sel:stepConcurrencyLevel:Cluster' :: Maybe Int
stepConcurrencyLevel = Maybe Int
a} :: Cluster)

-- | A list of tags associated with a cluster.
cluster_tags :: Lens.Lens' Cluster (Prelude.Maybe [Tag])
cluster_tags :: Lens' Cluster (Maybe [Tag])
cluster_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:Cluster' :: Cluster -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: Cluster
s@Cluster' {} Maybe [Tag]
a -> Cluster
s {$sel:tags:Cluster' :: Maybe [Tag]
tags = Maybe [Tag]
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

-- | Indicates whether Amazon EMR will lock the cluster to prevent the EC2
-- instances from being terminated by an API call or user intervention, or
-- in the event of a cluster error.
cluster_terminationProtected :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Bool)
cluster_terminationProtected :: Lens' Cluster (Maybe Bool)
cluster_terminationProtected = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Bool
terminationProtected :: Maybe Bool
$sel:terminationProtected:Cluster' :: Cluster -> Maybe Bool
terminationProtected} -> Maybe Bool
terminationProtected) (\s :: Cluster
s@Cluster' {} Maybe Bool
a -> Cluster
s {$sel:terminationProtected:Cluster' :: Maybe Bool
terminationProtected = Maybe Bool
a} :: Cluster)

-- | Indicates whether the cluster is visible to IAM principals in the Amazon
-- Web Services account associated with the cluster. When @true@, IAM
-- principals in the Amazon Web Services account can perform EMR cluster
-- actions on the cluster that their IAM policies allow. When @false@, only
-- the IAM principal that created the cluster and the Amazon Web Services
-- account root user can perform EMR actions, regardless of IAM permissions
-- policies attached to other IAM principals.
--
-- The default value is @true@ if a value is not provided when creating a
-- cluster using the EMR API RunJobFlow command, the CLI
-- <https://docs.aws.amazon.com/cli/latest/reference/emr/create-cluster.html create-cluster>
-- command, or the Amazon Web Services Management Console.
cluster_visibleToAllUsers :: Lens.Lens' Cluster (Prelude.Maybe Prelude.Bool)
cluster_visibleToAllUsers :: Lens' Cluster (Maybe Bool)
cluster_visibleToAllUsers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Maybe Bool
visibleToAllUsers :: Maybe Bool
$sel:visibleToAllUsers:Cluster' :: Cluster -> Maybe Bool
visibleToAllUsers} -> Maybe Bool
visibleToAllUsers) (\s :: Cluster
s@Cluster' {} Maybe Bool
a -> Cluster
s {$sel:visibleToAllUsers:Cluster' :: Maybe Bool
visibleToAllUsers = Maybe Bool
a} :: Cluster)

-- | The unique identifier for the cluster.
cluster_id :: Lens.Lens' Cluster Prelude.Text
cluster_id :: Lens' Cluster Text
cluster_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {Text
id :: Text
$sel:id:Cluster' :: Cluster -> Text
id} -> Text
id) (\s :: Cluster
s@Cluster' {} Text
a -> Cluster
s {$sel:id:Cluster' :: Text
id = Text
a} :: Cluster)

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

-- | The current status details about the cluster.
cluster_status :: Lens.Lens' Cluster ClusterStatus
cluster_status :: Lens' Cluster ClusterStatus
cluster_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Cluster' {ClusterStatus
status :: ClusterStatus
$sel:status:Cluster' :: Cluster -> ClusterStatus
status} -> ClusterStatus
status) (\s :: Cluster
s@Cluster' {} ClusterStatus
a -> Cluster
s {$sel:status:Cluster' :: ClusterStatus
status = ClusterStatus
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 [Application]
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe [Configuration]
-> Maybe Text
-> Maybe Int
-> Maybe Ec2InstanceAttributes
-> Maybe InstanceCollectionType
-> Maybe KerberosAttributes
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe [PlacementGroupConfig]
-> Maybe Text
-> Maybe RepoUpgradeOnBoot
-> Maybe Text
-> Maybe Text
-> Maybe ScaleDownBehavior
-> Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe [Tag]
-> Maybe Bool
-> Maybe Bool
-> Text
-> Text
-> ClusterStatus
-> 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
"Applications" 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
"AutoScalingRole")
            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
"AutoTerminate")
            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
"Configurations" 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
"CustomAmiId")
            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
"EbsRootVolumeSize")
            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
"Ec2InstanceAttributes")
            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
"InstanceCollectionType")
            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
"KerberosAttributes")
            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
"LogEncryptionKmsKeyId")
            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
"LogUri")
            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
"MasterPublicDnsName")
            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
"NormalizedInstanceHours")
            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
"OSReleaseLabel")
            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
"OutpostArn")
            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
"PlacementGroups"
                            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
"ReleaseLabel")
            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
"RepoUpgradeOnBoot")
            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
"RequestedAmiVersion")
            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
"RunningAmiVersion")
            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
"ScaleDownBehavior")
            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
"SecurityConfiguration")
            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
"ServiceRole")
            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
"StepConcurrencyLevel")
            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)
            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
"TerminationProtected")
            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
"VisibleToAllUsers")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Id")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser 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 a
Data..: Key
"Status")
      )

instance Prelude.Hashable Cluster where
  hashWithSalt :: Int -> Cluster -> Int
hashWithSalt Int
_salt Cluster' {Maybe Bool
Maybe Int
Maybe [Application]
Maybe [Configuration]
Maybe [PlacementGroupConfig]
Maybe [Tag]
Maybe Text
Maybe Ec2InstanceAttributes
Maybe InstanceCollectionType
Maybe KerberosAttributes
Maybe RepoUpgradeOnBoot
Maybe ScaleDownBehavior
Text
ClusterStatus
status :: ClusterStatus
name :: Text
id :: Text
visibleToAllUsers :: Maybe Bool
terminationProtected :: Maybe Bool
tags :: Maybe [Tag]
stepConcurrencyLevel :: Maybe Int
serviceRole :: Maybe Text
securityConfiguration :: Maybe Text
scaleDownBehavior :: Maybe ScaleDownBehavior
runningAmiVersion :: Maybe Text
requestedAmiVersion :: Maybe Text
repoUpgradeOnBoot :: Maybe RepoUpgradeOnBoot
releaseLabel :: Maybe Text
placementGroups :: Maybe [PlacementGroupConfig]
outpostArn :: Maybe Text
oSReleaseLabel :: Maybe Text
normalizedInstanceHours :: Maybe Int
masterPublicDnsName :: Maybe Text
logUri :: Maybe Text
logEncryptionKmsKeyId :: Maybe Text
kerberosAttributes :: Maybe KerberosAttributes
instanceCollectionType :: Maybe InstanceCollectionType
ec2InstanceAttributes :: Maybe Ec2InstanceAttributes
ebsRootVolumeSize :: Maybe Int
customAmiId :: Maybe Text
configurations :: Maybe [Configuration]
clusterArn :: Maybe Text
autoTerminate :: Maybe Bool
autoScalingRole :: Maybe Text
applications :: Maybe [Application]
$sel:status:Cluster' :: Cluster -> ClusterStatus
$sel:name:Cluster' :: Cluster -> Text
$sel:id:Cluster' :: Cluster -> Text
$sel:visibleToAllUsers:Cluster' :: Cluster -> Maybe Bool
$sel:terminationProtected:Cluster' :: Cluster -> Maybe Bool
$sel:tags:Cluster' :: Cluster -> Maybe [Tag]
$sel:stepConcurrencyLevel:Cluster' :: Cluster -> Maybe Int
$sel:serviceRole:Cluster' :: Cluster -> Maybe Text
$sel:securityConfiguration:Cluster' :: Cluster -> Maybe Text
$sel:scaleDownBehavior:Cluster' :: Cluster -> Maybe ScaleDownBehavior
$sel:runningAmiVersion:Cluster' :: Cluster -> Maybe Text
$sel:requestedAmiVersion:Cluster' :: Cluster -> Maybe Text
$sel:repoUpgradeOnBoot:Cluster' :: Cluster -> Maybe RepoUpgradeOnBoot
$sel:releaseLabel:Cluster' :: Cluster -> Maybe Text
$sel:placementGroups:Cluster' :: Cluster -> Maybe [PlacementGroupConfig]
$sel:outpostArn:Cluster' :: Cluster -> Maybe Text
$sel:oSReleaseLabel:Cluster' :: Cluster -> Maybe Text
$sel:normalizedInstanceHours:Cluster' :: Cluster -> Maybe Int
$sel:masterPublicDnsName:Cluster' :: Cluster -> Maybe Text
$sel:logUri:Cluster' :: Cluster -> Maybe Text
$sel:logEncryptionKmsKeyId:Cluster' :: Cluster -> Maybe Text
$sel:kerberosAttributes:Cluster' :: Cluster -> Maybe KerberosAttributes
$sel:instanceCollectionType:Cluster' :: Cluster -> Maybe InstanceCollectionType
$sel:ec2InstanceAttributes:Cluster' :: Cluster -> Maybe Ec2InstanceAttributes
$sel:ebsRootVolumeSize:Cluster' :: Cluster -> Maybe Int
$sel:customAmiId:Cluster' :: Cluster -> Maybe Text
$sel:configurations:Cluster' :: Cluster -> Maybe [Configuration]
$sel:clusterArn:Cluster' :: Cluster -> Maybe Text
$sel:autoTerminate:Cluster' :: Cluster -> Maybe Bool
$sel:autoScalingRole:Cluster' :: Cluster -> Maybe Text
$sel:applications:Cluster' :: Cluster -> Maybe [Application]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Application]
applications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
autoScalingRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
autoTerminate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Configuration]
configurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customAmiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
ebsRootVolumeSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Ec2InstanceAttributes
ec2InstanceAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceCollectionType
instanceCollectionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KerberosAttributes
kerberosAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logEncryptionKmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logUri
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
masterPublicDnsName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
normalizedInstanceHours
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
oSReleaseLabel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outpostArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PlacementGroupConfig]
placementGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
releaseLabel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RepoUpgradeOnBoot
repoUpgradeOnBoot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestedAmiVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
runningAmiVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ScaleDownBehavior
scaleDownBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
securityConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
stepConcurrencyLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
terminationProtected
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
visibleToAllUsers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ClusterStatus
status

instance Prelude.NFData Cluster where
  rnf :: Cluster -> ()
rnf Cluster' {Maybe Bool
Maybe Int
Maybe [Application]
Maybe [Configuration]
Maybe [PlacementGroupConfig]
Maybe [Tag]
Maybe Text
Maybe Ec2InstanceAttributes
Maybe InstanceCollectionType
Maybe KerberosAttributes
Maybe RepoUpgradeOnBoot
Maybe ScaleDownBehavior
Text
ClusterStatus
status :: ClusterStatus
name :: Text
id :: Text
visibleToAllUsers :: Maybe Bool
terminationProtected :: Maybe Bool
tags :: Maybe [Tag]
stepConcurrencyLevel :: Maybe Int
serviceRole :: Maybe Text
securityConfiguration :: Maybe Text
scaleDownBehavior :: Maybe ScaleDownBehavior
runningAmiVersion :: Maybe Text
requestedAmiVersion :: Maybe Text
repoUpgradeOnBoot :: Maybe RepoUpgradeOnBoot
releaseLabel :: Maybe Text
placementGroups :: Maybe [PlacementGroupConfig]
outpostArn :: Maybe Text
oSReleaseLabel :: Maybe Text
normalizedInstanceHours :: Maybe Int
masterPublicDnsName :: Maybe Text
logUri :: Maybe Text
logEncryptionKmsKeyId :: Maybe Text
kerberosAttributes :: Maybe KerberosAttributes
instanceCollectionType :: Maybe InstanceCollectionType
ec2InstanceAttributes :: Maybe Ec2InstanceAttributes
ebsRootVolumeSize :: Maybe Int
customAmiId :: Maybe Text
configurations :: Maybe [Configuration]
clusterArn :: Maybe Text
autoTerminate :: Maybe Bool
autoScalingRole :: Maybe Text
applications :: Maybe [Application]
$sel:status:Cluster' :: Cluster -> ClusterStatus
$sel:name:Cluster' :: Cluster -> Text
$sel:id:Cluster' :: Cluster -> Text
$sel:visibleToAllUsers:Cluster' :: Cluster -> Maybe Bool
$sel:terminationProtected:Cluster' :: Cluster -> Maybe Bool
$sel:tags:Cluster' :: Cluster -> Maybe [Tag]
$sel:stepConcurrencyLevel:Cluster' :: Cluster -> Maybe Int
$sel:serviceRole:Cluster' :: Cluster -> Maybe Text
$sel:securityConfiguration:Cluster' :: Cluster -> Maybe Text
$sel:scaleDownBehavior:Cluster' :: Cluster -> Maybe ScaleDownBehavior
$sel:runningAmiVersion:Cluster' :: Cluster -> Maybe Text
$sel:requestedAmiVersion:Cluster' :: Cluster -> Maybe Text
$sel:repoUpgradeOnBoot:Cluster' :: Cluster -> Maybe RepoUpgradeOnBoot
$sel:releaseLabel:Cluster' :: Cluster -> Maybe Text
$sel:placementGroups:Cluster' :: Cluster -> Maybe [PlacementGroupConfig]
$sel:outpostArn:Cluster' :: Cluster -> Maybe Text
$sel:oSReleaseLabel:Cluster' :: Cluster -> Maybe Text
$sel:normalizedInstanceHours:Cluster' :: Cluster -> Maybe Int
$sel:masterPublicDnsName:Cluster' :: Cluster -> Maybe Text
$sel:logUri:Cluster' :: Cluster -> Maybe Text
$sel:logEncryptionKmsKeyId:Cluster' :: Cluster -> Maybe Text
$sel:kerberosAttributes:Cluster' :: Cluster -> Maybe KerberosAttributes
$sel:instanceCollectionType:Cluster' :: Cluster -> Maybe InstanceCollectionType
$sel:ec2InstanceAttributes:Cluster' :: Cluster -> Maybe Ec2InstanceAttributes
$sel:ebsRootVolumeSize:Cluster' :: Cluster -> Maybe Int
$sel:customAmiId:Cluster' :: Cluster -> Maybe Text
$sel:configurations:Cluster' :: Cluster -> Maybe [Configuration]
$sel:clusterArn:Cluster' :: Cluster -> Maybe Text
$sel:autoTerminate:Cluster' :: Cluster -> Maybe Bool
$sel:autoScalingRole:Cluster' :: Cluster -> Maybe Text
$sel:applications:Cluster' :: Cluster -> Maybe [Application]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Application]
applications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
autoScalingRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
autoTerminate
      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 [Configuration]
configurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customAmiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
ebsRootVolumeSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Ec2InstanceAttributes
ec2InstanceAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceCollectionType
instanceCollectionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KerberosAttributes
kerberosAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logEncryptionKmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logUri
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
masterPublicDnsName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
normalizedInstanceHours
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
oSReleaseLabel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outpostArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PlacementGroupConfig]
placementGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
releaseLabel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RepoUpgradeOnBoot
repoUpgradeOnBoot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
requestedAmiVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
runningAmiVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ScaleDownBehavior
scaleDownBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
securityConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
serviceRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Int
stepConcurrencyLevel
      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
        Maybe Bool
terminationProtected
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Bool
visibleToAllUsers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        ClusterStatus
status