{-# 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.SpotOptionsRequest
-- 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.SpotOptionsRequest 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.FleetSpotMaintenanceStrategiesRequest
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 request.
--
-- /See:/ 'newSpotOptionsRequest' smart constructor.
data SpotOptionsRequest = SpotOptionsRequest'
  { -- | 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@
    SpotOptionsRequest -> Maybe SpotAllocationStrategy
allocationStrategy :: Prelude.Maybe SpotAllocationStrategy,
    -- | The behavior when a Spot Instance is interrupted.
    --
    -- Default: @terminate@
    SpotOptionsRequest -> Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior :: Prelude.Maybe SpotInstanceInterruptionBehavior,
    -- | The number of Spot pools across which to allocate your target Spot
    -- capacity. Supported only when Spot @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.
    SpotOptionsRequest -> Maybe Int
instancePoolsToUseCount :: Prelude.Maybe Prelude.Int,
    -- | The strategies for managing your Spot Instances that are at an elevated
    -- risk of being interrupted.
    SpotOptionsRequest -> Maybe FleetSpotMaintenanceStrategiesRequest
maintenanceStrategies :: Prelude.Maybe FleetSpotMaintenanceStrategiesRequest,
    -- | 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.
    SpotOptionsRequest -> 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@
    SpotOptionsRequest -> 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@.
    SpotOptionsRequest -> 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@.
    SpotOptionsRequest -> Maybe Bool
singleInstanceType :: Prelude.Maybe Prelude.Bool
  }
  deriving (SpotOptionsRequest -> SpotOptionsRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpotOptionsRequest -> SpotOptionsRequest -> Bool
$c/= :: SpotOptionsRequest -> SpotOptionsRequest -> Bool
== :: SpotOptionsRequest -> SpotOptionsRequest -> Bool
$c== :: SpotOptionsRequest -> SpotOptionsRequest -> Bool
Prelude.Eq, ReadPrec [SpotOptionsRequest]
ReadPrec SpotOptionsRequest
Int -> ReadS SpotOptionsRequest
ReadS [SpotOptionsRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpotOptionsRequest]
$creadListPrec :: ReadPrec [SpotOptionsRequest]
readPrec :: ReadPrec SpotOptionsRequest
$creadPrec :: ReadPrec SpotOptionsRequest
readList :: ReadS [SpotOptionsRequest]
$creadList :: ReadS [SpotOptionsRequest]
readsPrec :: Int -> ReadS SpotOptionsRequest
$creadsPrec :: Int -> ReadS SpotOptionsRequest
Prelude.Read, Int -> SpotOptionsRequest -> ShowS
[SpotOptionsRequest] -> ShowS
SpotOptionsRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpotOptionsRequest] -> ShowS
$cshowList :: [SpotOptionsRequest] -> ShowS
show :: SpotOptionsRequest -> String
$cshow :: SpotOptionsRequest -> String
showsPrec :: Int -> SpotOptionsRequest -> ShowS
$cshowsPrec :: Int -> SpotOptionsRequest -> ShowS
Prelude.Show, forall x. Rep SpotOptionsRequest x -> SpotOptionsRequest
forall x. SpotOptionsRequest -> Rep SpotOptionsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpotOptionsRequest x -> SpotOptionsRequest
$cfrom :: forall x. SpotOptionsRequest -> Rep SpotOptionsRequest x
Prelude.Generic)

-- |
-- Create a value of 'SpotOptionsRequest' 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', 'spotOptionsRequest_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', 'spotOptionsRequest_instanceInterruptionBehavior' - The behavior when a Spot Instance is interrupted.
--
-- Default: @terminate@
--
-- 'instancePoolsToUseCount', 'spotOptionsRequest_instancePoolsToUseCount' - The number of Spot pools across which to allocate your target Spot
-- capacity. Supported only when Spot @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', 'spotOptionsRequest_maintenanceStrategies' - The strategies for managing your Spot Instances that are at an elevated
-- risk of being interrupted.
--
-- 'maxTotalPrice', 'spotOptionsRequest_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', 'spotOptionsRequest_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', 'spotOptionsRequest_singleAvailabilityZone' - Indicates that the fleet launches all Spot Instances into a single
-- Availability Zone.
--
-- Supported only for fleets of type @instant@.
--
-- 'singleInstanceType', 'spotOptionsRequest_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@.
newSpotOptionsRequest ::
  SpotOptionsRequest
