{-# 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.EC2.Types.SpotOptions
-- 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.EC2.Types.SpotOptions where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.FleetSpotMaintenanceStrategies
import Amazonka.EC2.Types.SpotAllocationStrategy
import Amazonka.EC2.Types.SpotInstanceInterruptionBehavior
import qualified Amazonka.Prelude as Prelude

-- | Describes the configuration of Spot Instances in an EC2 Fleet.
--
-- /See:/ 'newSpotOptions' smart constructor.
data SpotOptions = SpotOptions'
  { -- | The strategy that determines how to allocate the target Spot Instance
    -- capacity across the Spot Instance pools specified by the EC2 Fleet
    -- launch configuration. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-fleet-allocation-strategy.html Allocation strategies for Spot Instances>
    -- in the /Amazon EC2 User Guide/.
    --
    -- [price-capacity-optimized (recommended)]
    --     EC2 Fleet identifies the pools with the highest capacity
    --     availability for the number of instances that are launching. This
    --     means that we will request Spot Instances from the pools that we
    --     believe have the lowest chance of interruption in the near term. EC2
    --     Fleet then requests Spot Instances from the lowest priced of these
    --     pools.
    --
    -- [capacity-optimized]
    --     EC2 Fleet identifies the pools with the highest capacity
    --     availability for the number of instances that are launching. This
    --     means that we will request Spot Instances from the pools that we
    --     believe have the lowest chance of interruption in the near term. To
    --     give certain instance types a higher chance of launching first, use
    --     @capacity-optimized-prioritized@. Set a priority for each instance
    --     type by using the @Priority@ parameter for
    --     @LaunchTemplateOverrides@. You can assign the same priority to
    --     different @LaunchTemplateOverrides@. EC2 implements the priorities
    --     on a best-effort basis, but optimizes for capacity first.
    --     @capacity-optimized-prioritized@ is supported only if your EC2 Fleet
    --     uses a launch template. Note that if the On-Demand
    --     @AllocationStrategy@ is set to @prioritized@, the same priority is
    --     applied when fulfilling On-Demand capacity.
    --
    -- [diversified]
    --     EC2 Fleet requests instances from all of the Spot Instance pools
    --     that you specify.
    --
    -- [lowest-price]
    --     EC2 Fleet requests instances from the lowest priced Spot Instance
    --     pool that has available capacity. If the lowest priced pool doesn\'t
    --     have available capacity, the Spot Instances come from the next
    --     lowest priced pool that has available capacity. If a pool runs out
    --     of capacity before fulfilling your desired capacity, EC2 Fleet will
    --     continue to fulfill your request by drawing from the next lowest
    --     priced pool. To ensure that your desired capacity is met, you might
    --     receive Spot Instances from several pools. Because this strategy
    --     only considers instance price and not capacity availability, it
    --     might lead to high interruption rates.
    --
    -- Default: @lowest-price@
    SpotOptions -> Maybe SpotAllocationStrategy
allocationStrategy :: Prelude.Maybe SpotAllocationStrategy,
    -- | The behavior when a Spot Instance is interrupted.
    --
    -- Default: @terminate@
    SpotOptions -> Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior :: Prelude.Maybe SpotInstanceInterruptionBehavior,
    -- | The number of Spot pools across which to allocate your target Spot
    -- capacity. Supported only when @AllocationStrategy@ is set to
    -- @lowest-price@. EC2 Fleet selects the cheapest Spot pools and evenly
    -- allocates your target Spot capacity across the number of Spot pools that
    -- you specify.
    --
    -- Note that EC2 Fleet attempts to draw Spot Instances from the number of
    -- pools that you specify on a best effort basis. If a pool runs out of
    -- Spot capacity before fulfilling your target capacity, EC2 Fleet will
    -- continue to fulfill your request by drawing from the next cheapest pool.
    -- To ensure that your target capacity is met, you might receive Spot
    -- Instances from more than the number of pools that you specified.
    -- Similarly, if most of the pools have no Spot capacity, you might receive
    -- your full target capacity from fewer than the number of pools that you
    -- specified.
    SpotOptions -> Maybe Int
instancePoolsToUseCount :: Prelude.Maybe Prelude.Int,
    -- | The strategies for managing your workloads on your Spot Instances that
    -- will be interrupted. Currently only the capacity rebalance strategy is
    -- available.
    SpotOptions -> Maybe FleetSpotMaintenanceStrategies
maintenanceStrategies :: Prelude.Maybe FleetSpotMaintenanceStrategies,
    -- | The maximum amount per hour for Spot Instances that you\'re willing to
    -- pay. We do not recommend using this parameter because it can lead to
    -- increased interruptions. If you do not specify this parameter, you will
    -- pay the current Spot price.
    --
    -- If you specify a maximum price, your Spot Instances will be interrupted
    -- more frequently than if you do not specify this parameter.
    SpotOptions -> Maybe Text
maxTotalPrice :: Prelude.Maybe Prelude.Text,
    -- | The minimum target capacity for Spot Instances in the fleet. If the
    -- minimum target capacity is not reached, the fleet launches no instances.
    --
    -- Supported only for fleets of type @instant@.
    --
    -- At least one of the following must be specified:
    -- @SingleAvailabilityZone@ | @SingleInstanceType@
    SpotOptions -> Maybe Int
minTargetCapacity :: Prelude.Maybe Prelude.Int,
    -- | Indicates that the fleet launches all Spot Instances into a single
    -- Availability Zone.
    --
    -- Supported only for fleets of type @instant@.
    SpotOptions -> Maybe Bool
singleAvailabilityZone :: Prelude.Maybe Prelude.Bool,
    -- | Indicates that the fleet uses a single instance type to launch all Spot
    -- Instances in the fleet.
    --
    -- Supported only for fleets of type @instant@.
    SpotOptions -> Maybe Bool
singleInstanceType :: Prelude.Maybe Prelude.Bool
  }
  deriving (SpotOptions -> SpotOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpotOptions -> SpotOptions -> Bool
$c/= :: SpotOptions -> SpotOptions -> Bool
== :: SpotOptions -> SpotOptions -> Bool
$c== :: SpotOptions -> SpotOptions -> Bool
Prelude.Eq, ReadPrec [SpotOptions]
ReadPrec SpotOptions
Int -> ReadS SpotOptions
ReadS [SpotOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpotOptions]
$creadListPrec :: ReadPrec [SpotOptions]
readPrec :: ReadPrec SpotOptions
$creadPrec :: ReadPrec SpotOptions
readList :: ReadS [SpotOptions]
$creadList :: ReadS [SpotOptions]
readsPrec :: Int -> ReadS SpotOptions
$creadsPrec :: Int -> ReadS SpotOptions
Prelude.Read, Int -> SpotOptions -> ShowS
[SpotOptions] -> ShowS
SpotOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpotOptions] -> ShowS
$cshowList :: [SpotOptions] -> ShowS
show :: SpotOptions -> String
$cshow :: SpotOptions -> String
showsPrec :: Int -> SpotOptions -> ShowS
$cshowsPrec :: Int -> SpotOptions -> ShowS
Prelude.Show, forall x. Rep SpotOptions x -> SpotOptions
forall x. SpotOptions -> Rep SpotOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpotOptions x -> SpotOptions
$cfrom :: forall x. SpotOptions -> Rep SpotOptions x
Prelude.Generic)

