{-# 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.InstanceGroup
-- 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.InstanceGroup 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.AutoScalingPolicyDescription
import Amazonka.EMR.Types.Configuration
import Amazonka.EMR.Types.EbsBlockDevice
import Amazonka.EMR.Types.InstanceGroupStatus
import Amazonka.EMR.Types.InstanceGroupType
import Amazonka.EMR.Types.MarketType
import Amazonka.EMR.Types.ShrinkPolicy
import qualified Amazonka.Prelude as Prelude

-- | This entity represents an instance group, which is a group of instances
-- that have common purpose. For example, CORE instance group is used for
-- HDFS.
--
-- /See:/ 'newInstanceGroup' smart constructor.
data InstanceGroup = InstanceGroup'
  { -- | An automatic scaling policy for a core instance group or task instance
    -- group in an Amazon EMR cluster. The automatic scaling policy defines how
    -- an instance group dynamically adds and terminates EC2 instances in
    -- response to the value of a CloudWatch metric. See PutAutoScalingPolicy.
    InstanceGroup -> Maybe AutoScalingPolicyDescription
autoScalingPolicy :: Prelude.Maybe AutoScalingPolicyDescription,
    -- | If specified, indicates that the instance group uses Spot Instances.
    -- This is the maximum price you are willing to pay for Spot Instances.
    -- Specify @OnDemandPrice@ to set the amount equal to the On-Demand price,
    -- or specify an amount in USD.
    InstanceGroup -> Maybe Text
bidPrice :: Prelude.Maybe Prelude.Text,
    -- | Amazon EMR releases 4.x or later.
    --
    -- The list of configurations supplied for an Amazon EMR cluster instance
    -- group. You can specify a separate configuration for each instance group
    -- (master, core, and task).
    InstanceGroup -> Maybe [Configuration]
configurations :: Prelude.Maybe [Configuration],
    -- | The version number of the requested configuration specification for this
    -- instance group.
    InstanceGroup -> Maybe Integer
configurationsVersion :: Prelude.Maybe Prelude.Integer,
    -- | The custom AMI ID to use for the provisioned instance group.
    InstanceGroup -> Maybe Text
customAmiId :: Prelude.Maybe Prelude.Text,
    -- | The EBS block devices that are mapped to this instance group.
    InstanceGroup -> Maybe [EbsBlockDevice]
ebsBlockDevices :: Prelude.Maybe [EbsBlockDevice],
    -- | If the instance group is EBS-optimized. An Amazon EBS-optimized instance
    -- uses an optimized configuration stack and provides additional, dedicated
    -- capacity for Amazon EBS I\/O.
    InstanceGroup -> Maybe Bool
ebsOptimized :: Prelude.Maybe Prelude.Bool,
    -- | The identifier of the instance group.
    InstanceGroup -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The type of the instance group. Valid values are MASTER, CORE or TASK.
    InstanceGroup -> Maybe InstanceGroupType
instanceGroupType :: Prelude.Maybe InstanceGroupType,
    -- | The EC2 instance type for all instances in the instance group.
    InstanceGroup -> Maybe Text
instanceType :: Prelude.Maybe Prelude.Text,
    -- | A list of configurations that were successfully applied for an instance
    -- group last time.
    InstanceGroup -> Maybe [Configuration]
lastSuccessfullyAppliedConfigurations :: Prelude.Maybe [Configuration],
    -- | The version number of a configuration specification that was
    -- successfully applied for an instance group last time.
    InstanceGroup -> Maybe Integer
lastSuccessfullyAppliedConfigurationsVersion :: Prelude.Maybe Prelude.Integer,
    -- | The marketplace to provision instances for this group. Valid values are
    -- ON_DEMAND or SPOT.
    InstanceGroup -> Maybe MarketType
market :: Prelude.Maybe MarketType,
    -- | The name of the instance group.
    InstanceGroup -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The target number of instances for the instance group.
    InstanceGroup -> Maybe Int
requestedInstanceCount :: Prelude.Maybe Prelude.Int,
    -- | The number of instances currently running in this instance group.
    InstanceGroup -> Maybe Int
runningInstanceCount :: Prelude.Maybe Prelude.Int,
    -- | Policy for customizing shrink operations.
    InstanceGroup -> Maybe ShrinkPolicy
shrinkPolicy :: Prelude.Maybe ShrinkPolicy,
    -- | The current status of the instance group.
    InstanceGroup -> Maybe InstanceGroupStatus
status :: Prelude.Maybe InstanceGroupStatus
  }
  deriving (InstanceGroup -> InstanceGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceGroup -> InstanceGroup -> Bool
$c/= :: InstanceGroup -> InstanceGroup -> Bool
== :: InstanceGroup -> InstanceGroup -> Bool
$c== :: InstanceGroup -> InstanceGroup -> Bool
Prelude.Eq, ReadPrec [InstanceGroup]
ReadPrec InstanceGroup
Int -> ReadS InstanceGroup
ReadS [InstanceGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstanceGroup]
$creadListPrec :: ReadPrec [InstanceGroup]
readPrec :: ReadPrec InstanceGroup
$creadPrec :: ReadPrec InstanceGroup
readList :: ReadS [InstanceGroup]
$creadList :: ReadS [InstanceGroup]
readsPrec :: Int -> ReadS InstanceGroup
$creadsPrec :: Int -> ReadS InstanceGroup
Prelude.Read, Int -> InstanceGroup -> ShowS
[InstanceGroup] -> ShowS
InstanceGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceGroup] -> ShowS
$cshowList :: [InstanceGroup] -> ShowS
show :: InstanceGroup -> String
$cshow :: InstanceGroup -> String
showsPrec :: Int -> InstanceGroup -> ShowS
$cshowsPrec :: Int -> InstanceGroup -> ShowS
Prelude.Show, forall x. Rep InstanceGroup x -> InstanceGroup
forall x. InstanceGroup -> Rep InstanceGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstanceGroup x -> InstanceGroup
$cfrom :: forall x. InstanceGroup -> Rep InstanceGroup x
Prelude.Generic)

