{-# 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.AutoScaling.Types.InstancesDistribution
-- 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.AutoScaling.Types.InstancesDistribution where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude

-- | Use this structure to specify the distribution of On-Demand Instances
-- and Spot Instances and the allocation strategies used to fulfill
-- On-Demand and Spot capacities for a mixed instances policy.
--
-- /See:/ 'newInstancesDistribution' smart constructor.
data InstancesDistribution = InstancesDistribution'
  { -- | The allocation strategy to apply to your On-Demand Instances when they
    -- are launched. Possible instance types are determined by the launch
    -- template overrides that you specify.
    --
    -- The following lists the valid values:
    --
    -- [lowest-price]
    --     Uses price to determine which instance types are the highest
    --     priority, launching the lowest priced instance types within an
    --     Availability Zone first. This is the default value for Auto Scaling
    --     groups that specify InstanceRequirements.
    --
    -- [prioritized]
    --     You set the order of instance types for the launch template
    --     overrides from highest to lowest priority (from first to last in the
    --     list). Amazon EC2 Auto Scaling launches your highest priority
    --     instance types first. If all your On-Demand capacity cannot be
    --     fulfilled using your highest priority instance type, then Amazon EC2
    --     Auto Scaling launches the remaining capacity using the second
    --     priority instance type, and so on. This is the default value for
    --     Auto Scaling groups that don\'t specify InstanceRequirements and
    --     cannot be used for groups that do.
    InstancesDistribution -> Maybe Text
onDemandAllocationStrategy :: Prelude.Maybe Prelude.Text,
    -- | The minimum amount of the Auto Scaling group\'s capacity that must be
    -- fulfilled by On-Demand Instances. This base portion is launched first as
    -- your group scales.
    --
    -- This number has the same unit of measurement as the group\'s desired
    -- capacity. If you change the default unit of measurement (number of
    -- instances) by specifying weighted capacity values in your launch
    -- template overrides list, or by changing the default desired capacity
    -- type setting of the group, you must specify this number using the same
    -- unit of measurement.
    --
    -- Default: 0
    InstancesDistribution -> Maybe Int
onDemandBaseCapacity :: Prelude.Maybe Prelude.Int,
    -- | Controls the percentages of On-Demand Instances and Spot Instances for
    -- your additional capacity beyond @OnDemandBaseCapacity@. Expressed as a
    -- number (for example, 20 specifies 20% On-Demand Instances, 80% Spot
    -- Instances). If set to 100, only On-Demand Instances are used.
    --
    -- Default: 100
    InstancesDistribution -> Maybe Int
onDemandPercentageAboveBaseCapacity :: Prelude.Maybe Prelude.Int,
    -- | The allocation strategy to apply to your Spot Instances when they are
    -- launched. Possible instance types are determined by the launch template
    -- overrides that you specify.
    --
    -- The following lists the valid values:
    --
    -- [capacity-optimized]
    --     Requests Spot Instances using pools that are optimally chosen based
    --     on the available Spot capacity. This strategy has the lowest risk of
    --     interruption. To give certain instance types a higher chance of
    --     launching first, use @capacity-optimized-prioritized@.
    --
    -- [capacity-optimized-prioritized]
    --     You set the order of instance types for the launch template
    --     overrides from highest to lowest priority (from first to last in the
    --     list). Amazon EC2 Auto Scaling honors the instance type priorities
    --     on a best effort basis but optimizes for capacity first. Note that
    --     if the On-Demand allocation strategy is set to @prioritized@, the
    --     same priority is applied when fulfilling On-Demand capacity. This is
    --     not a valid value for Auto Scaling groups that specify
    --     InstanceRequirements.
    --
    -- [lowest-price]
    --     Requests Spot Instances using the lowest priced pools within an
    --     Availability Zone, across the number of Spot pools that you specify
    --     for the @SpotInstancePools@ property. To ensure that your desired
    --     capacity is met, you might receive Spot Instances from several
    --     pools. This is the default value, but it might lead to high
    --     interruption rates because this strategy only considers instance
    --     price and not available capacity.
    --
    -- [price-capacity-optimized (recommended)]
    --     The price and capacity optimized allocation strategy looks at both
    --     price and capacity to select the Spot Instance pools that are the
    --     least likely to be interrupted and have the lowest possible price.
    InstancesDistribution -> Maybe Text
spotAllocationStrategy :: Prelude.Maybe Prelude.Text,
    -- | The number of Spot Instance pools across which to allocate your Spot
    -- Instances. The Spot pools are determined from the different instance
    -- types in the overrides. Valid only when the @SpotAllocationStrategy@ is
    -- @lowest-price@. Value must be in the range of 1–20.
    --
    -- Default: 2
    InstancesDistribution -> Maybe Int
spotInstancePools :: Prelude.Maybe Prelude.Int,
    -- | The maximum price per unit hour that you are willing to pay for a Spot
    -- Instance. If your maximum price is lower than the Spot price for the
    -- instance types that you selected, your Spot Instances are not launched.
    -- We do not recommend specifying a maximum price because it can lead to
    -- increased interruptions. When Spot Instances launch, you pay the current
    -- Spot price. To remove a maximum price that you previously set, include
    -- the property but specify an empty string (\"\") for the value.
    --
    -- If you specify a maximum price, your instances will be interrupted more
    -- frequently than if you do not specify one.
    --
    -- Valid Range: Minimum value of 0.001
    InstancesDistribution -> Maybe Text
spotMaxPrice :: Prelude.Maybe Prelude.Text
  }
  deriving (InstancesDistribution -> InstancesDistribution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InstancesDistribution -> InstancesDistribution -> Bool
$c/= :: InstancesDistribution -> InstancesDistribution -> Bool
== :: InstancesDistribution -> InstancesDistribution -> Bool
$c== :: InstancesDistribution -> InstancesDistribution -> Bool
Prelude.Eq, ReadPrec [InstancesDistribution]
ReadPrec InstancesDistribution
Int -> ReadS InstancesDistribution
ReadS [InstancesDistribution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InstancesDistribution]
$creadListPrec :: ReadPrec [InstancesDistribution]
readPrec :: ReadPrec InstancesDistribution
$creadPrec :: ReadPrec InstancesDistribution
readList :: ReadS [InstancesDistribution]
$creadList :: ReadS [InstancesDistribution]
readsPrec :: Int -> ReadS InstancesDistribution
$creadsPrec :: Int -> ReadS InstancesDistribution
Prelude.Read, Int -> InstancesDistribution -> ShowS
[InstancesDistribution] -> ShowS
InstancesDistribution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InstancesDistribution] -> ShowS
$cshowList :: [InstancesDistribution] -> ShowS
show :: InstancesDistribution -> String
$cshow :: InstancesDistribution -> String
showsPrec :: Int -> InstancesDistribution -> ShowS
$cshowsPrec :: Int -> InstancesDistribution -> ShowS
Prelude.Show, forall x. Rep InstancesDistribution x -> InstancesDistribution
forall x. InstancesDistribution -> Rep InstancesDistribution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InstancesDistribution x -> InstancesDistribution
$cfrom :: forall x. InstancesDistribution -> Rep InstancesDistribution x
Prelude.Generic)

-- |
-- Create a value of 'InstancesDistribution' 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:
--
-- 'onDemandAllocationStrategy', 'instancesDistribution_onDemandAllocationStrategy' - The allocation strategy to apply to your On-Demand Instances when they
-- are launched. Possible instance types are determined by the launch
-- template overrides that you specify.
--
-- The following lists the valid values:
--
-- [lowest-price]
--     Uses price to determine which instance types are the highest
--     priority, launching the lowest priced instance types within an
--     Availability Zone first. This is the default value for Auto Scaling
--     groups that specify InstanceRequirements.
--
-- [prioritized]
--     You set the order of instance types for the launch template
--     overrides from highest to lowest priority (from first to last in the
--     list). Amazon EC2 Auto Scaling launches your highest priority
--     instance types first. If all your On-Demand capacity cannot be
--     fulfilled using your highest priority instance type, then Amazon EC2
--     Auto Scaling launches the remaining capacity using the second
--     priority instance type, and so on. This is the default value for
--     Auto Scaling groups that don\'t specify InstanceRequirements and
--     cannot be used for groups that do.
--
-- 'onDemandBaseCapacity', 'instancesDistribution_onDemandBaseCapacity' - The minimum amount of the Auto Scaling group\'s capacity that must be
-- fulfilled by On-Demand Instances. This base portion is launched first as
-- your group scales.
--
-- This number has the same unit of measurement as the group\'s desired
-- capacity. If you change the default unit of measurement (number of
-- instances) by specifying weighted capacity values in your launch
-- template overrides list, or by changing the default desired capacity
-- type setting of the group, you must specify this number using the same
-- unit of measurement.
--
-- Default: 0
--
-- 'onDemandPercentageAboveBaseCapacity', 'instancesDistribution_onDemandPercentageAboveBaseCapacity' - Controls the percentages of On-Demand Instances and Spot Instances for
-- your additional capacity beyond @OnDemandBaseCapacity@. Expressed as a
-- number (for example, 20 specifies 20% On-Demand Instances, 80% Spot
-- Instances). If set to 100, only On-Demand Instances are used.
--
-- Default: 100
--
-- 'spotAllocationStrategy', 'instancesDistribution_spotAllocationStrategy' - The allocation strategy to apply to your Spot Instances when they are
-- launched. Possible instance types are determined by the launch template
-- overrides that you specify.
--
-- The following lists the valid values:
--
-- [capacity-optimized]
--     Requests Spot Instances using pools that are optimally chosen based
--     on the available Spot capacity. This strategy has the lowest risk of
--     interruption. To give certain instance types a higher chance of
--     launching first, use @capacity-optimized-prioritized@.
--
-- [capacity-optimized-prioritized]
--     You set the order of instance types for the launch template
--     overrides from highest to lowest priority (from first to last in the
--     list). Amazon EC2 Auto Scaling honors the instance type priorities
--     on a best effort basis but optimizes for capacity first. Note that
--     if the On-Demand allocation strategy is set to @prioritized@, the
--     same priority is applied when fulfilling On-Demand capacity. This is
--     not a valid value for Auto Scaling groups that specify
--     InstanceRequirements.
--
-- [lowest-price]
--     Requests Spot Instances using the lowest priced pools within an
--     Availability Zone, across the number of Spot pools that you specify
--     for the @SpotInstancePools@ property. To ensure that your desired
--     capacity is met, you might receive Spot Instances from several
--     pools. This is the default value, but it might lead to high
--     interruption rates because this strategy only considers instance
--     price and not available capacity.
--
-- [price-capacity-optimized (recommended)]
--     The price and capacity optimized allocation strategy looks at both
--     price and capacity to select the Spot Instance pools that are the
--     least likely to be interrupted and have the lowest possible price.
--
-- 'spotInstancePools', 'instancesDistribution_spotInstancePools' - The number of Spot Instance pools across which to allocate your Spot
-- Instances. The Spot pools are determined from the different instance
-- types in the overrides. Valid only when the @SpotAllocationStrategy@ is
-- @lowest-price@. Value must be in the range of 1–20.
--
-- Default: 2
--
-- 'spotMaxPrice', 'instancesDistribution_spotMaxPrice' - The maximum price per unit hour that you are willing to pay for a Spot
-- Instance. If your maximum price is lower than the Spot price for the
-- instance types that you selected, your Spot Instances are not launched.
-- We do not recommend specifying a maximum price because it can lead to
-- increased interruptions. When Spot Instances launch, you pay the current
-- Spot price. To remove a maximum price that you previously set, include
-- the property but specify an empty string (\"\") for the value.
--
-- If you specify a maximum price, your instances will be interrupted more
-- frequently than if you do not specify one.
--
-- Valid Range: Minimum value of 0.001
newInstancesDistribution ::
  InstancesDistribution
newInstancesDistribution :: InstancesDistribution
newInstancesDistribution =
  InstancesDistribution'
    { $sel:onDemandAllocationStrategy:InstancesDistribution' :: Maybe Text
onDemandAllocationStrategy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:onDemandBaseCapacity:InstancesDistribution' :: Maybe Int
onDemandBaseCapacity = forall a. Maybe a
Prelude.Nothing,
      $sel:onDemandPercentageAboveBaseCapacity:InstancesDistribution' :: Maybe Int
onDemandPercentageAboveBaseCapacity =
        forall a. Maybe a
Prelude.Nothing,
      $sel:spotAllocationStrategy:InstancesDistribution' :: Maybe Text
spotAllocationStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:spotInstancePools:InstancesDistribution' :: Maybe Int
spotInstancePools = forall a. Maybe a
Prelude.Nothing,
      $sel:spotMaxPrice:InstancesDistribution' :: Maybe Text
spotMaxPrice = forall a. Maybe a
Prelude.Nothing
    }

-- | The allocation strategy to apply to your On-Demand Instances when they
-- are launched. Possible instance types are determined by the launch
-- template overrides that you specify.
--
-- The following lists the valid values:
--
-- [lowest-price]
--     Uses price to determine which instance types are the highest
--     priority, launching the lowest priced instance types within an
--     Availability Zone first. This is the default value for Auto Scaling
--     groups that specify InstanceRequirements.
--
-- [prioritized]
--     You set the order of instance types for the launch template
--     overrides from highest to lowest priority (from first to last in the
--     list). Amazon EC2 Auto Scaling launches your highest priority
--     instance types first. If all your On-Demand capacity cannot be
--     fulfilled using your highest priority instance type, then Amazon EC2
--     Auto Scaling launches the remaining capacity using the second
--     priority instance type, and so on. This is the default value for
--     Auto Scaling groups that don\'t specify InstanceRequirements and
--     cannot be used for groups that do.
instancesDistribution_onDemandAllocationStrategy :: Lens.Lens' InstancesDistribution (Prelude.Maybe Prelude.Text)
instancesDistribution_onDemandAllocationStrategy :: Lens' InstancesDistribution (Maybe Text)
instancesDistribution_onDemandAllocationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstancesDistribution' {Maybe Text
onDemandAllocationStrategy :: Maybe Text
$sel:onDemandAllocationStrategy:InstancesDistribution' :: InstancesDistribution -> Maybe Text
onDemandAllocationStrategy} -> Maybe Text
onDemandAllocationStrategy) (\s :: InstancesDistribution
s@InstancesDistribution' {} Maybe Text
a -> InstancesDistribution
s {$sel:onDemandAllocationStrategy:InstancesDistribution' :: Maybe Text
onDemandAllocationStrategy = Maybe Text
a} :: InstancesDistribution)