-- |
-- Create a value of 'SpotOptions' 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:
--
-- 'allocationStrategy', 'spotOptions_allocationStrategy' - The strategy that determines how to allocate the target Spot Instance
-- capacity across the Spot Instance pools specified by the EC2 Fleet
-- launch configuration. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-fleet-allocation-strategy.html Allocation strategies for Spot Instances>
-- in the /Amazon EC2 User Guide/.
--
-- [price-capacity-optimized (recommended)]
--     EC2 Fleet identifies the pools with the highest capacity
--     availability for the number of instances that are launching. This
--     means that we will request Spot Instances from the pools that we
--     believe have the lowest chance of interruption in the near term. EC2
--     Fleet then requests Spot Instances from the lowest priced of these
--     pools.
--
-- [capacity-optimized]
--     EC2 Fleet identifies the pools with the highest capacity
--     availability for the number of instances that are launching. This
--     means that we will request Spot Instances from the pools that we
--     believe have the lowest chance of interruption in the near term. To
--     give certain instance types a higher chance of launching first, use
--     @capacity-optimized-prioritized@. Set a priority for each instance
--     type by using the @Priority@ parameter for
--     @LaunchTemplateOverrides@. You can assign the same priority to
--     different @LaunchTemplateOverrides@. EC2 implements the priorities
--     on a best-effort basis, but optimizes for capacity first.
--     @capacity-optimized-prioritized@ is supported only if your EC2 Fleet
--     uses a launch template. Note that if the On-Demand
--     @AllocationStrategy@ is set to @prioritized@, the same priority is
--     applied when fulfilling On-Demand capacity.
--
-- [diversified]
--     EC2 Fleet requests instances from all of the Spot Instance pools
--     that you specify.
--
-- [lowest-price]
--     EC2 Fleet requests instances from the lowest priced Spot Instance
--     pool that has available capacity. If the lowest priced pool doesn\'t
--     have available capacity, the Spot Instances come from the next
--     lowest priced pool that has available capacity. If a pool runs out
--     of capacity before fulfilling your desired capacity, EC2 Fleet will
--     continue to fulfill your request by drawing from the next lowest
--     priced pool. To ensure that your desired capacity is met, you might
--     receive Spot Instances from several pools. Because this strategy
--     only considers instance price and not capacity availability, it
--     might lead to high interruption rates.
--
-- Default: @lowest-price@
--
-- 'instanceInterruptionBehavior', 'spotOptions_instanceInterruptionBehavior' - The behavior when a Spot Instance is interrupted.
--
-- Default: @terminate@
--
-- 'instancePoolsToUseCount', 'spotOptions_instancePoolsToUseCount' - The number of Spot pools across which to allocate your target Spot
-- capacity. Supported only when @AllocationStrategy@ is set to
-- @lowest-price@. EC2 Fleet selects the cheapest Spot pools and evenly
-- allocates your target Spot capacity across the number of Spot pools that
-- you specify.
--
-- Note that EC2 Fleet attempts to draw Spot Instances from the number of
-- pools that you specify on a best effort basis. If a pool runs out of
-- Spot capacity before fulfilling your target capacity, EC2 Fleet will
-- continue to fulfill your request by drawing from the next cheapest pool.
-- To ensure that your target capacity is met, you might receive Spot
-- Instances from more than the number of pools that you specified.
-- Similarly, if most of the pools have no Spot capacity, you might receive
-- your full target capacity from fewer than the number of pools that you
-- specified.
--
-- 'maintenanceStrategies', 'spotOptions_maintenanceStrategies' - The strategies for managing your workloads on your Spot Instances that
-- will be interrupted. Currently only the capacity rebalance strategy is
-- available.
--
-- 'maxTotalPrice', 'spotOptions_maxTotalPrice' - The maximum amount per hour for Spot Instances that you\'re willing to
-- pay. We do not recommend using this parameter because it can lead to
-- increased interruptions. If you do not specify this parameter, you will
-- pay the current Spot price.
--
-- If you specify a maximum price, your Spot Instances will be interrupted
-- more frequently than if you do not specify this parameter.
--
-- 'minTargetCapacity', 'spotOptions_minTargetCapacity' - The minimum target capacity for Spot Instances in the fleet. If the
-- minimum target capacity is not reached, the fleet launches no instances.
--
-- Supported only for fleets of type @instant@.
--
-- At least one of the following must be specified:
-- @SingleAvailabilityZone@ | @SingleInstanceType@
--
-- 'singleAvailabilityZone', 'spotOptions_singleAvailabilityZone' - Indicates that the fleet launches all Spot Instances into a single
-- Availability Zone.
--
-- Supported only for fleets of type @instant@.
--
-- 'singleInstanceType', 'spotOptions_singleInstanceType' - Indicates that the fleet uses a single instance type to launch all Spot
-- Instances in the fleet.
--
-- Supported only for fleets of type @instant@.
newSpotOptions ::
  SpotOptions