-- |
-- Create a value of 'InstanceGroup' 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:
--
-- 'autoScalingPolicy', 'instanceGroup_autoScalingPolicy' - An automatic scaling policy for a core instance group or task instance
-- group in an Amazon EMR cluster. The automatic scaling policy defines how
-- an instance group dynamically adds and terminates EC2 instances in
-- response to the value of a CloudWatch metric. See PutAutoScalingPolicy.
--
-- 'bidPrice', 'instanceGroup_bidPrice' - If specified, indicates that the instance group uses Spot Instances.
-- This is the maximum price you are willing to pay for Spot Instances.
-- Specify @OnDemandPrice@ to set the amount equal to the On-Demand price,
-- or specify an amount in USD.
--
-- 'configurations', 'instanceGroup_configurations' - Amazon EMR releases 4.x or later.
--
-- The list of configurations supplied for an Amazon EMR cluster instance
-- group. You can specify a separate configuration for each instance group
-- (master, core, and task).
--
-- 'configurationsVersion', 'instanceGroup_configurationsVersion' - The version number of the requested configuration specification for this
-- instance group.
--
-- 'customAmiId', 'instanceGroup_customAmiId' - The custom AMI ID to use for the provisioned instance group.
--
-- 'ebsBlockDevices', 'instanceGroup_ebsBlockDevices' - The EBS block devices that are mapped to this instance group.
--
-- 'ebsOptimized', 'instanceGroup_ebsOptimized' - If the instance group is EBS-optimized. An Amazon EBS-optimized instance
-- uses an optimized configuration stack and provides additional, dedicated
-- capacity for Amazon EBS I\/O.
--
-- 'id', 'instanceGroup_id' - The identifier of the instance group.
--
-- 'instanceGroupType', 'instanceGroup_instanceGroupType' - The type of the instance group. Valid values are MASTER, CORE or TASK.
--
-- 'instanceType', 'instanceGroup_instanceType' - The EC2 instance type for all instances in the instance group.
--
-- 'lastSuccessfullyAppliedConfigurations', 'instanceGroup_lastSuccessfullyAppliedConfigurations' - A list of configurations that were successfully applied for an instance
-- group last time.
--
-- 'lastSuccessfullyAppliedConfigurationsVersion', 'instanceGroup_lastSuccessfullyAppliedConfigurationsVersion' - The version number of a configuration specification that was
-- successfully applied for an instance group last time.
--
-- 'market', 'instanceGroup_market' - The marketplace to provision instances for this group. Valid values are
-- ON_DEMAND or SPOT.
--
-- 'name', 'instanceGroup_name' - The name of the instance group.
--
-- 'requestedInstanceCount', 'instanceGroup_requestedInstanceCount' - The target number of instances for the instance group.
--
-- 'runningInstanceCount', 'instanceGroup_runningInstanceCount' - The number of instances currently running in this instance group.
--
-- 'shrinkPolicy', 'instanceGroup_shrinkPolicy' - Policy for customizing shrink operations.
--
-- 'status', 'instanceGroup_status' - The current status of the instance group.
newInstanceGroup ::
  InstanceGroup