-- | The minimum amount of the Auto Scaling group\'s capacity that must be
-- fulfilled by On-Demand Instances. This base portion is launched first as
-- your group scales.
--
-- This number has the same unit of measurement as the group\'s desired
-- capacity. If you change the default unit of measurement (number of
-- instances) by specifying weighted capacity values in your launch
-- template overrides list, or by changing the default desired capacity
-- type setting of the group, you must specify this number using the same
-- unit of measurement.
--
-- Default: 0
instancesDistribution_onDemandBaseCapacity :: Lens.Lens' InstancesDistribution (Prelude.Maybe Prelude.Int)
instancesDistribution_onDemandBaseCapacity :: Lens' InstancesDistribution (Maybe Int)
instancesDistribution_onDemandBaseCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstancesDistribution' {Maybe Int
onDemandBaseCapacity :: Maybe Int
$sel:onDemandBaseCapacity:InstancesDistribution' :: InstancesDistribution -> Maybe Int
onDemandBaseCapacity} -> Maybe Int
onDemandBaseCapacity) (\s :: InstancesDistribution
s@InstancesDistribution' {} Maybe Int
a -> InstancesDistribution
s {$sel:onDemandBaseCapacity:InstancesDistribution' :: Maybe Int
onDemandBaseCapacity = Maybe Int
a} :: InstancesDistribution)