newSpotOptions :: SpotOptions
newSpotOptions =
  SpotOptions'
    { $sel:allocationStrategy:SpotOptions' :: Maybe SpotAllocationStrategy
allocationStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceInterruptionBehavior:SpotOptions' :: Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:instancePoolsToUseCount:SpotOptions' :: Maybe Int
instancePoolsToUseCount = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceStrategies:SpotOptions' :: Maybe FleetSpotMaintenanceStrategies
maintenanceStrategies = forall a. Maybe a
Prelude.Nothing,
      $sel:maxTotalPrice:SpotOptions' :: Maybe Text
maxTotalPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:minTargetCapacity:SpotOptions' :: Maybe Int
minTargetCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:singleAvailabilityZone:SpotOptions' :: Maybe Bool
singleAvailabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:singleInstanceType:SpotOptions' :: Maybe Bool
singleInstanceType = forall a. Maybe a
Prelude.Nothing
    }

-- | The strategy that determines how to allocate the target Spot Instance
-- capacity across the Spot Instance pools specified by the EC2 Fleet
-- launch configuration. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/ec2-fleet-allocation-strategy.html Allocation strategies for Spot Instances>
-- in the /Amazon EC2 User Guide/.
--
-- [price-capacity-optimized (recommended)]
--     EC2 Fleet identifies the pools with the highest capacity
--     availability for the number of instances that are launching. This
--     means that we will request Spot Instances from the pools that we
--     believe have the lowest chance of interruption in the near term. EC2
--     Fleet then requests Spot Instances from the lowest priced of these
--     pools.
--
-- [capacity-optimized]
--     EC2 Fleet identifies the pools with the highest capacity
--     availability for the number of instances that are launching. This
--     means that we will request Spot Instances from the pools that we
--     believe have the lowest chance of interruption in the near term. To
--     give certain instance types a higher chance of launching first, use
--     @capacity-optimized-prioritized@. Set a priority for each instance
--     type by using the @Priority@ parameter for
--     @LaunchTemplateOverrides@. You can assign the same priority to
--     different @LaunchTemplateOverrides@. EC2 implements the priorities
--     on a best-effort basis, but optimizes for capacity first.
--     @capacity-optimized-prioritized@ is supported only if your EC2 Fleet
--     uses a launch template. Note that if the On-Demand
--     @AllocationStrategy@ is set to @prioritized@, the same priority is
--     applied when fulfilling On-Demand capacity.
--
-- [diversified]
--     EC2 Fleet requests instances from all of the Spot Instance pools
--     that you specify.
--
-- [lowest-price]
--     EC2 Fleet requests instances from the lowest priced Spot Instance
--     pool that has available capacity. If the lowest priced pool doesn\'t
--     have available capacity, the Spot Instances come from the next
--     lowest priced pool that has available capacity. If a pool runs out
--     of capacity before fulfilling your desired capacity, EC2 Fleet will
--     continue to fulfill your request by drawing from the next lowest
--     priced pool. To ensure that your desired capacity is met, you might
--     receive Spot Instances from several pools. Because this strategy
--     only considers instance price and not capacity availability, it
--     might lead to high interruption rates.
--
-- Default: @lowest-price@
spotOptions_allocationStrategy :: Lens.Lens' SpotOptions (Prelude.Maybe SpotAllocationStrategy)
spotOptions_allocationStrategy :: Lens' SpotOptions (Maybe SpotAllocationStrategy)
spotOptions_allocationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptions' {Maybe SpotAllocationStrategy
allocationStrategy :: Maybe SpotAllocationStrategy
$sel:allocationStrategy:SpotOptions' :: SpotOptions -> Maybe SpotAllocationStrategy
allocationStrategy} -> Maybe SpotAllocationStrategy
allocationStrategy) (\s :: SpotOptions
s@SpotOptions' {} Maybe SpotAllocationStrategy
a -> SpotOptions
s {$sel:allocationStrategy:SpotOptions' :: Maybe SpotAllocationStrategy
allocationStrategy = Maybe SpotAllocationStrategy
a} :: SpotOptions)