newInstanceGroup :: InstanceGroup
newInstanceGroup =
  InstanceGroup'
    { $sel:autoScalingPolicy:InstanceGroup' :: Maybe AutoScalingPolicyDescription
autoScalingPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:bidPrice:InstanceGroup' :: Maybe Text
bidPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:configurations:InstanceGroup' :: Maybe [Configuration]
configurations = forall a. Maybe a
Prelude.Nothing,
      $sel:configurationsVersion:InstanceGroup' :: Maybe Integer
configurationsVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:customAmiId:InstanceGroup' :: Maybe Text
customAmiId = forall a. Maybe a
Prelude.Nothing,
      $sel:ebsBlockDevices:InstanceGroup' :: Maybe [EbsBlockDevice]
ebsBlockDevices = forall a. Maybe a
Prelude.Nothing,
      $sel:ebsOptimized:InstanceGroup' :: Maybe Bool
ebsOptimized = forall a. Maybe a
Prelude.Nothing,
      $sel:id:InstanceGroup' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceGroupType:InstanceGroup' :: Maybe InstanceGroupType
instanceGroupType = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:InstanceGroup' :: Maybe Text
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:lastSuccessfullyAppliedConfigurations:InstanceGroup' :: Maybe [Configuration]
lastSuccessfullyAppliedConfigurations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lastSuccessfullyAppliedConfigurationsVersion:InstanceGroup' :: Maybe Integer
lastSuccessfullyAppliedConfigurationsVersion =
        forall a. Maybe a
Prelude.Nothing,
      $sel:market:InstanceGroup' :: Maybe MarketType
market = forall a. Maybe a
Prelude.Nothing,
      $sel:name:InstanceGroup' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:requestedInstanceCount:InstanceGroup' :: Maybe Int
requestedInstanceCount = forall a. Maybe a
Prelude.Nothing,
      $sel:runningInstanceCount:InstanceGroup' :: Maybe Int
runningInstanceCount = forall a. Maybe a
Prelude.Nothing,
      $sel:shrinkPolicy:InstanceGroup' :: Maybe ShrinkPolicy
shrinkPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:status:InstanceGroup' :: Maybe InstanceGroupStatus
status = forall a. Maybe a
Prelude.Nothing
    }

-- | An automatic scaling policy for a core instance group or task instance
-- group in an Amazon EMR cluster. The automatic scaling policy defines how
-- an instance group dynamically adds and terminates EC2 instances in
-- response to the value of a CloudWatch metric. See PutAutoScalingPolicy.
instanceGroup_autoScalingPolicy :: Lens.Lens' InstanceGroup (Prelude.Maybe AutoScalingPolicyDescription)
instanceGroup_autoScalingPolicy :: Lens' InstanceGroup (Maybe AutoScalingPolicyDescription)
instanceGroup_autoScalingPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe AutoScalingPolicyDescription
autoScalingPolicy :: Maybe AutoScalingPolicyDescription
$sel:autoScalingPolicy:InstanceGroup' :: InstanceGroup -> Maybe AutoScalingPolicyDescription
autoScalingPolicy} -> Maybe AutoScalingPolicyDescription
autoScalingPolicy) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe AutoScalingPolicyDescription
a -> InstanceGroup
s {$sel:autoScalingPolicy:InstanceGroup' :: Maybe AutoScalingPolicyDescription
autoScalingPolicy = Maybe AutoScalingPolicyDescription
a} :: InstanceGroup)

