{-# 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.InstanceFleetConfig
-- 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.InstanceFleetConfig 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.InstanceFleetProvisioningSpecifications
import Amazonka.EMR.Types.InstanceFleetType
import Amazonka.EMR.Types.InstanceTypeConfig
import qualified Amazonka.Prelude as Prelude

-- | The configuration that defines an instance fleet.
--
-- The instance fleet configuration is available only in Amazon EMR
-- versions 4.8.0 and later, excluding 5.0.x versions.
--
-- /See:/ 'newInstanceFleetConfig' smart constructor.
data InstanceFleetConfig = InstanceFleetConfig'
  { -- | The instance type configurations that define the EC2 instances in the
    -- instance fleet.
    InstanceFleetConfig -> Maybe [InstanceTypeConfig]
instanceTypeConfigs :: Prelude.Maybe [InstanceTypeConfig],
    -- | The launch specification for the instance fleet.
    InstanceFleetConfig
-> Maybe InstanceFleetProvisioningSpecifications
launchSpecifications :: Prelude.Maybe InstanceFleetProvisioningSpecifications,
    -- | The friendly name of the instance fleet.
    InstanceFleetConfig -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The target capacity of On-Demand units for the instance fleet, which
    -- determines how many On-Demand Instances to provision. When the instance
    -- fleet launches, Amazon EMR tries to provision On-Demand Instances as
    -- specified by InstanceTypeConfig. Each instance configuration has a
    -- specified @WeightedCapacity@. When an On-Demand Instance is provisioned,
    -- the @WeightedCapacity@ units count toward the target capacity. Amazon
    -- EMR provisions instances until the target capacity is totally fulfilled,
    -- even if this results in an overage. For example, if there are 2 units
    -- remaining to fulfill capacity, and Amazon EMR can only provision an
    -- instance with a @WeightedCapacity@ of 5 units, the instance is
    -- provisioned, and the target capacity is exceeded by 3 units.
    --
    -- If not specified or set to 0, only Spot Instances are provisioned for
    -- the instance fleet using @TargetSpotCapacity@. At least one of
    -- @TargetSpotCapacity@ and @TargetOnDemandCapacity@ should be greater than
    -- 0. For a master instance fleet, only one of @TargetSpotCapacity@ and
    -- @TargetOnDemandCapacity@ can be specified, and its value must be 1.
    InstanceFleetConfig -> Maybe Natural
targetOnDemandCapacity :: Prelude.Maybe Prelude.Natural,
    -- | The target capacity of Spot units for the instance fleet, which
    -- determines how many Spot Instances to provision. When the instance fleet
    -- launches, Amazon EMR tries to provision Spot Instances as specified by
    -- InstanceTypeConfig. Each instance configuration has a specified
    -- @WeightedCapacity@. When a Spot Instance is provisioned, the
    -- @WeightedCapacity@ units count toward the target capacity. Amazon EMR
    -- provisions instances until the target capacity is totally fulfilled,
    -- even if this results in an overage. For example, if there are 2 units
    -- remaining to fulfill capacity, and Amazon EMR can only provision an
    -- instance with a @WeightedCapacity@ of 5 units, the instance is
    -- provisioned, and the target capacity is exceeded by 3 units.
    --
    -- If not specified or set to 0, only On-Demand Instances are provisioned
    -- for the instance fleet. At least one of @TargetSpotCapacity@ and
    -- @TargetOnDemandCapacity@ should be greater than 0. For a master instance
    -- fleet, only one of @TargetSpotCapacity@ and @TargetOnDemandCapacity@ can
    -- be specified, and its value must be 1.
    InstanceFleetConfig -> Maybe Natural
targetSpotCapacity :: Prelude.Maybe Prelude.Natural,
    -- | The node type that the instance fleet hosts. Valid values are MASTER,
    -- CORE, and TASK.
    InstanceFleetConfig -> InstanceFleetType
instanceFleetType :: InstanceFleetType
  }
  deriving (InstanceFleetConfig -> InstanceFleetConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstanceFleetConfig -> InstanceFleetConfig -> Bool
$c/= :: InstanceFleetConfig -> InstanceFleetConfig -> Bool
== :: InstanceFleetConfig -> InstanceFleetConfig -> Bool
$c== :: InstanceFleetConfig -> InstanceFleetConfig -> Bool
Prelude.Eq, ReadPrec [InstanceFleetConfig]
ReadPrec InstanceFleetConfig
Int -> ReadS InstanceFleetConfig
ReadS [InstanceFleetConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstanceFleetConfig]
$creadListPrec :: ReadPrec [InstanceFleetConfig]
readPrec :: ReadPrec InstanceFleetConfig
$creadPrec :: ReadPrec InstanceFleetConfig
readList :: ReadS [InstanceFleetConfig]
$creadList :: ReadS [InstanceFleetConfig]
readsPrec :: Int -> ReadS InstanceFleetConfig
$creadsPrec :: Int -> ReadS InstanceFleetConfig
Prelude.Read, Int -> InstanceFleetConfig -> ShowS
[InstanceFleetConfig] -> ShowS
InstanceFleetConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstanceFleetConfig] -> ShowS
$cshowList :: [InstanceFleetConfig] -> ShowS
show :: InstanceFleetConfig -> String
$cshow :: InstanceFleetConfig -> String
showsPrec :: Int -> InstanceFleetConfig -> ShowS
$cshowsPrec :: Int -> InstanceFleetConfig -> ShowS
Prelude.Show, forall x. Rep InstanceFleetConfig x -> InstanceFleetConfig
forall x. InstanceFleetConfig -> Rep InstanceFleetConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstanceFleetConfig x -> InstanceFleetConfig
$cfrom :: forall x. InstanceFleetConfig -> Rep InstanceFleetConfig x
Prelude.Generic)

