{-# 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.InstanceGroupConfig
-- 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.InstanceGroupConfig 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.AutoScalingPolicy
import Amazonka.EMR.Types.Configuration
import Amazonka.EMR.Types.EbsConfiguration
import Amazonka.EMR.Types.InstanceRoleType
import Amazonka.EMR.Types.MarketType
import qualified Amazonka.Prelude as Prelude

-- | Configuration defining a new instance group.
--
-- /See:/ 'newInstanceGroupConfig' smart constructor.
data InstanceGroupConfig = InstanceGroupConfig'
  { -- | 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.
    InstanceGroupConfig -> Maybe AutoScalingPolicy
autoScalingPolicy :: Prelude.Maybe AutoScalingPolicy,
    -- | 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.
    InstanceGroupConfig -> Maybe Text
bidPrice :: Prelude.Maybe Prelude.Text,
    -- | Amazon EMR releases 4.x or later.
    --
    -- The list of configurations supplied for an EMR cluster instance group.
    -- You can specify a separate configuration for each instance group
    -- (master, core, and task).
    InstanceGroupConfig -> Maybe [Configuration]
configurations :: Prelude.Maybe [Configuration],
    -- | The custom AMI ID to use for the provisioned instance group.
    InstanceGroupConfig -> Maybe Text
customAmiId :: Prelude.Maybe Prelude.Text,
    -- | EBS configurations that will be attached to each EC2 instance in the
    -- instance group.
    InstanceGroupConfig -> Maybe EbsConfiguration
ebsConfiguration :: Prelude.Maybe EbsConfiguration,
    -- | Market type of the EC2 instances used to create a cluster node.
    InstanceGroupConfig -> Maybe MarketType
market :: Prelude.Maybe MarketType,
    -- | Friendly name given to the instance group.
    InstanceGroupConfig -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The role of the instance group in the cluster.
    InstanceGroupConfig -> InstanceRoleType
instanceRole :: InstanceRoleType,
    -- | The EC2 instance type for all instances in the instance group.
    InstanceGroupConfig -> Text
instanceType :: Prelude.Text,
    -- | Target number of instances for the instance group.
    InstanceGroupConfig -> Int
instanceCount :: Prelude.Int
  }
  deriving (InstanceGroupConfig -> InstanceGroupConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceGroupConfig -> InstanceGroupConfig -> Bool
$c/= :: InstanceGroupConfig -> InstanceGroupConfig -> Bool
== :: InstanceGroupConfig -> InstanceGroupConfig -> Bool
$c== :: InstanceGroupConfig -> InstanceGroupConfig -> Bool
Prelude.Eq, ReadPrec [InstanceGroupConfig]
ReadPrec InstanceGroupConfig
Int -> ReadS InstanceGroupConfig
ReadS [InstanceGroupConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstanceGroupConfig]
$creadListPrec :: ReadPrec [InstanceGroupConfig]
readPrec :: ReadPrec InstanceGroupConfig
$creadPrec :: ReadPrec InstanceGroupConfig
readList :: ReadS [InstanceGroupConfig]
$creadList :: ReadS [InstanceGroupConfig]
readsPrec :: Int -> ReadS InstanceGroupConfig
$creadsPrec :: Int -> ReadS InstanceGroupConfig
Prelude.Read, Int -> InstanceGroupConfig -> ShowS
[InstanceGroupConfig] -> ShowS
InstanceGroupConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceGroupConfig] -> ShowS
$cshowList :: [InstanceGroupConfig] -> ShowS
show :: InstanceGroupConfig -> String
$cshow :: InstanceGroupConfig -> String
showsPrec :: Int -> InstanceGroupConfig -> ShowS
$cshowsPrec :: Int -> InstanceGroupConfig -> ShowS
Prelude.Show, forall x. Rep InstanceGroupConfig x -> InstanceGroupConfig
forall x. InstanceGroupConfig -> Rep InstanceGroupConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstanceGroupConfig x -> InstanceGroupConfig
$cfrom :: forall x. InstanceGroupConfig -> Rep InstanceGroupConfig x
Prelude.Generic)