-- | If specified, indicates that the instance group uses Spot Instances.
-- This is the maximum price you are willing to pay for Spot Instances.
-- Specify @OnDemandPrice@ to set the amount equal to the On-Demand price,
-- or specify an amount in USD.
instanceGroup_bidPrice :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Text)
instanceGroup_bidPrice :: Lens' InstanceGroup (Maybe Text)
instanceGroup_bidPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Text
bidPrice :: Maybe Text
$sel:bidPrice:InstanceGroup' :: InstanceGroup -> Maybe Text
bidPrice} -> Maybe Text
bidPrice) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Text
a -> InstanceGroup
s {$sel:bidPrice:InstanceGroup' :: Maybe Text
bidPrice = Maybe Text
a} :: InstanceGroup)

-- | Amazon EMR releases 4.x or later.
--
-- The list of configurations supplied for an Amazon EMR cluster instance
-- group. You can specify a separate configuration for each instance group
-- (master, core, and task).
instanceGroup_configurations :: Lens.Lens' InstanceGroup (Prelude.Maybe [Configuration])
instanceGroup_configurations :: Lens' InstanceGroup (Maybe [Configuration])
instanceGroup_configurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe [Configuration]
configurations :: Maybe [Configuration]
$sel:configurations:InstanceGroup' :: InstanceGroup -> Maybe [Configuration]
configurations} -> Maybe [Configuration]
configurations) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe [Configuration]
a -> InstanceGroup
s {$sel:configurations:InstanceGroup' :: Maybe [Configuration]
configurations = Maybe [Configuration]
a} :: InstanceGroup) 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 version number of the requested configuration specification for this
-- instance group.
instanceGroup_configurationsVersion :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Integer)
instanceGroup_configurationsVersion :: Lens' InstanceGroup (Maybe Integer)
instanceGroup_configurationsVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Integer
configurationsVersion :: Maybe Integer
$sel:configurationsVersion:InstanceGroup' :: InstanceGroup -> Maybe Integer
configurationsVersion} -> Maybe Integer
configurationsVersion) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Integer
a -> InstanceGroup
s {$sel:configurationsVersion:InstanceGroup' :: Maybe Integer
configurationsVersion = Maybe Integer
a} :: InstanceGroup)

-- | The custom AMI ID to use for the provisioned instance group.
instanceGroup_customAmiId :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Text)
instanceGroup_customAmiId :: Lens' InstanceGroup (Maybe Text)
instanceGroup_customAmiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Text
customAmiId :: Maybe Text
$sel:customAmiId:InstanceGroup' :: InstanceGroup -> Maybe Text
customAmiId} -> Maybe Text
customAmiId) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Text
a -> InstanceGroup
s {$sel:customAmiId:InstanceGroup' :: Maybe Text
customAmiId = Maybe Text
a} :: InstanceGroup)

-- | The EBS block devices that are mapped to this instance group.
instanceGroup_ebsBlockDevices :: Lens.Lens' InstanceGroup (Prelude.Maybe [EbsBlockDevice])
instanceGroup_ebsBlockDevices :: Lens' InstanceGroup (Maybe [EbsBlockDevice])
instanceGroup_ebsBlockDevices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe [EbsBlockDevice]
ebsBlockDevices :: Maybe [EbsBlockDevice]
$sel:ebsBlockDevices:InstanceGroup' :: InstanceGroup -> Maybe [EbsBlockDevice]
ebsBlockDevices} -> Maybe [EbsBlockDevice]
ebsBlockDevices) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe [EbsBlockDevice]
a -> InstanceGroup
s {$sel:ebsBlockDevices:InstanceGroup' :: Maybe [EbsBlockDevice]
ebsBlockDevices = Maybe [EbsBlockDevice]
a} :: InstanceGroup) 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