-- | Controls the percentages of On-Demand Instances and Spot Instances for
-- your additional capacity beyond @OnDemandBaseCapacity@. Expressed as a
-- number (for example, 20 specifies 20% On-Demand Instances, 80% Spot
-- Instances). If set to 100, only On-Demand Instances are used.
--
-- Default: 100
instancesDistribution_onDemandPercentageAboveBaseCapacity :: Lens.Lens' InstancesDistribution (Prelude.Maybe Prelude.Int)
instancesDistribution_onDemandPercentageAboveBaseCapacity :: Lens' InstancesDistribution (Maybe Int)
instancesDistribution_onDemandPercentageAboveBaseCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstancesDistribution' {Maybe Int
onDemandPercentageAboveBaseCapacity :: Maybe Int
$sel:onDemandPercentageAboveBaseCapacity:InstancesDistribution' :: InstancesDistribution -> Maybe Int
onDemandPercentageAboveBaseCapacity} -> Maybe Int
onDemandPercentageAboveBaseCapacity) (\s :: InstancesDistribution
s@InstancesDistribution' {} Maybe Int
a -> InstancesDistribution
s {$sel:onDemandPercentageAboveBaseCapacity:InstancesDistribution' :: Maybe Int
onDemandPercentageAboveBaseCapacity = Maybe Int
a} :: InstancesDistribution)