-- |
-- Create a value of 'InstanceGroupConfig' 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', 'instanceGroupConfig_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', 'instanceGroupConfig_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', 'instanceGroupConfig_configurations' - Amazon EMR releases 4.x or later.
--
-- The list of configurations supplied for an EMR cluster instance group.
-- You can specify a separate configuration for each instance group
-- (master, core, and task).
--
-- 'customAmiId', 'instanceGroupConfig_customAmiId' - The custom AMI ID to use for the provisioned instance group.
--
-- 'ebsConfiguration', 'instanceGroupConfig_ebsConfiguration' - EBS configurations that will be attached to each EC2 instance in the
-- instance group.
--
-- 'market', 'instanceGroupConfig_market' - Market type of the EC2 instances used to create a cluster node.
--
-- 'name', 'instanceGroupConfig_name' - Friendly name given to the instance group.
--
-- 'instanceRole', 'instanceGroupConfig_instanceRole' - The role of the instance group in the cluster.
--
-- 'instanceType', 'instanceGroupConfig_instanceType' - The EC2 instance type for all instances in the instance group.
--
-- 'instanceCount', 'instanceGroupConfig_instanceCount' - Target number of instances for the instance group.
newInstanceGroupConfig ::
  -- | 'instanceRole'
  InstanceRoleType ->
  -- | 'instanceType'
  Prelude.Text ->
  -- | 'instanceCount'
  Prelude.Int ->
  InstanceGroupConfig
newInstanceGroupConfig :: InstanceRoleType -> Text -> Int -> InstanceGroupConfig
newInstanceGroupConfig
  InstanceRoleType
pInstanceRole_
  Text
pInstanceType_
  Int
pInstanceCount_ =
    InstanceGroupConfig'
      { $sel:autoScalingPolicy:InstanceGroupConfig' :: Maybe AutoScalingPolicy
autoScalingPolicy =
          forall a. Maybe a
Prelude.Nothing,
        $sel:bidPrice:InstanceGroupConfig' :: Maybe Text
bidPrice = forall a. Maybe a
Prelude.Nothing,
        $sel:configurations:InstanceGroupConfig' :: Maybe [Configuration]
configurations = forall a. Maybe a
Prelude.Nothing,
        $sel:customAmiId:InstanceGroupConfig' :: Maybe Text
customAmiId = forall a. Maybe a
Prelude.Nothing,
        $sel:ebsConfiguration:InstanceGroupConfig' :: Maybe EbsConfiguration
ebsConfiguration = forall a. Maybe a
Prelude.Nothing,
        $sel:market:InstanceGroupConfig' :: Maybe MarketType
market = forall a. Maybe a
Prelude.Nothing,
        $sel:name:InstanceGroupConfig' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:instanceRole:InstanceGroupConfig' :: InstanceRoleType
instanceRole = InstanceRoleType
pInstanceRole_,
        $sel:instanceType:InstanceGroupConfig' :: Text
instanceType = Text
pInstanceType_,
        $sel:instanceCount:InstanceGroupConfig' :: Int
instanceCount = Int
pInstanceCount_
      }

-- | 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.
instanceGroupConfig_autoScalingPolicy :: Lens.Lens' InstanceGroupConfig (Prelude.Maybe AutoScalingPolicy)
instanceGroupConfig_autoScalingPolicy :: Lens' InstanceGroupConfig (Maybe AutoScalingPolicy)
instanceGroupConfig_autoScalingPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {Maybe AutoScalingPolicy
autoScalingPolicy :: Maybe AutoScalingPolicy
$sel:autoScalingPolicy:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe AutoScalingPolicy
autoScalingPolicy} -> Maybe AutoScalingPolicy
autoScalingPolicy) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} Maybe AutoScalingPolicy
a -> InstanceGroupConfig
s {$sel:autoScalingPolicy:InstanceGroupConfig' :: Maybe AutoScalingPolicy
autoScalingPolicy = Maybe AutoScalingPolicy
a} :: InstanceGroupConfig)

-- | 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.
instanceGroupConfig_bidPrice :: Lens.Lens' InstanceGroupConfig (Prelude.Maybe Prelude.Text)
instanceGroupConfig_bidPrice :: Lens' InstanceGroupConfig (Maybe Text)
instanceGroupConfig_bidPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {Maybe Text
bidPrice :: Maybe Text
$sel:bidPrice:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
bidPrice} -> Maybe Text
bidPrice) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} Maybe Text
a -> InstanceGroupConfig
s {$sel:bidPrice:InstanceGroupConfig' :: Maybe Text
bidPrice = Maybe Text
a} :: InstanceGroupConfig)