-- | If the instance group is EBS-optimized. An Amazon EBS-optimized instance
-- uses an optimized configuration stack and provides additional, dedicated
-- capacity for Amazon EBS I\/O.
instanceGroup_ebsOptimized :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Bool)
instanceGroup_ebsOptimized :: Lens' InstanceGroup (Maybe Bool)
instanceGroup_ebsOptimized = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Bool
ebsOptimized :: Maybe Bool
$sel:ebsOptimized:InstanceGroup' :: InstanceGroup -> Maybe Bool
ebsOptimized} -> Maybe Bool
ebsOptimized) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Bool
a -> InstanceGroup
s {$sel:ebsOptimized:InstanceGroup' :: Maybe Bool
ebsOptimized = Maybe Bool
a} :: InstanceGroup)

-- | The identifier of the instance group.
instanceGroup_id :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Text)
instanceGroup_id :: Lens' InstanceGroup (Maybe Text)
instanceGroup_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Text
id :: Maybe Text
$sel:id:InstanceGroup' :: InstanceGroup -> Maybe Text
id} -> Maybe Text
id) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Text
a -> InstanceGroup
s {$sel:id:InstanceGroup' :: Maybe Text
id = Maybe Text
a} :: InstanceGroup)

-- | The type of the instance group. Valid values are MASTER, CORE or TASK.
instanceGroup_instanceGroupType :: Lens.Lens' InstanceGroup (Prelude.Maybe InstanceGroupType)
instanceGroup_instanceGroupType :: Lens' InstanceGroup (Maybe InstanceGroupType)
instanceGroup_instanceGroupType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe InstanceGroupType
instanceGroupType :: Maybe InstanceGroupType
$sel:instanceGroupType:InstanceGroup' :: InstanceGroup -> Maybe InstanceGroupType
instanceGroupType} -> Maybe InstanceGroupType
instanceGroupType) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe InstanceGroupType
a -> InstanceGroup
s {$sel:instanceGroupType:InstanceGroup' :: Maybe InstanceGroupType
instanceGroupType = Maybe InstanceGroupType
a} :: InstanceGroup)

-- | The EC2 instance type for all instances in the instance group.
instanceGroup_instanceType :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Text)
instanceGroup_instanceType :: Lens' InstanceGroup (Maybe Text)
instanceGroup_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Text
instanceType :: Maybe Text
$sel:instanceType:InstanceGroup' :: InstanceGroup -> Maybe Text
instanceType} -> Maybe Text
instanceType) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Text
a -> InstanceGroup
s {$sel:instanceType:InstanceGroup' :: Maybe Text
instanceType = Maybe Text
a} :: InstanceGroup)

-- | A list of configurations that were successfully applied for an instance
-- group last time.
instanceGroup_lastSuccessfullyAppliedConfigurations :: Lens.Lens' InstanceGroup (Prelude.Maybe [Configuration])
instanceGroup_lastSuccessfullyAppliedConfigurations :: Lens' InstanceGroup (Maybe [Configuration])
instanceGroup_lastSuccessfullyAppliedConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe [Configuration]
lastSuccessfullyAppliedConfigurations :: Maybe [Configuration]
$sel:lastSuccessfullyAppliedConfigurations:InstanceGroup' :: InstanceGroup -> Maybe [Configuration]
lastSuccessfullyAppliedConfigurations} -> Maybe [Configuration]
lastSuccessfullyAppliedConfigurations) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe [Configuration]
a -> InstanceGroup
s {$sel:lastSuccessfullyAppliedConfigurations:InstanceGroup' :: Maybe [Configuration]
lastSuccessfullyAppliedConfigurations = Maybe [Configuration]
a} :: InstanceGroup) 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 version number of a configuration specification that was
-- successfully applied for an instance group last time.
instanceGroup_lastSuccessfullyAppliedConfigurationsVersion :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Integer)
instanceGroup_lastSuccessfullyAppliedConfigurationsVersion :: Lens' InstanceGroup (Maybe Integer)
instanceGroup_lastSuccessfullyAppliedConfigurationsVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Integer
lastSuccessfullyAppliedConfigurationsVersion :: Maybe Integer
$sel:lastSuccessfullyAppliedConfigurationsVersion:InstanceGroup' :: InstanceGroup -> Maybe Integer
lastSuccessfullyAppliedConfigurationsVersion} -> Maybe Integer
lastSuccessfullyAppliedConfigurationsVersion) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Integer
a -> InstanceGroup
s {$sel:lastSuccessfullyAppliedConfigurationsVersion:InstanceGroup' :: Maybe Integer
lastSuccessfullyAppliedConfigurationsVersion = Maybe Integer
a} :: InstanceGroup)