-- | The behavior when a Spot Instance is interrupted.
--
-- Default: @terminate@
spotOptions_instanceInterruptionBehavior :: Lens.Lens' SpotOptions (Prelude.Maybe SpotInstanceInterruptionBehavior)
spotOptions_instanceInterruptionBehavior :: Lens' SpotOptions (Maybe SpotInstanceInterruptionBehavior)
spotOptions_instanceInterruptionBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptions' {Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior :: Maybe SpotInstanceInterruptionBehavior
$sel:instanceInterruptionBehavior:SpotOptions' :: SpotOptions -> Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior} -> Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior) (\s :: SpotOptions
s@SpotOptions' {} Maybe SpotInstanceInterruptionBehavior
a -> SpotOptions
s {$sel:instanceInterruptionBehavior:SpotOptions' :: Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior = Maybe SpotInstanceInterruptionBehavior
a} :: SpotOptions)

-- | The number of Spot pools across which to allocate your target Spot
-- capacity. Supported only when @AllocationStrategy@ is set to
-- @lowest-price@. EC2 Fleet selects the cheapest Spot pools and evenly
-- allocates your target Spot capacity across the number of Spot pools that
-- you specify.
--
-- Note that EC2 Fleet attempts to draw Spot Instances from the number of
-- pools that you specify on a best effort basis. If a pool runs out of
-- Spot capacity before fulfilling your target capacity, EC2 Fleet will
-- continue to fulfill your request by drawing from the next cheapest pool.
-- To ensure that your target capacity is met, you might receive Spot
-- Instances from more than the number of pools that you specified.
-- Similarly, if most of the pools have no Spot capacity, you might receive
-- your full target capacity from fewer than the number of pools that you
-- specified.
spotOptions_instancePoolsToUseCount :: Lens.Lens' SpotOptions (Prelude.Maybe Prelude.Int)
spotOptions_instancePoolsToUseCount :: Lens' SpotOptions (Maybe Int)
spotOptions_instancePoolsToUseCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptions' {Maybe Int
instancePoolsToUseCount :: Maybe Int
$sel:instancePoolsToUseCount:SpotOptions' :: SpotOptions -> Maybe Int
instancePoolsToUseCount} -> Maybe Int
instancePoolsToUseCount) (\s :: SpotOptions
s@SpotOptions' {} Maybe Int
a -> SpotOptions
s {$sel:instancePoolsToUseCount:SpotOptions' :: Maybe Int
instancePoolsToUseCount = Maybe Int
a} :: SpotOptions)