-- |
-- Create a value of 'InstanceFleetConfig' 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:
--
-- 'instanceTypeConfigs', 'instanceFleetConfig_instanceTypeConfigs' - The instance type configurations that define the EC2 instances in the
-- instance fleet.
--
-- 'launchSpecifications', 'instanceFleetConfig_launchSpecifications' - The launch specification for the instance fleet.
--
-- 'name', 'instanceFleetConfig_name' - The friendly name of the instance fleet.
--
-- 'targetOnDemandCapacity', 'instanceFleetConfig_targetOnDemandCapacity' - The target capacity of On-Demand units for the instance fleet, which
-- determines how many On-Demand Instances to provision. When the instance
-- fleet launches, Amazon EMR tries to provision On-Demand Instances as
-- specified by InstanceTypeConfig. Each instance configuration has a
-- specified @WeightedCapacity@. When an On-Demand Instance is provisioned,
-- the @WeightedCapacity@ units count toward the target capacity. Amazon
-- EMR provisions instances until the target capacity is totally fulfilled,
-- even if this results in an overage. For example, if there are 2 units
-- remaining to fulfill capacity, and Amazon EMR can only provision an
-- instance with a @WeightedCapacity@ of 5 units, the instance is
-- provisioned, and the target capacity is exceeded by 3 units.
--
-- If not specified or set to 0, only Spot Instances are provisioned for
-- the instance fleet using @TargetSpotCapacity@. At least one of
-- @TargetSpotCapacity@ and @TargetOnDemandCapacity@ should be greater than
-- 0. For a master instance fleet, only one of @TargetSpotCapacity@ and
-- @TargetOnDemandCapacity@ can be specified, and its value must be 1.
--
-- 'targetSpotCapacity', 'instanceFleetConfig_targetSpotCapacity' - The target capacity of Spot units for the instance fleet, which
-- determines how many Spot Instances to provision. When the instance fleet
-- launches, Amazon EMR tries to provision Spot Instances as specified by
-- InstanceTypeConfig. Each instance configuration has a specified
-- @WeightedCapacity@. When a Spot Instance is provisioned, the
-- @WeightedCapacity@ units count toward the target capacity. Amazon EMR
-- provisions instances until the target capacity is totally fulfilled,
-- even if this results in an overage. For example, if there are 2 units
-- remaining to fulfill capacity, and Amazon EMR can only provision an
-- instance with a @WeightedCapacity@ of 5 units, the instance is
-- provisioned, and the target capacity is exceeded by 3 units.
--
-- If not specified or set to 0, only On-Demand Instances are provisioned
-- for the instance fleet. At least one of @TargetSpotCapacity@ and
-- @TargetOnDemandCapacity@ should be greater than 0. For a master instance
-- fleet, only one of @TargetSpotCapacity@ and @TargetOnDemandCapacity@ can
-- be specified, and its value must be 1.
--
-- 'instanceFleetType', 'instanceFleetConfig_instanceFleetType' - The node type that the instance fleet hosts. Valid values are MASTER,
-- CORE, and TASK.
newInstanceFleetConfig ::
  -- | 'instanceFleetType'
  InstanceFleetType ->
  InstanceFleetConfig