-- | The allocation strategy to apply to your Spot Instances when they are
-- launched. Possible instance types are determined by the launch template
-- overrides that you specify.
--
-- The following lists the valid values:
--
-- [capacity-optimized]
--     Requests Spot Instances using pools that are optimally chosen based
--     on the available Spot capacity. This strategy has the lowest risk of
--     interruption. To give certain instance types a higher chance of
--     launching first, use @capacity-optimized-prioritized@.
--
-- [capacity-optimized-prioritized]
--     You set the order of instance types for the launch template
--     overrides from highest to lowest priority (from first to last in the
--     list). Amazon EC2 Auto Scaling honors the instance type priorities
--     on a best effort basis but optimizes for capacity first. Note that
--     if the On-Demand allocation strategy is set to @prioritized@, the
--     same priority is applied when fulfilling On-Demand capacity. This is
--     not a valid value for Auto Scaling groups that specify
--     InstanceRequirements.
--
-- [lowest-price]
--     Requests Spot Instances using the lowest priced pools within an
--     Availability Zone, across the number of Spot pools that you specify
--     for the @SpotInstancePools@ property. To ensure that your desired
--     capacity is met, you might receive Spot Instances from several
--     pools. This is the default value, but it might lead to high
--     interruption rates because this strategy only considers instance
--     price and not available capacity.
--
-- [price-capacity-optimized (recommended)]
--     The price and capacity optimized allocation strategy looks at both
--     price and capacity to select the Spot Instance pools that are the
--     least likely to be interrupted and have the lowest possible price.
instancesDistribution_spotAllocationStrategy :: Lens.Lens' InstancesDistribution (Prelude.Maybe Prelude.Text)
instancesDistribution_spotAllocationStrategy :: Lens' InstancesDistribution (Maybe Text)
instancesDistribution_spotAllocationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstancesDistribution' {Maybe Text
spotAllocationStrategy :: Maybe Text
$sel:spotAllocationStrategy:InstancesDistribution' :: InstancesDistribution -> Maybe Text
spotAllocationStrategy} -> Maybe Text
spotAllocationStrategy) (\s :: InstancesDistribution
s@InstancesDistribution' {} Maybe Text
a -> InstancesDistribution
s {$sel:spotAllocationStrategy:InstancesDistribution' :: Maybe Text
spotAllocationStrategy = Maybe Text
a} :: InstancesDistribution)