newSpotOptionsRequest :: SpotOptionsRequest
newSpotOptionsRequest =
  SpotOptionsRequest'
    { $sel:allocationStrategy:SpotOptionsRequest' :: Maybe SpotAllocationStrategy
allocationStrategy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:instanceInterruptionBehavior:SpotOptionsRequest' :: Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:instancePoolsToUseCount:SpotOptionsRequest' :: Maybe Int
instancePoolsToUseCount = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceStrategies:SpotOptionsRequest' :: Maybe FleetSpotMaintenanceStrategiesRequest
maintenanceStrategies = forall a. Maybe a
Prelude.Nothing,
      $sel:maxTotalPrice:SpotOptionsRequest' :: Maybe Text
maxTotalPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:minTargetCapacity:SpotOptionsRequest' :: Maybe Int
minTargetCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:singleAvailabilityZone:SpotOptionsRequest' :: Maybe Bool
singleAvailabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:singleInstanceType:SpotOptionsRequest' :: 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@
spotOptionsRequest_allocationStrategy :: Lens.Lens' SpotOptionsRequest (Prelude.Maybe SpotAllocationStrategy)
spotOptionsRequest_allocationStrategy :: Lens' SpotOptionsRequest (Maybe SpotAllocationStrategy)
spotOptionsRequest_allocationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptionsRequest' {Maybe SpotAllocationStrategy
allocationStrategy :: Maybe SpotAllocationStrategy
$sel:allocationStrategy:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe SpotAllocationStrategy
allocationStrategy} -> Maybe SpotAllocationStrategy
allocationStrategy) (\s :: SpotOptionsRequest
s@SpotOptionsRequest' {} Maybe SpotAllocationStrategy
a -> SpotOptionsRequest
s {$sel:allocationStrategy:SpotOptionsRequest' :: Maybe SpotAllocationStrategy
allocationStrategy = Maybe SpotAllocationStrategy
a} :: SpotOptionsRequest)

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

-- | The number of Spot pools across which to allocate your target Spot
-- capacity. Supported only when Spot @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.
spotOptionsRequest_instancePoolsToUseCount :: Lens.Lens' SpotOptionsRequest (Prelude.Maybe Prelude.Int)
spotOptionsRequest_instancePoolsToUseCount :: Lens' SpotOptionsRequest (Maybe Int)
spotOptionsRequest_instancePoolsToUseCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptionsRequest' {Maybe Int
instancePoolsToUseCount :: Maybe Int
$sel:instancePoolsToUseCount:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Int
instancePoolsToUseCount} -> Maybe Int
instancePoolsToUseCount) (\s :: SpotOptionsRequest
s@SpotOptionsRequest' {} Maybe Int
a -> SpotOptionsRequest
s {$sel:instancePoolsToUseCount:SpotOptionsRequest' :: Maybe Int
instancePoolsToUseCount = Maybe Int
a} :: SpotOptionsRequest)

-- | The strategies for managing your Spot Instances that are at an elevated
-- risk of being interrupted.
spotOptionsRequest_maintenanceStrategies :: Lens.Lens' SpotOptionsRequest (Prelude.Maybe FleetSpotMaintenanceStrategiesRequest)
spotOptionsRequest_maintenanceStrategies :: Lens'
  SpotOptionsRequest (Maybe FleetSpotMaintenanceStrategiesRequest)
spotOptionsRequest_maintenanceStrategies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptionsRequest' {Maybe FleetSpotMaintenanceStrategiesRequest
maintenanceStrategies :: Maybe FleetSpotMaintenanceStrategiesRequest
$sel:maintenanceStrategies:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe FleetSpotMaintenanceStrategiesRequest
maintenanceStrategies} -> Maybe FleetSpotMaintenanceStrategiesRequest
maintenanceStrategies) (\s :: SpotOptionsRequest
s@SpotOptionsRequest' {} Maybe FleetSpotMaintenanceStrategiesRequest
a -> SpotOptionsRequest
s {$sel:maintenanceStrategies:SpotOptionsRequest' :: Maybe FleetSpotMaintenanceStrategiesRequest
maintenanceStrategies = Maybe FleetSpotMaintenanceStrategiesRequest
a} :: SpotOptionsRequest)

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

-- | 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@
spotOptionsRequest_minTargetCapacity :: Lens.Lens' SpotOptionsRequest (Prelude.Maybe Prelude.Int)
spotOptionsRequest_minTargetCapacity :: Lens' SpotOptionsRequest (Maybe Int)
spotOptionsRequest_minTargetCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotOptionsRequest' {Maybe Int
minTargetCapacity :: Maybe Int
$sel:minTargetCapacity:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Int
minTargetCapacity} -> Maybe Int
minTargetCapacity) (\s :: SpotOptionsRequest
s@SpotOptionsRequest' {} Maybe Int
a -> SpotOptionsRequest
s {$sel:minTargetCapacity:SpotOptionsRequest' :: Maybe Int
minTargetCapacity = Maybe Int
a} :: SpotOptionsRequest)

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

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

instance Prelude.Hashable SpotOptionsRequest where
  hashWithSalt :: Int -> SpotOptionsRequest -> Int