newInstanceFleetConfig :: InstanceFleetType -> InstanceFleetConfig
newInstanceFleetConfig InstanceFleetType
pInstanceFleetType_ =
  InstanceFleetConfig'
    { $sel:instanceTypeConfigs:InstanceFleetConfig' :: Maybe [InstanceTypeConfig]
instanceTypeConfigs =
        forall a. Maybe a
Prelude.Nothing,
      $sel:launchSpecifications:InstanceFleetConfig' :: Maybe InstanceFleetProvisioningSpecifications
launchSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:name:InstanceFleetConfig' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:targetOnDemandCapacity:InstanceFleetConfig' :: Maybe Natural
targetOnDemandCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:targetSpotCapacity:InstanceFleetConfig' :: Maybe Natural
targetSpotCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceFleetType:InstanceFleetConfig' :: InstanceFleetType
instanceFleetType = InstanceFleetType
pInstanceFleetType_
    }

-- | The instance type configurations that define the EC2 instances in the
-- instance fleet.
instanceFleetConfig_instanceTypeConfigs :: Lens.Lens' InstanceFleetConfig (Prelude.Maybe [InstanceTypeConfig])
instanceFleetConfig_instanceTypeConfigs :: Lens' InstanceFleetConfig (Maybe [InstanceTypeConfig])
instanceFleetConfig_instanceTypeConfigs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceFleetConfig' {Maybe [InstanceTypeConfig]
instanceTypeConfigs :: Maybe [InstanceTypeConfig]
$sel:instanceTypeConfigs:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe [InstanceTypeConfig]
instanceTypeConfigs} -> Maybe [InstanceTypeConfig]
instanceTypeConfigs) (\s :: InstanceFleetConfig
s@InstanceFleetConfig' {} Maybe [InstanceTypeConfig]
a -> InstanceFleetConfig
s {$sel:instanceTypeConfigs:InstanceFleetConfig' :: Maybe [InstanceTypeConfig]
instanceTypeConfigs = Maybe [InstanceTypeConfig]
a} :: InstanceFleetConfig) 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 launch specification for the instance fleet.
instanceFleetConfig_launchSpecifications :: Lens.Lens' InstanceFleetConfig (Prelude.Maybe InstanceFleetProvisioningSpecifications)
instanceFleetConfig_launchSpecifications :: Lens'
  InstanceFleetConfig (Maybe InstanceFleetProvisioningSpecifications)
instanceFleetConfig_launchSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceFleetConfig' {Maybe InstanceFleetProvisioningSpecifications
launchSpecifications :: Maybe InstanceFleetProvisioningSpecifications
$sel:launchSpecifications:InstanceFleetConfig' :: InstanceFleetConfig
-> Maybe InstanceFleetProvisioningSpecifications
launchSpecifications} -> Maybe InstanceFleetProvisioningSpecifications
launchSpecifications) (\s :: InstanceFleetConfig
s@InstanceFleetConfig' {} Maybe InstanceFleetProvisioningSpecifications
a -> InstanceFleetConfig
s {$sel:launchSpecifications:InstanceFleetConfig' :: Maybe InstanceFleetProvisioningSpecifications
launchSpecifications = Maybe InstanceFleetProvisioningSpecifications
a} :: InstanceFleetConfig)

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