-- | The number of Spot Instance pools across which to allocate your Spot
-- Instances. The Spot pools are determined from the different instance
-- types in the overrides. Valid only when the @SpotAllocationStrategy@ is
-- @lowest-price@. Value must be in the range of 1–20.
--
-- Default: 2
instancesDistribution_spotInstancePools :: Lens.Lens' InstancesDistribution (Prelude.Maybe Prelude.Int)
instancesDistribution_spotInstancePools :: Lens' InstancesDistribution (Maybe Int)
instancesDistribution_spotInstancePools = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstancesDistribution' {Maybe Int
spotInstancePools :: Maybe Int
$sel:spotInstancePools:InstancesDistribution' :: InstancesDistribution -> Maybe Int
spotInstancePools} -> Maybe Int
spotInstancePools) (\s :: InstancesDistribution
s@InstancesDistribution' {} Maybe Int
a -> InstancesDistribution
s {$sel:spotInstancePools:InstancesDistribution' :: Maybe Int
spotInstancePools = Maybe Int
a} :: InstancesDistribution)

-- | The maximum price per unit hour that you are willing to pay for a Spot
-- Instance. If your maximum price is lower than the Spot price for the
-- instance types that you selected, your Spot Instances are not launched.
-- We do not recommend specifying a maximum price because it can lead to
-- increased interruptions. When Spot Instances launch, you pay the current
-- Spot price. To remove a maximum price that you previously set, include
-- the property but specify an empty string (\"\") for the value.
--
-- If you specify a maximum price, your instances will be interrupted more
-- frequently than if you do not specify one.
--
-- Valid Range: Minimum value of 0.001
instancesDistribution_spotMaxPrice :: Lens.Lens' InstancesDistribution (Prelude.Maybe Prelude.Text)
instancesDistribution_spotMaxPrice :: Lens' InstancesDistribution (Maybe Text)
instancesDistribution_spotMaxPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\InstancesDistribution' {Maybe Text
spotMaxPrice :: Maybe Text
$sel:spotMaxPrice:InstancesDistribution' :: InstancesDistribution -> Maybe Text
spotMaxPrice} -> Maybe Text
spotMaxPrice) (\s :: InstancesDistribution
s@InstancesDistribution' {} Maybe Text
a -> InstancesDistribution
s {$sel:spotMaxPrice:InstancesDistribution' :: Maybe Text
spotMaxPrice = Maybe Text
a} :: InstancesDistribution)