hashWithSalt Int
_salt SpotOptionsRequest' {Maybe Bool
Maybe Int
Maybe Text
Maybe FleetSpotMaintenanceStrategiesRequest
Maybe SpotAllocationStrategy
Maybe SpotInstanceInterruptionBehavior
singleInstanceType :: Maybe Bool
singleAvailabilityZone :: Maybe Bool
minTargetCapacity :: Maybe Int
maxTotalPrice :: Maybe Text
maintenanceStrategies :: Maybe FleetSpotMaintenanceStrategiesRequest
instancePoolsToUseCount :: Maybe Int
instanceInterruptionBehavior :: Maybe SpotInstanceInterruptionBehavior
allocationStrategy :: Maybe SpotAllocationStrategy
$sel:singleInstanceType:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Bool
$sel:singleAvailabilityZone:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Bool
$sel:minTargetCapacity:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Int
$sel:maxTotalPrice:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Text
$sel:maintenanceStrategies:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe FleetSpotMaintenanceStrategiesRequest
$sel:instancePoolsToUseCount:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Int
$sel:instanceInterruptionBehavior:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe SpotInstanceInterruptionBehavior
$sel:allocationStrategy:SpotOptionsRequest' :: SpotOptionsRequest -> 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 FleetSpotMaintenanceStrategiesRequest
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 SpotOptionsRequest where
  rnf :: SpotOptionsRequest -> ()
rnf SpotOptionsRequest' {Maybe Bool
Maybe Int
Maybe Text
Maybe FleetSpotMaintenanceStrategiesRequest
Maybe SpotAllocationStrategy
Maybe SpotInstanceInterruptionBehavior
singleInstanceType :: Maybe Bool
singleAvailabilityZone :: Maybe Bool
minTargetCapacity :: Maybe Int
maxTotalPrice :: Maybe Text
maintenanceStrategies :: Maybe FleetSpotMaintenanceStrategiesRequest
instancePoolsToUseCount :: Maybe Int
instanceInterruptionBehavior :: Maybe SpotInstanceInterruptionBehavior
allocationStrategy :: Maybe SpotAllocationStrategy
$sel:singleInstanceType:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Bool
$sel:singleAvailabilityZone:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Bool
$sel:minTargetCapacity:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Int
$sel:maxTotalPrice:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Text
$sel:maintenanceStrategies:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe FleetSpotMaintenanceStrategiesRequest
$sel:instancePoolsToUseCount:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Int
$sel:instanceInterruptionBehavior:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe SpotInstanceInterruptionBehavior
$sel:allocationStrategy:SpotOptionsRequest' :: SpotOptionsRequest -> 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 FleetSpotMaintenanceStrategiesRequest
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

instance Data.ToQuery SpotOptionsRequest where
  toQuery :: SpotOptionsRequest -> QueryString
toQuery SpotOptionsRequest' {Maybe Bool
Maybe Int
Maybe Text
Maybe FleetSpotMaintenanceStrategiesRequest
Maybe SpotAllocationStrategy
Maybe SpotInstanceInterruptionBehavior
singleInstanceType :: Maybe Bool
singleAvailabilityZone :: Maybe Bool
minTargetCapacity :: Maybe Int
maxTotalPrice :: Maybe Text
maintenanceStrategies :: Maybe FleetSpotMaintenanceStrategiesRequest
instancePoolsToUseCount :: Maybe Int
instanceInterruptionBehavior :: Maybe SpotInstanceInterruptionBehavior
allocationStrategy :: Maybe SpotAllocationStrategy
$sel:singleInstanceType:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Bool
$sel:singleAvailabilityZone:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Bool
$sel:minTargetCapacity:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Int
$sel:maxTotalPrice:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Text
$sel:maintenanceStrategies:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe FleetSpotMaintenanceStrategiesRequest
$sel:instancePoolsToUseCount:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe Int
$sel:instanceInterruptionBehavior:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe SpotInstanceInterruptionBehavior
$sel:allocationStrategy:SpotOptionsRequest' :: SpotOptionsRequest -> Maybe SpotAllocationStrategy
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"AllocationStrategy" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SpotAllocationStrategy
allocationStrategy,
        ByteString
"InstanceInterruptionBehavior"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SpotInstanceInterruptionBehavior
instanceInterruptionBehavior,
        ByteString
"InstancePoolsToUseCount"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
instancePoolsToUseCount,
        ByteString
"MaintenanceStrategies"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe FleetSpotMaintenanceStrategiesRequest
maintenanceStrategies,
        ByteString
"MaxTotalPrice" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
maxTotalPrice,
        ByteString
"MinTargetCapacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
minTargetCapacity,
        ByteString
"SingleAvailabilityZone"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
singleAvailabilityZone,
        ByteString
"SingleInstanceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
singleInstanceType
      ]