-- | The marketplace to provision instances for this group. Valid values are
-- ON_DEMAND or SPOT.
instanceGroup_market :: Lens.Lens' InstanceGroup (Prelude.Maybe MarketType)
instanceGroup_market :: Lens' InstanceGroup (Maybe MarketType)
instanceGroup_market = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe MarketType
market :: Maybe MarketType
$sel:market:InstanceGroup' :: InstanceGroup -> Maybe MarketType
market} -> Maybe MarketType
market) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe MarketType
a -> InstanceGroup
s {$sel:market:InstanceGroup' :: Maybe MarketType
market = Maybe MarketType
a} :: InstanceGroup)

-- | The name of the instance group.
instanceGroup_name :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Text)
instanceGroup_name :: Lens' InstanceGroup (Maybe Text)
instanceGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Text
name :: Maybe Text
$sel:name:InstanceGroup' :: InstanceGroup -> Maybe Text
name} -> Maybe Text
name) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Text
a -> InstanceGroup
s {$sel:name:InstanceGroup' :: Maybe Text
name = Maybe Text
a} :: InstanceGroup)

-- | The target number of instances for the instance group.
instanceGroup_requestedInstanceCount :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Int)
instanceGroup_requestedInstanceCount :: Lens' InstanceGroup (Maybe Int)
instanceGroup_requestedInstanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Int
requestedInstanceCount :: Maybe Int
$sel:requestedInstanceCount:InstanceGroup' :: InstanceGroup -> Maybe Int
requestedInstanceCount} -> Maybe Int
requestedInstanceCount) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Int
a -> InstanceGroup
s {$sel:requestedInstanceCount:InstanceGroup' :: Maybe Int
requestedInstanceCount = Maybe Int
a} :: InstanceGroup)

-- | The number of instances currently running in this instance group.
instanceGroup_runningInstanceCount :: Lens.Lens' InstanceGroup (Prelude.Maybe Prelude.Int)
instanceGroup_runningInstanceCount :: Lens' InstanceGroup (Maybe Int)
instanceGroup_runningInstanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe Int
runningInstanceCount :: Maybe Int
$sel:runningInstanceCount:InstanceGroup' :: InstanceGroup -> Maybe Int
runningInstanceCount} -> Maybe Int
runningInstanceCount) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe Int
a -> InstanceGroup
s {$sel:runningInstanceCount:InstanceGroup' :: Maybe Int
runningInstanceCount = Maybe Int
a} :: InstanceGroup)

-- | Policy for customizing shrink operations.
instanceGroup_shrinkPolicy :: Lens.Lens' InstanceGroup (Prelude.Maybe ShrinkPolicy)
instanceGroup_shrinkPolicy :: Lens' InstanceGroup (Maybe ShrinkPolicy)
instanceGroup_shrinkPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe ShrinkPolicy
shrinkPolicy :: Maybe ShrinkPolicy
$sel:shrinkPolicy:InstanceGroup' :: InstanceGroup -> Maybe ShrinkPolicy
shrinkPolicy} -> Maybe ShrinkPolicy
shrinkPolicy) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe ShrinkPolicy
a -> InstanceGroup
s {$sel:shrinkPolicy:InstanceGroup' :: Maybe ShrinkPolicy
shrinkPolicy = Maybe ShrinkPolicy
a} :: InstanceGroup)