instance Data.FromXML InstancesDistribution where
  parseXML :: [Node] -> Either String InstancesDistribution
parseXML [Node]
x =
    Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> InstancesDistribution
InstancesDistribution'
      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
"OnDemandAllocationStrategy")
      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
"OnDemandBaseCapacity")
      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
"OnDemandPercentageAboveBaseCapacity")
      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
"SpotAllocationStrategy")
      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
"SpotInstancePools")
      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
"SpotMaxPrice")

instance Prelude.Hashable InstancesDistribution where
  hashWithSalt :: Int -> InstancesDistribution -> Int
hashWithSalt Int
_salt InstancesDistribution' {Maybe Int
Maybe Text
spotMaxPrice :: Maybe Text
spotInstancePools :: Maybe Int
spotAllocationStrategy :: Maybe Text
onDemandPercentageAboveBaseCapacity :: Maybe Int
onDemandBaseCapacity :: Maybe Int
onDemandAllocationStrategy :: Maybe Text
$sel:spotMaxPrice:InstancesDistribution' :: InstancesDistribution -> Maybe Text
$sel:spotInstancePools:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:spotAllocationStrategy:InstancesDistribution' :: InstancesDistribution -> Maybe Text
$sel:onDemandPercentageAboveBaseCapacity:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:onDemandBaseCapacity:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:onDemandAllocationStrategy:InstancesDistribution' :: InstancesDistribution -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
onDemandAllocationStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
onDemandBaseCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
onDemandPercentageAboveBaseCapacity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spotAllocationStrategy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
spotInstancePools
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spotMaxPrice

instance Prelude.NFData InstancesDistribution where
  rnf :: InstancesDistribution -> ()
rnf InstancesDistribution' {Maybe Int
Maybe Text
spotMaxPrice :: Maybe Text
spotInstancePools :: Maybe Int
spotAllocationStrategy :: Maybe Text
onDemandPercentageAboveBaseCapacity :: Maybe Int
onDemandBaseCapacity :: Maybe Int
onDemandAllocationStrategy :: Maybe Text
$sel:spotMaxPrice:InstancesDistribution' :: InstancesDistribution -> Maybe Text
$sel:spotInstancePools:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:spotAllocationStrategy:InstancesDistribution' :: InstancesDistribution -> Maybe Text
$sel:onDemandPercentageAboveBaseCapacity:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:onDemandBaseCapacity:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:onDemandAllocationStrategy:InstancesDistribution' :: InstancesDistribution -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
onDemandAllocationStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
onDemandBaseCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
onDemandPercentageAboveBaseCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
spotAllocationStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
spotInstancePools
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
spotMaxPrice

instance Data.ToQuery InstancesDistribution where
  toQuery :: InstancesDistribution -> QueryString
toQuery InstancesDistribution' {Maybe Int
Maybe Text
spotMaxPrice :: Maybe Text
spotInstancePools :: Maybe Int
spotAllocationStrategy :: Maybe Text
onDemandPercentageAboveBaseCapacity :: Maybe Int
onDemandBaseCapacity :: Maybe Int
onDemandAllocationStrategy :: Maybe Text
$sel:spotMaxPrice:InstancesDistribution' :: InstancesDistribution -> Maybe Text
$sel:spotInstancePools:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:spotAllocationStrategy:InstancesDistribution' :: InstancesDistribution -> Maybe Text
$sel:onDemandPercentageAboveBaseCapacity:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:onDemandBaseCapacity:InstancesDistribution' :: InstancesDistribution -> Maybe Int
$sel:onDemandAllocationStrategy:InstancesDistribution' :: InstancesDistribution -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"OnDemandAllocationStrategy"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
onDemandAllocationStrategy,
        ByteString
"OnDemandBaseCapacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
onDemandBaseCapacity,
        ByteString
"OnDemandPercentageAboveBaseCapacity"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
onDemandPercentageAboveBaseCapacity,
        ByteString
"SpotAllocationStrategy"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
spotAllocationStrategy,
        ByteString
"SpotInstancePools" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
spotInstancePools,
        ByteString
"SpotMaxPrice" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
spotMaxPrice
      ]