-- | The strategies for managing your workloads on your Spot Instances that
-- will be interrupted. Currently only the capacity rebalance strategy is
-- available.
spotOptions_maintenanceStrategies :: Lens.Lens' SpotOptions (Prelude.Maybe FleetSpotMaintenanceStrategies)
spotOptions_maintenanceStrategies :: Lens' SpotOptions (Maybe FleetSpotMaintenanceStrategies)
spotOptions_maintenanceStrategies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptions' {Maybe FleetSpotMaintenanceStrategies
maintenanceStrategies :: Maybe FleetSpotMaintenanceStrategies
$sel:maintenanceStrategies:SpotOptions' :: SpotOptions -> Maybe FleetSpotMaintenanceStrategies
maintenanceStrategies} -> Maybe FleetSpotMaintenanceStrategies
maintenanceStrategies) (\s :: SpotOptions
s@SpotOptions' {} Maybe FleetSpotMaintenanceStrategies
a -> SpotOptions
s {$sel:maintenanceStrategies:SpotOptions' :: Maybe FleetSpotMaintenanceStrategies
maintenanceStrategies = Maybe FleetSpotMaintenanceStrategies
a} :: SpotOptions)

-- | The maximum amount per hour for Spot Instances that you\'re willing to
-- pay. We do not recommend using this parameter because it can lead to
-- increased interruptions. If you do not specify this parameter, you will
-- pay the current Spot price.
--
-- If you specify a maximum price, your Spot Instances will be interrupted
-- more frequently than if you do not specify this parameter.
spotOptions_maxTotalPrice :: Lens.Lens' SpotOptions (Prelude.Maybe Prelude.Text)
spotOptions_maxTotalPrice :: Lens' SpotOptions (Maybe Text)
spotOptions_maxTotalPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptions' {Maybe Text
maxTotalPrice :: Maybe Text
$sel:maxTotalPrice:SpotOptions' :: SpotOptions -> Maybe Text
maxTotalPrice} -> Maybe Text
maxTotalPrice) (\s :: SpotOptions
s@SpotOptions' {} Maybe Text
a -> SpotOptions
s {$sel:maxTotalPrice:SpotOptions' :: Maybe Text
maxTotalPrice = Maybe Text
a} :: SpotOptions)