-- | The current status of the instance group.
instanceGroup_status :: Lens.Lens' InstanceGroup (Prelude.Maybe InstanceGroupStatus)
instanceGroup_status :: Lens' InstanceGroup (Maybe InstanceGroupStatus)
instanceGroup_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroup' {Maybe InstanceGroupStatus
status :: Maybe InstanceGroupStatus
$sel:status:InstanceGroup' :: InstanceGroup -> Maybe InstanceGroupStatus
status} -> Maybe InstanceGroupStatus
status) (\s :: InstanceGroup
s@InstanceGroup' {} Maybe InstanceGroupStatus
a -> InstanceGroup
s {$sel:status:InstanceGroup' :: Maybe InstanceGroupStatus
status = Maybe InstanceGroupStatus
a} :: InstanceGroup)

instance Data.FromJSON InstanceGroup where
  parseJSON :: Value -> Parser InstanceGroup
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"InstanceGroup"
      ( \Object
x ->
          Maybe AutoScalingPolicyDescription
-> Maybe Text
-> Maybe [Configuration]
-> Maybe Integer
-> Maybe Text
-> Maybe [EbsBlockDevice]
-> Maybe Bool
-> Maybe Text
-> Maybe InstanceGroupType
-> Maybe Text
-> Maybe [Configuration]
-> Maybe Integer
-> Maybe MarketType
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe ShrinkPolicy
-> Maybe InstanceGroupStatus
-> InstanceGroup
InstanceGroup'
            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
"AutoScalingPolicy")
            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
"BidPrice")
            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
"ConfigurationsVersion")
            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
"EbsBlockDevices"
                            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
"EbsOptimized")
            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
"Id")
            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
"InstanceGroupType")
            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
"InstanceType")
            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
"LastSuccessfullyAppliedConfigurations"
                            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
"LastSuccessfullyAppliedConfigurationsVersion"
                        )
            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
"Market")
            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
"RequestedInstanceCount")
            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
"RunningInstanceCount")
            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
"ShrinkPolicy")
            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")
      )

instance Prelude.Hashable InstanceGroup where
  hashWithSalt :: Int -> InstanceGroup -> Int
hashWithSalt Int
_salt InstanceGroup' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Configuration]
Maybe [EbsBlockDevice]
Maybe Text
Maybe InstanceGroupStatus
Maybe InstanceGroupType
Maybe MarketType
Maybe ShrinkPolicy
Maybe AutoScalingPolicyDescription
status :: Maybe InstanceGroupStatus
shrinkPolicy :: Maybe ShrinkPolicy
runningInstanceCount :: Maybe Int
requestedInstanceCount :: Maybe Int
name :: Maybe Text
market :: Maybe MarketType
lastSuccessfullyAppliedConfigurationsVersion :: Maybe Integer
lastSuccessfullyAppliedConfigurations :: Maybe [Configuration]
instanceType :: Maybe Text
instanceGroupType :: Maybe InstanceGroupType
id :: Maybe Text
ebsOptimized :: Maybe Bool
ebsBlockDevices :: Maybe [EbsBlockDevice]
customAmiId :: Maybe Text
configurationsVersion :: Maybe Integer
configurations :: Maybe [Configuration]
bidPrice :: Maybe Text
autoScalingPolicy :: Maybe AutoScalingPolicyDescription
$sel:status:InstanceGroup' :: InstanceGroup -> Maybe InstanceGroupStatus
$sel:shrinkPolicy:InstanceGroup' :: InstanceGroup -> Maybe ShrinkPolicy
$sel:runningInstanceCount:InstanceGroup' :: InstanceGroup -> Maybe Int
$sel:requestedInstanceCount:InstanceGroup' :: InstanceGroup -> Maybe Int
$sel:name:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:market:InstanceGroup' :: InstanceGroup -> Maybe MarketType
$sel:lastSuccessfullyAppliedConfigurationsVersion:InstanceGroup' :: InstanceGroup -> Maybe Integer
$sel:lastSuccessfullyAppliedConfigurations:InstanceGroup' :: InstanceGroup -> Maybe [Configuration]
$sel:instanceType:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:instanceGroupType:InstanceGroup' :: InstanceGroup -> Maybe InstanceGroupType
$sel:id:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:ebsOptimized:InstanceGroup' :: InstanceGroup -> Maybe Bool
$sel:ebsBlockDevices:InstanceGroup' :: InstanceGroup -> Maybe [EbsBlockDevice]
$sel:customAmiId:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:configurationsVersion:InstanceGroup' :: InstanceGroup -> Maybe Integer
$sel:configurations:InstanceGroup' :: InstanceGroup -> Maybe [Configuration]
$sel:bidPrice:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:autoScalingPolicy:InstanceGroup' :: InstanceGroup -> Maybe AutoScalingPolicyDescription
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoScalingPolicyDescription
autoScalingPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bidPrice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Configuration]
configurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
configurationsVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customAmiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EbsBlockDevice]
ebsBlockDevices
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ebsOptimized
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceGroupType
instanceGroupType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Configuration]
lastSuccessfullyAppliedConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Integer
lastSuccessfullyAppliedConfigurationsVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MarketType
market
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
requestedInstanceCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
runningInstanceCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ShrinkPolicy
shrinkPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceGroupStatus
status