-- | Amazon EMR releases 4.x or later.
--
-- The list of configurations supplied for an EMR cluster instance group.
-- You can specify a separate configuration for each instance group
-- (master, core, and task).
instanceGroupConfig_configurations :: Lens.Lens' InstanceGroupConfig (Prelude.Maybe [Configuration])
instanceGroupConfig_configurations :: Lens' InstanceGroupConfig (Maybe [Configuration])
instanceGroupConfig_configurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {Maybe [Configuration]
configurations :: Maybe [Configuration]
$sel:configurations:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe [Configuration]
configurations} -> Maybe [Configuration]
configurations) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} Maybe [Configuration]
a -> InstanceGroupConfig
s {$sel:configurations:InstanceGroupConfig' :: Maybe [Configuration]
configurations = Maybe [Configuration]
a} :: InstanceGroupConfig) 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 custom AMI ID to use for the provisioned instance group.
instanceGroupConfig_customAmiId :: Lens.Lens' InstanceGroupConfig (Prelude.Maybe Prelude.Text)
instanceGroupConfig_customAmiId :: Lens' InstanceGroupConfig (Maybe Text)
instanceGroupConfig_customAmiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {Maybe Text
customAmiId :: Maybe Text
$sel:customAmiId:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
customAmiId} -> Maybe Text
customAmiId) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} Maybe Text
a -> InstanceGroupConfig
s {$sel:customAmiId:InstanceGroupConfig' :: Maybe Text
customAmiId = Maybe Text
a} :: InstanceGroupConfig)

-- | EBS configurations that will be attached to each EC2 instance in the
-- instance group.
instanceGroupConfig_ebsConfiguration :: Lens.Lens' InstanceGroupConfig (Prelude.Maybe EbsConfiguration)
instanceGroupConfig_ebsConfiguration :: Lens' InstanceGroupConfig (Maybe EbsConfiguration)
instanceGroupConfig_ebsConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {Maybe EbsConfiguration
ebsConfiguration :: Maybe EbsConfiguration
$sel:ebsConfiguration:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe EbsConfiguration
ebsConfiguration} -> Maybe EbsConfiguration
ebsConfiguration) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} Maybe EbsConfiguration
a -> InstanceGroupConfig
s {$sel:ebsConfiguration:InstanceGroupConfig' :: Maybe EbsConfiguration
ebsConfiguration = Maybe EbsConfiguration
a} :: InstanceGroupConfig)

-- | Market type of the EC2 instances used to create a cluster node.
instanceGroupConfig_market :: Lens.Lens' InstanceGroupConfig (Prelude.Maybe MarketType)
instanceGroupConfig_market :: Lens' InstanceGroupConfig (Maybe MarketType)
instanceGroupConfig_market = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {Maybe MarketType
market :: Maybe MarketType
$sel:market:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe MarketType
market} -> Maybe MarketType
market) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} Maybe MarketType
a -> InstanceGroupConfig
s {$sel:market:InstanceGroupConfig' :: Maybe MarketType
market = Maybe MarketType
a} :: InstanceGroupConfig)

-- | Friendly name given to the instance group.
instanceGroupConfig_name :: Lens.Lens' InstanceGroupConfig (Prelude.Maybe Prelude.Text)
instanceGroupConfig_name :: Lens' InstanceGroupConfig (Maybe Text)
instanceGroupConfig_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {Maybe Text
name :: Maybe Text
$sel:name:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
name} -> Maybe Text
name) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} Maybe Text
a -> InstanceGroupConfig
s {$sel:name:InstanceGroupConfig' :: Maybe Text
name = Maybe Text
a} :: InstanceGroupConfig)

-- | The role of the instance group in the cluster.
instanceGroupConfig_instanceRole :: Lens.Lens' InstanceGroupConfig InstanceRoleType
instanceGroupConfig_instanceRole :: Lens' InstanceGroupConfig InstanceRoleType
instanceGroupConfig_instanceRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {InstanceRoleType
instanceRole :: InstanceRoleType
$sel:instanceRole:InstanceGroupConfig' :: InstanceGroupConfig -> InstanceRoleType
instanceRole} -> InstanceRoleType
instanceRole) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} InstanceRoleType
a -> InstanceGroupConfig
s {$sel:instanceRole:InstanceGroupConfig' :: InstanceRoleType
instanceRole = InstanceRoleType
a} :: InstanceGroupConfig)

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

-- | Target number of instances for the instance group.
instanceGroupConfig_instanceCount :: Lens.Lens' InstanceGroupConfig Prelude.Int
instanceGroupConfig_instanceCount :: Lens' InstanceGroupConfig Int
instanceGroupConfig_instanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceGroupConfig' {Int
instanceCount :: Int
$sel:instanceCount:InstanceGroupConfig' :: InstanceGroupConfig -> Int
instanceCount} -> Int
instanceCount) (\s :: InstanceGroupConfig
s@InstanceGroupConfig' {} Int
a -> InstanceGroupConfig
s {$sel:instanceCount:InstanceGroupConfig' :: Int
instanceCount = Int
a} :: InstanceGroupConfig)

instance Prelude.Hashable InstanceGroupConfig where
  hashWithSalt :: Int -> InstanceGroupConfig -> Int