-- | The minimum target capacity for Spot Instances in the fleet. If the
-- minimum target capacity is not reached, the fleet launches no instances.
--
-- Supported only for fleets of type @instant@.
--
-- At least one of the following must be specified:
-- @SingleAvailabilityZone@ | @SingleInstanceType@
spotOptions_minTargetCapacity :: Lens.Lens' SpotOptions (Prelude.Maybe Prelude.Int)
spotOptions_minTargetCapacity :: Lens' SpotOptions (Maybe Int)
spotOptions_minTargetCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptions' {Maybe Int
minTargetCapacity :: Maybe Int
$sel:minTargetCapacity:SpotOptions' :: SpotOptions -> Maybe Int
minTargetCapacity} -> Maybe Int
minTargetCapacity) (\s :: SpotOptions
s@SpotOptions' {} Maybe Int
a -> SpotOptions
s {$sel:minTargetCapacity:SpotOptions' :: Maybe Int
minTargetCapacity = Maybe Int
a} :: SpotOptions)

-- | Indicates that the fleet launches all Spot Instances into a single
-- Availability Zone.
--
-- Supported only for fleets of type @instant@.
spotOptions_singleAvailabilityZone :: Lens.Lens' SpotOptions (Prelude.Maybe Prelude.Bool)
spotOptions_singleAvailabilityZone :: Lens' SpotOptions (Maybe Bool)
spotOptions_singleAvailabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptions' {Maybe Bool
singleAvailabilityZone :: Maybe Bool
$sel:singleAvailabilityZone:SpotOptions' :: SpotOptions -> Maybe Bool
singleAvailabilityZone} -> Maybe Bool
singleAvailabilityZone) (\s :: SpotOptions
s@SpotOptions' {} Maybe Bool
a -> SpotOptions
s {$sel:singleAvailabilityZone:SpotOptions' :: Maybe Bool
singleAvailabilityZone = Maybe Bool
a} :: SpotOptions)

-- | Indicates that the fleet uses a single instance type to launch all Spot
-- Instances in the fleet.
--
-- Supported only for fleets of type @instant@.
spotOptions_singleInstanceType :: Lens.Lens' SpotOptions (Prelude.Maybe Prelude.Bool)
spotOptions_singleInstanceType :: Lens' SpotOptions (Maybe Bool)
spotOptions_singleInstanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptions' {Maybe Bool
singleInstanceType :: Maybe Bool
$sel:singleInstanceType:SpotOptions' :: SpotOptions -> Maybe Bool
singleInstanceType} -> Maybe Bool
singleInstanceType) (\s :: SpotOptions
s@SpotOptions' {} Maybe Bool
a -> SpotOptions
s {$sel:singleInstanceType:SpotOptions' :: Maybe Bool
singleInstanceType = Maybe Bool
a} :: SpotOptions)

instance Data.FromXML SpotOptions where
  parseXML :: [Node] -> Either String SpotOptions
parseXML [Node]
x =
    Maybe SpotAllocationStrategy