-- | The target capacity of On-Demand units for the instance fleet, which
-- determines how many On-Demand Instances to provision. When the instance
-- fleet launches, Amazon EMR tries to provision On-Demand Instances as
-- specified by InstanceTypeConfig. Each instance configuration has a
-- specified @WeightedCapacity@. When an On-Demand Instance is provisioned,
-- the @WeightedCapacity@ units count toward the target capacity. Amazon
-- EMR provisions instances until the target capacity is totally fulfilled,
-- even if this results in an overage. For example, if there are 2 units
-- remaining to fulfill capacity, and Amazon EMR can only provision an
-- instance with a @WeightedCapacity@ of 5 units, the instance is
-- provisioned, and the target capacity is exceeded by 3 units.
--
-- If not specified or set to 0, only Spot Instances are provisioned for
-- the instance fleet using @TargetSpotCapacity@. At least one of
-- @TargetSpotCapacity@ and @TargetOnDemandCapacity@ should be greater than
-- 0. For a master instance fleet, only one of @TargetSpotCapacity@ and
-- @TargetOnDemandCapacity@ can be specified, and its value must be 1.
instanceFleetConfig_targetOnDemandCapacity :: Lens.Lens' InstanceFleetConfig (Prelude.Maybe Prelude.Natural)
instanceFleetConfig_targetOnDemandCapacity :: Lens' InstanceFleetConfig (Maybe Natural)
instanceFleetConfig_targetOnDemandCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceFleetConfig' {Maybe Natural
targetOnDemandCapacity :: Maybe Natural
$sel:targetOnDemandCapacity:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Natural
targetOnDemandCapacity} -> Maybe Natural
targetOnDemandCapacity) (\s :: InstanceFleetConfig
s@InstanceFleetConfig' {} Maybe Natural
a -> InstanceFleetConfig
s {$sel:targetOnDemandCapacity:InstanceFleetConfig' :: Maybe Natural
targetOnDemandCapacity = Maybe Natural
a} :: InstanceFleetConfig)

-- | The target capacity of Spot units for the instance fleet, which
-- determines how many Spot Instances to provision. When the instance fleet
-- launches, Amazon EMR tries to provision Spot Instances as specified by
-- InstanceTypeConfig. Each instance configuration has a specified
-- @WeightedCapacity@. When a Spot Instance is provisioned, the
-- @WeightedCapacity@ units count toward the target capacity. Amazon EMR
-- provisions instances until the target capacity is totally fulfilled,
-- even if this results in an overage. For example, if there are 2 units
-- remaining to fulfill capacity, and Amazon EMR can only provision an
-- instance with a @WeightedCapacity@ of 5 units, the instance is
-- provisioned, and the target capacity is exceeded by 3 units.
--
-- If not specified or set to 0, only On-Demand Instances are provisioned
-- for the instance fleet. At least one of @TargetSpotCapacity@ and
-- @TargetOnDemandCapacity@ should be greater than 0. For a master instance
-- fleet, only one of @TargetSpotCapacity@ and @TargetOnDemandCapacity@ can
-- be specified, and its value must be 1.
instanceFleetConfig_targetSpotCapacity :: Lens.Lens' InstanceFleetConfig (Prelude.Maybe Prelude.Natural)
instanceFleetConfig_targetSpotCapacity :: Lens' InstanceFleetConfig (Maybe Natural)
instanceFleetConfig_targetSpotCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceFleetConfig' {Maybe Natural
targetSpotCapacity :: Maybe Natural
$sel:targetSpotCapacity:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Natural
targetSpotCapacity} -> Maybe Natural
targetSpotCapacity) (\s :: InstanceFleetConfig
s@InstanceFleetConfig' {} Maybe Natural
a -> InstanceFleetConfig
s {$sel:targetSpotCapacity:InstanceFleetConfig' :: Maybe Natural
targetSpotCapacity = Maybe Natural
a} :: InstanceFleetConfig)

-- | The node type that the instance fleet hosts. Valid values are MASTER,
-- CORE, and TASK.
instanceFleetConfig_instanceFleetType :: Lens.Lens' InstanceFleetConfig InstanceFleetType
instanceFleetConfig_instanceFleetType :: Lens' InstanceFleetConfig InstanceFleetType
instanceFleetConfig_instanceFleetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstanceFleetConfig' {InstanceFleetType
instanceFleetType :: InstanceFleetType
$sel:instanceFleetType:InstanceFleetConfig' :: InstanceFleetConfig -> InstanceFleetType
instanceFleetType} -> InstanceFleetType
instanceFleetType) (\s :: InstanceFleetConfig
s@InstanceFleetConfig' {} InstanceFleetType
a -> InstanceFleetConfig
s {$sel:instanceFleetType:InstanceFleetConfig' :: InstanceFleetType
instanceFleetType = InstanceFleetType
a} :: InstanceFleetConfig)