hashWithSalt Int
_salt InstanceGroupConfig' {Int
Maybe [Configuration]
Maybe Text
Maybe MarketType
Maybe AutoScalingPolicy
Maybe EbsConfiguration
Text
InstanceRoleType
instanceCount :: Int
instanceType :: Text
instanceRole :: InstanceRoleType
name :: Maybe Text
market :: Maybe MarketType
ebsConfiguration :: Maybe EbsConfiguration
customAmiId :: Maybe Text
configurations :: Maybe [Configuration]
bidPrice :: Maybe Text
autoScalingPolicy :: Maybe AutoScalingPolicy
$sel:instanceCount:InstanceGroupConfig' :: InstanceGroupConfig -> Int
$sel:instanceType:InstanceGroupConfig' :: InstanceGroupConfig -> Text
$sel:instanceRole:InstanceGroupConfig' :: InstanceGroupConfig -> InstanceRoleType
$sel:name:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:market:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe MarketType
$sel:ebsConfiguration:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe EbsConfiguration
$sel:customAmiId:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:configurations:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe [Configuration]
$sel:bidPrice:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:autoScalingPolicy:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe AutoScalingPolicy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AutoScalingPolicy
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 Text
customAmiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EbsConfiguration
ebsConfiguration
      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` InstanceRoleType
instanceRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
instanceCount

instance Prelude.NFData InstanceGroupConfig where
  rnf :: InstanceGroupConfig -> ()
rnf InstanceGroupConfig' {Int
Maybe [Configuration]
Maybe Text
Maybe MarketType
Maybe AutoScalingPolicy
Maybe EbsConfiguration
Text
InstanceRoleType
instanceCount :: Int
instanceType :: Text
instanceRole :: InstanceRoleType
name :: Maybe Text
market :: Maybe MarketType
ebsConfiguration :: Maybe EbsConfiguration
customAmiId :: Maybe Text
configurations :: Maybe [Configuration]
bidPrice :: Maybe Text
autoScalingPolicy :: Maybe AutoScalingPolicy
$sel:instanceCount:InstanceGroupConfig' :: InstanceGroupConfig -> Int
$sel:instanceType:InstanceGroupConfig' :: InstanceGroupConfig -> Text
$sel:instanceRole:InstanceGroupConfig' :: InstanceGroupConfig -> InstanceRoleType
$sel:name:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:market:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe MarketType
$sel:ebsConfiguration:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe EbsConfiguration
$sel:customAmiId:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:configurations:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe [Configuration]
$sel:bidPrice:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:autoScalingPolicy:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe AutoScalingPolicy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AutoScalingPolicy
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 Text
customAmiId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EbsConfiguration
ebsConfiguration
      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 InstanceRoleType
instanceRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
instanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
instanceCount

instance Data.ToJSON InstanceGroupConfig where
  toJSON :: InstanceGroupConfig -> Value
toJSON InstanceGroupConfig' {Int
Maybe [Configuration]
Maybe Text
Maybe MarketType
Maybe AutoScalingPolicy
Maybe EbsConfiguration
Text
InstanceRoleType
instanceCount :: Int
instanceType :: Text
instanceRole :: InstanceRoleType
name :: Maybe Text
market :: Maybe MarketType
ebsConfiguration :: Maybe EbsConfiguration
customAmiId :: Maybe Text
configurations :: Maybe [Configuration]
bidPrice :: Maybe Text
autoScalingPolicy :: Maybe AutoScalingPolicy
$sel:instanceCount:InstanceGroupConfig' :: InstanceGroupConfig -> Int
$sel:instanceType:InstanceGroupConfig' :: InstanceGroupConfig -> Text
$sel:instanceRole:InstanceGroupConfig' :: InstanceGroupConfig -> InstanceRoleType
$sel:name:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:market:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe MarketType
$sel:ebsConfiguration:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe EbsConfiguration
$sel:customAmiId:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:configurations:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe [Configuration]
$sel:bidPrice:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe Text
$sel:autoScalingPolicy:InstanceGroupConfig' :: InstanceGroupConfig -> Maybe AutoScalingPolicy
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AutoScalingPolicy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe AutoScalingPolicy
autoScalingPolicy,
            (Key
"BidPrice" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
bidPrice,
            (Key
"Configurations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Configuration]
configurations,
            (Key
"CustomAmiId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
customAmiId,
            (Key
"EbsConfiguration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EbsConfiguration
ebsConfiguration,
            (Key
"Market" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MarketType
market,
            (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
name,
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceRole" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= InstanceRoleType
instanceRole),
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"InstanceCount" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Int
instanceCount)
          ]
      )