-> Maybe SpotInstanceInterruptionBehavior
-> Maybe Int
-> Maybe FleetSpotMaintenanceStrategies
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> SpotOptions
SpotOptions'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"allocationStrategy")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"instanceInterruptionBehavior")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"instancePoolsToUseCount")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"maintenanceStrategies")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"maxTotalPrice")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"minTargetCapacity")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"singleAvailabilityZone")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"singleInstanceType")

instance Prelude.Hashable SpotOptions where
  hashWithSalt :: Int -> SpotOptions -> Int
hashWithSalt Int
_salt SpotOptions' {Maybe Bool
Maybe Int
Maybe Text
Maybe FleetSpotMaintenanceStrategies
Maybe SpotAllocationStrategy
Maybe SpotInstanceInterruptionBehavior
singleInstanceType :: Maybe Bool
singleAvailabilityZone :: Maybe Bool
minTargetCapacity :: Maybe Int
maxTotalPrice :: Maybe Text
maintenanceStrategies :: Maybe FleetSpotMaintenanceStrategies
instancePoolsToUseCount :: Maybe Int
instanceInterruptionBehavior :: Maybe SpotInstanceInterruptionBehavior
allocationStrategy :: Maybe SpotAllocationStrategy
$sel:singleInstanceType:SpotOptions' :: SpotOptions -> Maybe Bool
$sel:singleAvailabilityZone:SpotOptions' :: SpotOptions -> Maybe Bool
$sel:minTargetCapacity:SpotOptions' :: SpotOptions -> Maybe Int
$sel:maxTotalPrice:SpotOptions' :: SpotOptions -> Maybe Text
$sel:maintenanceStrategies:SpotOptions' :: SpotOptions -> Maybe FleetSpotMaintenanceStrategies
$sel:instancePoolsToUseCount:SpotOptions' :: SpotOptions -> Maybe Int
$sel:instanceInterruptionBehavior:SpotOptions' :: SpotOptions -> Maybe SpotInstanceInterruptionBehavior
$sel:allocationStrategy:SpotOptions' :: SpotOptions -> Maybe SpotAllocationStrategy
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotAllocationStrategy
allocationStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
instancePoolsToUseCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FleetSpotMaintenanceStrategies
maintenanceStrategies
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxTotalPrice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
minTargetCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
singleAvailabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
singleInstanceType

instance Prelude.NFData SpotOptions where
  rnf :: SpotOptions -> ()
rnf SpotOptions' {Maybe Bool
Maybe Int
Maybe Text
Maybe FleetSpotMaintenanceStrategies
Maybe SpotAllocationStrategy
Maybe SpotInstanceInterruptionBehavior
singleInstanceType :: Maybe Bool
singleAvailabilityZone :: Maybe Bool
minTargetCapacity :: Maybe Int
maxTotalPrice :: Maybe Text
maintenanceStrategies :: Maybe FleetSpotMaintenanceStrategies
instancePoolsToUseCount :: Maybe Int
instanceInterruptionBehavior :: Maybe SpotInstanceInterruptionBehavior
allocationStrategy :: Maybe SpotAllocationStrategy
$sel:singleInstanceType:SpotOptions' :: SpotOptions -> Maybe Bool
$sel:singleAvailabilityZone:SpotOptions' :: SpotOptions -> Maybe Bool
$sel:minTargetCapacity:SpotOptions' :: SpotOptions -> Maybe Int
$sel:maxTotalPrice:SpotOptions' :: SpotOptions -> Maybe Text
$sel:maintenanceStrategies:SpotOptions' :: SpotOptions -> Maybe FleetSpotMaintenanceStrategies
$sel:instancePoolsToUseCount:SpotOptions' :: SpotOptions -> Maybe Int
$sel:instanceInterruptionBehavior:SpotOptions' :: SpotOptions -> Maybe SpotInstanceInterruptionBehavior
$sel:allocationStrategy:SpotOptions' :: SpotOptions -> Maybe SpotAllocationStrategy
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SpotAllocationStrategy
allocationStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
instancePoolsToUseCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FleetSpotMaintenanceStrategies
maintenanceStrategies
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maxTotalPrice
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
minTargetCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
singleAvailabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
singleInstanceType