instance Prelude.NFData InstanceGroup where
  rnf :: InstanceGroup -> ()
rnf InstanceGroup' {Maybe Bool
Maybe Int
Maybe Integer
Maybe [Configuration]
Maybe [EbsBlockDevice]
Maybe Text
Maybe InstanceGroupStatus
Maybe InstanceGroupType
Maybe MarketType
Maybe ShrinkPolicy
Maybe AutoScalingPolicyDescription
status :: Maybe InstanceGroupStatus
shrinkPolicy :: Maybe ShrinkPolicy
runningInstanceCount :: Maybe Int
requestedInstanceCount :: Maybe Int
name :: Maybe Text
market :: Maybe MarketType
lastSuccessfullyAppliedConfigurationsVersion :: Maybe Integer
lastSuccessfullyAppliedConfigurations :: Maybe [Configuration]
instanceType :: Maybe Text
instanceGroupType :: Maybe InstanceGroupType
id :: Maybe Text
ebsOptimized :: Maybe Bool
ebsBlockDevices :: Maybe [EbsBlockDevice]
customAmiId :: Maybe Text
configurationsVersion :: Maybe Integer
configurations :: Maybe [Configuration]
bidPrice :: Maybe Text
autoScalingPolicy :: Maybe AutoScalingPolicyDescription
$sel:status:InstanceGroup' :: InstanceGroup -> Maybe InstanceGroupStatus
$sel:shrinkPolicy:InstanceGroup' :: InstanceGroup -> Maybe ShrinkPolicy
$sel:runningInstanceCount:InstanceGroup' :: InstanceGroup -> Maybe Int
$sel:requestedInstanceCount:InstanceGroup' :: InstanceGroup -> Maybe Int
$sel:name:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:market:InstanceGroup' :: InstanceGroup -> Maybe MarketType
$sel:lastSuccessfullyAppliedConfigurationsVersion:InstanceGroup' :: InstanceGroup -> Maybe Integer
$sel:lastSuccessfullyAppliedConfigurations:InstanceGroup' :: InstanceGroup -> Maybe [Configuration]
$sel:instanceType:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:instanceGroupType:InstanceGroup' :: InstanceGroup -> Maybe InstanceGroupType
$sel:id:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:ebsOptimized:InstanceGroup' :: InstanceGroup -> Maybe Bool
$sel:ebsBlockDevices:InstanceGroup' :: InstanceGroup -> Maybe [EbsBlockDevice]
$sel:customAmiId:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:configurationsVersion:InstanceGroup' :: InstanceGroup -> Maybe Integer
$sel:configurations:InstanceGroup' :: InstanceGroup -> Maybe [Configuration]
$sel:bidPrice:InstanceGroup' :: InstanceGroup -> Maybe Text
$sel:autoScalingPolicy:InstanceGroup' :: InstanceGroup -> Maybe AutoScalingPolicyDescription
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoScalingPolicyDescription
autoScalingPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bidPrice
      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 Integer
configurationsVersion
      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 [EbsBlockDevice]
ebsBlockDevices
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ebsOptimized
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceGroupType
instanceGroupType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe [Configuration]
lastSuccessfullyAppliedConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Integer
lastSuccessfullyAppliedConfigurationsVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MarketType
market
      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 Int
requestedInstanceCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
runningInstanceCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ShrinkPolicy
shrinkPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceGroupStatus
status