instance Prelude.Hashable InstanceFleetConfig where
  hashWithSalt :: Int -> InstanceFleetConfig -> Int
hashWithSalt Int
_salt InstanceFleetConfig' {Maybe Natural
Maybe [InstanceTypeConfig]
Maybe Text
Maybe InstanceFleetProvisioningSpecifications
InstanceFleetType
instanceFleetType :: InstanceFleetType
targetSpotCapacity :: Maybe Natural
targetOnDemandCapacity :: Maybe Natural
name :: Maybe Text
launchSpecifications :: Maybe InstanceFleetProvisioningSpecifications
instanceTypeConfigs :: Maybe [InstanceTypeConfig]
$sel:instanceFleetType:InstanceFleetConfig' :: InstanceFleetConfig -> InstanceFleetType
$sel:targetSpotCapacity:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Natural
$sel:targetOnDemandCapacity:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Natural
$sel:name:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Text
$sel:launchSpecifications:InstanceFleetConfig' :: InstanceFleetConfig
-> Maybe InstanceFleetProvisioningSpecifications
$sel:instanceTypeConfigs:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe [InstanceTypeConfig]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InstanceTypeConfig]
instanceTypeConfigs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceFleetProvisioningSpecifications
launchSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
targetOnDemandCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
targetSpotCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` InstanceFleetType
instanceFleetType

instance Prelude.NFData InstanceFleetConfig where
  rnf :: InstanceFleetConfig -> ()
rnf InstanceFleetConfig' {Maybe Natural
Maybe [InstanceTypeConfig]
Maybe Text
Maybe InstanceFleetProvisioningSpecifications
InstanceFleetType
instanceFleetType :: InstanceFleetType
targetSpotCapacity :: Maybe Natural
targetOnDemandCapacity :: Maybe Natural
name :: Maybe Text
launchSpecifications :: Maybe InstanceFleetProvisioningSpecifications
instanceTypeConfigs :: Maybe [InstanceTypeConfig]
$sel:instanceFleetType:InstanceFleetConfig' :: InstanceFleetConfig -> InstanceFleetType
$sel:targetSpotCapacity:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Natural
$sel:targetOnDemandCapacity:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Natural
$sel:name:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Text
$sel:launchSpecifications:InstanceFleetConfig' :: InstanceFleetConfig
-> Maybe InstanceFleetProvisioningSpecifications
$sel:instanceTypeConfigs:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe [InstanceTypeConfig]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceTypeConfig]
instanceTypeConfigs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceFleetProvisioningSpecifications
launchSpecifications
      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 Natural
targetOnDemandCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
targetSpotCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf InstanceFleetType
instanceFleetType

instance Data.ToJSON InstanceFleetConfig where
  toJSON :: InstanceFleetConfig -> Value
toJSON InstanceFleetConfig' {Maybe Natural
Maybe [InstanceTypeConfig]
Maybe Text
Maybe InstanceFleetProvisioningSpecifications
InstanceFleetType
instanceFleetType :: InstanceFleetType
targetSpotCapacity :: Maybe Natural
targetOnDemandCapacity :: Maybe Natural
name :: Maybe Text
launchSpecifications :: Maybe InstanceFleetProvisioningSpecifications
instanceTypeConfigs :: Maybe [InstanceTypeConfig]
$sel:instanceFleetType:InstanceFleetConfig' :: InstanceFleetConfig -> InstanceFleetType
$sel:targetSpotCapacity:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Natural
$sel:targetOnDemandCapacity:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Natural
$sel:name:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe Text
$sel:launchSpecifications:InstanceFleetConfig' :: InstanceFleetConfig
-> Maybe InstanceFleetProvisioningSpecifications
$sel:instanceTypeConfigs:InstanceFleetConfig' :: InstanceFleetConfig -> Maybe [InstanceTypeConfig]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"InstanceTypeConfigs" 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 [InstanceTypeConfig]
instanceTypeConfigs,
            (Key
"LaunchSpecifications" 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 InstanceFleetProvisioningSpecifications
launchSpecifications,
            (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,
            (Key
"TargetOnDemandCapacity" 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 Natural
targetOnDemandCapacity,
            (Key
"TargetSpotCapacity" 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 Natural
targetSpotCapacity,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"InstanceFleetType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= InstanceFleetType
instanceFleetType)
          ]
      )