{-# 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.SpotFleetLaunchSpecification
-- 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.SpotFleetLaunchSpecification 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.BlockDeviceMapping
import Amazonka.EC2.Types.GroupIdentifier
import Amazonka.EC2.Types.IamInstanceProfileSpecification
import Amazonka.EC2.Types.InstanceNetworkInterfaceSpecification
import Amazonka.EC2.Types.InstanceRequirements
import Amazonka.EC2.Types.InstanceType
import Amazonka.EC2.Types.SpotFleetMonitoring
import Amazonka.EC2.Types.SpotFleetTagSpecification
import Amazonka.EC2.Types.SpotPlacement
import qualified Amazonka.Prelude as Prelude

-- | Describes the launch specification for one or more Spot Instances. If
-- you include On-Demand capacity in your fleet request or want to specify
-- an EFA network device, you can\'t use @SpotFleetLaunchSpecification@;
-- you must use
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_LaunchTemplateConfig.html LaunchTemplateConfig>.
--
-- /See:/ 'newSpotFleetLaunchSpecification' smart constructor.
data SpotFleetLaunchSpecification = SpotFleetLaunchSpecification'
  { -- | Deprecated.
    SpotFleetLaunchSpecification -> Maybe Text
addressingType :: Prelude.Maybe Prelude.Text,
    -- | One or more block devices that are mapped to the Spot Instances. You
    -- can\'t specify both a snapshot ID and an encryption value. This is
    -- because only blank volumes can be encrypted on creation. If a snapshot
    -- is the basis for a volume, it is not blank and its encryption status is
    -- used for the volume encryption status.
    SpotFleetLaunchSpecification -> Maybe [BlockDeviceMapping]
blockDeviceMappings :: Prelude.Maybe [BlockDeviceMapping],
    -- | Indicates whether the instances are optimized for EBS I\/O. This
    -- optimization provides dedicated throughput to Amazon EBS and an
    -- optimized configuration stack to provide optimal EBS I\/O performance.
    -- This optimization isn\'t available with all instance types. Additional
    -- usage charges apply when using an EBS Optimized instance.
    --
    -- Default: @false@
    SpotFleetLaunchSpecification -> Maybe Bool
ebsOptimized :: Prelude.Maybe Prelude.Bool,
    -- | The IAM instance profile.
    SpotFleetLaunchSpecification
-> Maybe IamInstanceProfileSpecification
iamInstanceProfile :: Prelude.Maybe IamInstanceProfileSpecification,
    -- | The ID of the AMI.
    SpotFleetLaunchSpecification -> Maybe Text
imageId :: Prelude.Maybe Prelude.Text,
    -- | The attributes for the instance types. When you specify instance
    -- attributes, Amazon EC2 will identify instance types with those
    -- attributes.
    --
    -- If you specify @InstanceRequirements@, you can\'t specify
    -- @InstanceType@.
    SpotFleetLaunchSpecification -> Maybe InstanceRequirements
instanceRequirements :: Prelude.Maybe InstanceRequirements,
    -- | The instance type.
    SpotFleetLaunchSpecification -> Maybe InstanceType
instanceType :: Prelude.Maybe InstanceType,
    -- | The ID of the kernel.
    SpotFleetLaunchSpecification -> Maybe Text
kernelId :: Prelude.Maybe Prelude.Text,
    -- | The name of the key pair.
    SpotFleetLaunchSpecification -> Maybe Text
keyName :: Prelude.Maybe Prelude.Text,
    -- | Enable or disable monitoring for the instances.
    SpotFleetLaunchSpecification -> Maybe SpotFleetMonitoring
monitoring :: Prelude.Maybe SpotFleetMonitoring,
    -- | One or more network interfaces. If you specify a network interface, you
    -- must specify subnet IDs and security group IDs using the network
    -- interface.
    --
    -- @SpotFleetLaunchSpecification@ currently does not support Elastic Fabric
    -- Adapter (EFA). To specify an EFA, you must use
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_LaunchTemplateConfig.html LaunchTemplateConfig>.
    SpotFleetLaunchSpecification
-> Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces :: Prelude.Maybe [InstanceNetworkInterfaceSpecification],
    -- | The placement information.
    SpotFleetLaunchSpecification -> Maybe SpotPlacement
placement :: Prelude.Maybe SpotPlacement,
    -- | The ID of the RAM disk. Some kernels require additional drivers at
    -- launch. Check the kernel requirements for information about whether you
    -- need to specify a RAM disk. To find kernel requirements, refer to the
    -- Amazon Web Services Resource Center and search for the kernel ID.
    SpotFleetLaunchSpecification -> Maybe Text
ramdiskId :: Prelude.Maybe Prelude.Text,
    -- | One or more security groups. When requesting instances in a VPC, you
    -- must specify the IDs of the security groups. When requesting instances
    -- in EC2-Classic, you can specify the names or the IDs of the security
    -- groups.
    SpotFleetLaunchSpecification -> Maybe [GroupIdentifier]
securityGroups :: Prelude.Maybe [GroupIdentifier],
    -- | The maximum price per unit hour that you are willing to pay for a Spot
    -- Instance. 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 instances will be interrupted more
    -- frequently than if you do not specify this parameter.
    SpotFleetLaunchSpecification -> Maybe Text
spotPrice :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the subnets in which to launch the instances. To specify
    -- multiple subnets, separate them using commas; for example,
    -- \"subnet-1234abcdeexample1, subnet-0987cdef6example2\".
    SpotFleetLaunchSpecification -> Maybe Text
subnetId :: Prelude.Maybe Prelude.Text,
    -- | The tags to apply during creation.
    SpotFleetLaunchSpecification -> Maybe [SpotFleetTagSpecification]
tagSpecifications :: Prelude.Maybe [SpotFleetTagSpecification],
    -- | The Base64-encoded user data that instances use when starting up.
    SpotFleetLaunchSpecification -> Maybe Text
userData :: Prelude.Maybe Prelude.Text,
    -- | The number of units provided by the specified instance type. These are
    -- the same units that you chose to set the target capacity in terms of
    -- instances, or a performance characteristic such as vCPUs, memory, or
    -- I\/O.
    --
    -- If the target capacity divided by this value is not a whole number,
    -- Amazon EC2 rounds the number of instances to the next whole number. If
    -- this value is not specified, the default is 1.
    SpotFleetLaunchSpecification -> Maybe Double
weightedCapacity :: Prelude.Maybe Prelude.Double
  }
  deriving (SpotFleetLaunchSpecification
-> SpotFleetLaunchSpecification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpotFleetLaunchSpecification
-> SpotFleetLaunchSpecification -> Bool
$c/= :: SpotFleetLaunchSpecification
-> SpotFleetLaunchSpecification -> Bool
== :: SpotFleetLaunchSpecification
-> SpotFleetLaunchSpecification -> Bool
$c== :: SpotFleetLaunchSpecification
-> SpotFleetLaunchSpecification -> Bool
Prelude.Eq, ReadPrec [SpotFleetLaunchSpecification]
ReadPrec SpotFleetLaunchSpecification
Int -> ReadS SpotFleetLaunchSpecification
ReadS [SpotFleetLaunchSpecification]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpotFleetLaunchSpecification]
$creadListPrec :: ReadPrec [SpotFleetLaunchSpecification]
readPrec :: ReadPrec SpotFleetLaunchSpecification
$creadPrec :: ReadPrec SpotFleetLaunchSpecification
readList :: ReadS [SpotFleetLaunchSpecification]
$creadList :: ReadS [SpotFleetLaunchSpecification]
readsPrec :: Int -> ReadS SpotFleetLaunchSpecification
$creadsPrec :: Int -> ReadS SpotFleetLaunchSpecification
Prelude.Read, Int -> SpotFleetLaunchSpecification -> ShowS
[SpotFleetLaunchSpecification] -> ShowS
SpotFleetLaunchSpecification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpotFleetLaunchSpecification] -> ShowS
$cshowList :: [SpotFleetLaunchSpecification] -> ShowS
show :: SpotFleetLaunchSpecification -> String
$cshow :: SpotFleetLaunchSpecification -> String
showsPrec :: Int -> SpotFleetLaunchSpecification -> ShowS
$cshowsPrec :: Int -> SpotFleetLaunchSpecification -> ShowS
Prelude.Show, forall x.
Rep SpotFleetLaunchSpecification x -> SpotFleetLaunchSpecification
forall x.
SpotFleetLaunchSpecification -> Rep SpotFleetLaunchSpecification x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SpotFleetLaunchSpecification x -> SpotFleetLaunchSpecification
$cfrom :: forall x.
SpotFleetLaunchSpecification -> Rep SpotFleetLaunchSpecification x
Prelude.Generic)

-- |
-- Create a value of 'SpotFleetLaunchSpecification' 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:
--
-- 'addressingType', 'spotFleetLaunchSpecification_addressingType' - Deprecated.
--
-- 'blockDeviceMappings', 'spotFleetLaunchSpecification_blockDeviceMappings' - One or more block devices that are mapped to the Spot Instances. You
-- can\'t specify both a snapshot ID and an encryption value. This is
-- because only blank volumes can be encrypted on creation. If a snapshot
-- is the basis for a volume, it is not blank and its encryption status is
-- used for the volume encryption status.
--
-- 'ebsOptimized', 'spotFleetLaunchSpecification_ebsOptimized' - Indicates whether the instances are optimized for EBS I\/O. This
-- optimization provides dedicated throughput to Amazon EBS and an
-- optimized configuration stack to provide optimal EBS I\/O performance.
-- This optimization isn\'t available with all instance types. Additional
-- usage charges apply when using an EBS Optimized instance.
--
-- Default: @false@
--
-- 'iamInstanceProfile', 'spotFleetLaunchSpecification_iamInstanceProfile' - The IAM instance profile.
--
-- 'imageId', 'spotFleetLaunchSpecification_imageId' - The ID of the AMI.
--
-- 'instanceRequirements', 'spotFleetLaunchSpecification_instanceRequirements' - The attributes for the instance types. When you specify instance
-- attributes, Amazon EC2 will identify instance types with those
-- attributes.
--
-- If you specify @InstanceRequirements@, you can\'t specify
-- @InstanceType@.
--
-- 'instanceType', 'spotFleetLaunchSpecification_instanceType' - The instance type.
--
-- 'kernelId', 'spotFleetLaunchSpecification_kernelId' - The ID of the kernel.
--
-- 'keyName', 'spotFleetLaunchSpecification_keyName' - The name of the key pair.
--
-- 'monitoring', 'spotFleetLaunchSpecification_monitoring' - Enable or disable monitoring for the instances.
--
-- 'networkInterfaces', 'spotFleetLaunchSpecification_networkInterfaces' - One or more network interfaces. If you specify a network interface, you
-- must specify subnet IDs and security group IDs using the network
-- interface.
--
-- @SpotFleetLaunchSpecification@ currently does not support Elastic Fabric
-- Adapter (EFA). To specify an EFA, you must use
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_LaunchTemplateConfig.html LaunchTemplateConfig>.
--
-- 'placement', 'spotFleetLaunchSpecification_placement' - The placement information.
--
-- 'ramdiskId', 'spotFleetLaunchSpecification_ramdiskId' - The ID of the RAM disk. Some kernels require additional drivers at
-- launch. Check the kernel requirements for information about whether you
-- need to specify a RAM disk. To find kernel requirements, refer to the
-- Amazon Web Services Resource Center and search for the kernel ID.
--
-- 'securityGroups', 'spotFleetLaunchSpecification_securityGroups' - One or more security groups. When requesting instances in a VPC, you
-- must specify the IDs of the security groups. When requesting instances
-- in EC2-Classic, you can specify the names or the IDs of the security
-- groups.
--
-- 'spotPrice', 'spotFleetLaunchSpecification_spotPrice' - The maximum price per unit hour that you are willing to pay for a Spot
-- Instance. 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 instances will be interrupted more
-- frequently than if you do not specify this parameter.
--
-- 'subnetId', 'spotFleetLaunchSpecification_subnetId' - The IDs of the subnets in which to launch the instances. To specify
-- multiple subnets, separate them using commas; for example,
-- \"subnet-1234abcdeexample1, subnet-0987cdef6example2\".
--
-- 'tagSpecifications', 'spotFleetLaunchSpecification_tagSpecifications' - The tags to apply during creation.
--
-- 'userData', 'spotFleetLaunchSpecification_userData' - The Base64-encoded user data that instances use when starting up.
--
-- 'weightedCapacity', 'spotFleetLaunchSpecification_weightedCapacity' - The number of units provided by the specified instance type. These are
-- the same units that you chose to set the target capacity in terms of
-- instances, or a performance characteristic such as vCPUs, memory, or
-- I\/O.
--
-- If the target capacity divided by this value is not a whole number,
-- Amazon EC2 rounds the number of instances to the next whole number. If
-- this value is not specified, the default is 1.
newSpotFleetLaunchSpecification ::
  SpotFleetLaunchSpecification
newSpotFleetLaunchSpecification :: SpotFleetLaunchSpecification
newSpotFleetLaunchSpecification =
  SpotFleetLaunchSpecification'
    { $sel:addressingType:SpotFleetLaunchSpecification' :: Maybe Text
addressingType =
        forall a. Maybe a
Prelude.Nothing,
      $sel:blockDeviceMappings:SpotFleetLaunchSpecification' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = forall a. Maybe a
Prelude.Nothing,
      $sel:ebsOptimized:SpotFleetLaunchSpecification' :: Maybe Bool
ebsOptimized = forall a. Maybe a
Prelude.Nothing,
      $sel:iamInstanceProfile:SpotFleetLaunchSpecification' :: Maybe IamInstanceProfileSpecification
iamInstanceProfile = forall a. Maybe a
Prelude.Nothing,
      $sel:imageId:SpotFleetLaunchSpecification' :: Maybe Text
imageId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceRequirements:SpotFleetLaunchSpecification' :: Maybe InstanceRequirements
instanceRequirements = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:SpotFleetLaunchSpecification' :: Maybe InstanceType
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:kernelId:SpotFleetLaunchSpecification' :: Maybe Text
kernelId = forall a. Maybe a
Prelude.Nothing,
      $sel:keyName:SpotFleetLaunchSpecification' :: Maybe Text
keyName = forall a. Maybe a
Prelude.Nothing,
      $sel:monitoring:SpotFleetLaunchSpecification' :: Maybe SpotFleetMonitoring
monitoring = forall a. Maybe a
Prelude.Nothing,
      $sel:networkInterfaces:SpotFleetLaunchSpecification' :: Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces = forall a. Maybe a
Prelude.Nothing,
      $sel:placement:SpotFleetLaunchSpecification' :: Maybe SpotPlacement
placement = forall a. Maybe a
Prelude.Nothing,
      $sel:ramdiskId:SpotFleetLaunchSpecification' :: Maybe Text
ramdiskId = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:SpotFleetLaunchSpecification' :: Maybe [GroupIdentifier]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:spotPrice:SpotFleetLaunchSpecification' :: Maybe Text
spotPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetId:SpotFleetLaunchSpecification' :: Maybe Text
subnetId = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:SpotFleetLaunchSpecification' :: Maybe [SpotFleetTagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:userData:SpotFleetLaunchSpecification' :: Maybe Text
userData = forall a. Maybe a
Prelude.Nothing,
      $sel:weightedCapacity:SpotFleetLaunchSpecification' :: Maybe Double
weightedCapacity = forall a. Maybe a
Prelude.Nothing
    }

-- | Deprecated.
spotFleetLaunchSpecification_addressingType :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Text)
spotFleetLaunchSpecification_addressingType :: Lens' SpotFleetLaunchSpecification (Maybe Text)
spotFleetLaunchSpecification_addressingType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Text
addressingType :: Maybe Text
$sel:addressingType:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
addressingType} -> Maybe Text
addressingType) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Text
a -> SpotFleetLaunchSpecification
s {$sel:addressingType:SpotFleetLaunchSpecification' :: Maybe Text
addressingType = Maybe Text
a} :: SpotFleetLaunchSpecification)

-- | One or more block devices that are mapped to the Spot Instances. You
-- can\'t specify both a snapshot ID and an encryption value. This is
-- because only blank volumes can be encrypted on creation. If a snapshot
-- is the basis for a volume, it is not blank and its encryption status is
-- used for the volume encryption status.
spotFleetLaunchSpecification_blockDeviceMappings :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe [BlockDeviceMapping])
spotFleetLaunchSpecification_blockDeviceMappings :: Lens' SpotFleetLaunchSpecification (Maybe [BlockDeviceMapping])
spotFleetLaunchSpecification_blockDeviceMappings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe [BlockDeviceMapping]
blockDeviceMappings :: Maybe [BlockDeviceMapping]
$sel:blockDeviceMappings:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [BlockDeviceMapping]
blockDeviceMappings} -> Maybe [BlockDeviceMapping]
blockDeviceMappings) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe [BlockDeviceMapping]
a -> SpotFleetLaunchSpecification
s {$sel:blockDeviceMappings:SpotFleetLaunchSpecification' :: Maybe [BlockDeviceMapping]
blockDeviceMappings = Maybe [BlockDeviceMapping]
a} :: SpotFleetLaunchSpecification) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Indicates whether the instances are optimized for EBS I\/O. This
-- optimization provides dedicated throughput to Amazon EBS and an
-- optimized configuration stack to provide optimal EBS I\/O performance.
-- This optimization isn\'t available with all instance types. Additional
-- usage charges apply when using an EBS Optimized instance.
--
-- Default: @false@
spotFleetLaunchSpecification_ebsOptimized :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Bool)
spotFleetLaunchSpecification_ebsOptimized :: Lens' SpotFleetLaunchSpecification (Maybe Bool)
spotFleetLaunchSpecification_ebsOptimized = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Bool
ebsOptimized :: Maybe Bool
$sel:ebsOptimized:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Bool
ebsOptimized} -> Maybe Bool
ebsOptimized) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Bool
a -> SpotFleetLaunchSpecification
s {$sel:ebsOptimized:SpotFleetLaunchSpecification' :: Maybe Bool
ebsOptimized = Maybe Bool
a} :: SpotFleetLaunchSpecification)

-- | The IAM instance profile.
spotFleetLaunchSpecification_iamInstanceProfile :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe IamInstanceProfileSpecification)
spotFleetLaunchSpecification_iamInstanceProfile :: Lens'
  SpotFleetLaunchSpecification
  (Maybe IamInstanceProfileSpecification)
spotFleetLaunchSpecification_iamInstanceProfile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe IamInstanceProfileSpecification
iamInstanceProfile :: Maybe IamInstanceProfileSpecification
$sel:iamInstanceProfile:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification
-> Maybe IamInstanceProfileSpecification
iamInstanceProfile} -> Maybe IamInstanceProfileSpecification
iamInstanceProfile) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe IamInstanceProfileSpecification
a -> SpotFleetLaunchSpecification
s {$sel:iamInstanceProfile:SpotFleetLaunchSpecification' :: Maybe IamInstanceProfileSpecification
iamInstanceProfile = Maybe IamInstanceProfileSpecification
a} :: SpotFleetLaunchSpecification)

-- | The ID of the AMI.
spotFleetLaunchSpecification_imageId :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Text)
spotFleetLaunchSpecification_imageId :: Lens' SpotFleetLaunchSpecification (Maybe Text)
spotFleetLaunchSpecification_imageId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Text
imageId :: Maybe Text
$sel:imageId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
imageId} -> Maybe Text
imageId) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Text
a -> SpotFleetLaunchSpecification
s {$sel:imageId:SpotFleetLaunchSpecification' :: Maybe Text
imageId = Maybe Text
a} :: SpotFleetLaunchSpecification)

-- | The attributes for the instance types. When you specify instance
-- attributes, Amazon EC2 will identify instance types with those
-- attributes.
--
-- If you specify @InstanceRequirements@, you can\'t specify
-- @InstanceType@.
spotFleetLaunchSpecification_instanceRequirements :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe InstanceRequirements)
spotFleetLaunchSpecification_instanceRequirements :: Lens' SpotFleetLaunchSpecification (Maybe InstanceRequirements)
spotFleetLaunchSpecification_instanceRequirements = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe InstanceRequirements
instanceRequirements :: Maybe InstanceRequirements
$sel:instanceRequirements:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe InstanceRequirements
instanceRequirements} -> Maybe InstanceRequirements
instanceRequirements) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe InstanceRequirements
a -> SpotFleetLaunchSpecification
s {$sel:instanceRequirements:SpotFleetLaunchSpecification' :: Maybe InstanceRequirements
instanceRequirements = Maybe InstanceRequirements
a} :: SpotFleetLaunchSpecification)

-- | The instance type.
spotFleetLaunchSpecification_instanceType :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe InstanceType)
spotFleetLaunchSpecification_instanceType :: Lens' SpotFleetLaunchSpecification (Maybe InstanceType)
spotFleetLaunchSpecification_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe InstanceType
instanceType :: Maybe InstanceType
$sel:instanceType:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe InstanceType
instanceType} -> Maybe InstanceType
instanceType) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe InstanceType
a -> SpotFleetLaunchSpecification
s {$sel:instanceType:SpotFleetLaunchSpecification' :: Maybe InstanceType
instanceType = Maybe InstanceType
a} :: SpotFleetLaunchSpecification)

-- | The ID of the kernel.
spotFleetLaunchSpecification_kernelId :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Text)
spotFleetLaunchSpecification_kernelId :: Lens' SpotFleetLaunchSpecification (Maybe Text)
spotFleetLaunchSpecification_kernelId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Text
kernelId :: Maybe Text
$sel:kernelId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
kernelId} -> Maybe Text
kernelId) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Text
a -> SpotFleetLaunchSpecification
s {$sel:kernelId:SpotFleetLaunchSpecification' :: Maybe Text
kernelId = Maybe Text
a} :: SpotFleetLaunchSpecification)

-- | The name of the key pair.
spotFleetLaunchSpecification_keyName :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Text)
spotFleetLaunchSpecification_keyName :: Lens' SpotFleetLaunchSpecification (Maybe Text)
spotFleetLaunchSpecification_keyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Text
keyName :: Maybe Text
$sel:keyName:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
keyName} -> Maybe Text
keyName) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Text
a -> SpotFleetLaunchSpecification
s {$sel:keyName:SpotFleetLaunchSpecification' :: Maybe Text
keyName = Maybe Text
a} :: SpotFleetLaunchSpecification)

-- | Enable or disable monitoring for the instances.
spotFleetLaunchSpecification_monitoring :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe SpotFleetMonitoring)
spotFleetLaunchSpecification_monitoring :: Lens' SpotFleetLaunchSpecification (Maybe SpotFleetMonitoring)
spotFleetLaunchSpecification_monitoring = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe SpotFleetMonitoring
monitoring :: Maybe SpotFleetMonitoring
$sel:monitoring:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe SpotFleetMonitoring
monitoring} -> Maybe SpotFleetMonitoring
monitoring) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe SpotFleetMonitoring
a -> SpotFleetLaunchSpecification
s {$sel:monitoring:SpotFleetLaunchSpecification' :: Maybe SpotFleetMonitoring
monitoring = Maybe SpotFleetMonitoring
a} :: SpotFleetLaunchSpecification)

-- | One or more network interfaces. If you specify a network interface, you
-- must specify subnet IDs and security group IDs using the network
-- interface.
--
-- @SpotFleetLaunchSpecification@ currently does not support Elastic Fabric
-- Adapter (EFA). To specify an EFA, you must use
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_LaunchTemplateConfig.html LaunchTemplateConfig>.
spotFleetLaunchSpecification_networkInterfaces :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe [InstanceNetworkInterfaceSpecification])
spotFleetLaunchSpecification_networkInterfaces :: Lens'
  SpotFleetLaunchSpecification
  (Maybe [InstanceNetworkInterfaceSpecification])
spotFleetLaunchSpecification_networkInterfaces = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces :: Maybe [InstanceNetworkInterfaceSpecification]
$sel:networkInterfaces:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification
-> Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces} -> Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe [InstanceNetworkInterfaceSpecification]
a -> SpotFleetLaunchSpecification
s {$sel:networkInterfaces:SpotFleetLaunchSpecification' :: Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces = Maybe [InstanceNetworkInterfaceSpecification]
a} :: SpotFleetLaunchSpecification) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The placement information.
spotFleetLaunchSpecification_placement :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe SpotPlacement)
spotFleetLaunchSpecification_placement :: Lens' SpotFleetLaunchSpecification (Maybe SpotPlacement)
spotFleetLaunchSpecification_placement = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe SpotPlacement
placement :: Maybe SpotPlacement
$sel:placement:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe SpotPlacement
placement} -> Maybe SpotPlacement
placement) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe SpotPlacement
a -> SpotFleetLaunchSpecification
s {$sel:placement:SpotFleetLaunchSpecification' :: Maybe SpotPlacement
placement = Maybe SpotPlacement
a} :: SpotFleetLaunchSpecification)

-- | The ID of the RAM disk. Some kernels require additional drivers at
-- launch. Check the kernel requirements for information about whether you
-- need to specify a RAM disk. To find kernel requirements, refer to the
-- Amazon Web Services Resource Center and search for the kernel ID.
spotFleetLaunchSpecification_ramdiskId :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Text)
spotFleetLaunchSpecification_ramdiskId :: Lens' SpotFleetLaunchSpecification (Maybe Text)
spotFleetLaunchSpecification_ramdiskId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Text
ramdiskId :: Maybe Text
$sel:ramdiskId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
ramdiskId} -> Maybe Text
ramdiskId) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Text
a -> SpotFleetLaunchSpecification
s {$sel:ramdiskId:SpotFleetLaunchSpecification' :: Maybe Text
ramdiskId = Maybe Text
a} :: SpotFleetLaunchSpecification)

-- | One or more security groups. When requesting instances in a VPC, you
-- must specify the IDs of the security groups. When requesting instances
-- in EC2-Classic, you can specify the names or the IDs of the security
-- groups.
spotFleetLaunchSpecification_securityGroups :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe [GroupIdentifier])
spotFleetLaunchSpecification_securityGroups :: Lens' SpotFleetLaunchSpecification (Maybe [GroupIdentifier])
spotFleetLaunchSpecification_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe [GroupIdentifier]
securityGroups :: Maybe [GroupIdentifier]
$sel:securityGroups:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [GroupIdentifier]
securityGroups} -> Maybe [GroupIdentifier]
securityGroups) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe [GroupIdentifier]
a -> SpotFleetLaunchSpecification
s {$sel:securityGroups:SpotFleetLaunchSpecification' :: Maybe [GroupIdentifier]
securityGroups = Maybe [GroupIdentifier]
a} :: SpotFleetLaunchSpecification) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The maximum price per unit hour that you are willing to pay for a Spot
-- Instance. 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 instances will be interrupted more
-- frequently than if you do not specify this parameter.
spotFleetLaunchSpecification_spotPrice :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Text)
spotFleetLaunchSpecification_spotPrice :: Lens' SpotFleetLaunchSpecification (Maybe Text)
spotFleetLaunchSpecification_spotPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Text
spotPrice :: Maybe Text
$sel:spotPrice:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
spotPrice} -> Maybe Text
spotPrice) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Text
a -> SpotFleetLaunchSpecification
s {$sel:spotPrice:SpotFleetLaunchSpecification' :: Maybe Text
spotPrice = Maybe Text
a} :: SpotFleetLaunchSpecification)

-- | The IDs of the subnets in which to launch the instances. To specify
-- multiple subnets, separate them using commas; for example,
-- \"subnet-1234abcdeexample1, subnet-0987cdef6example2\".
spotFleetLaunchSpecification_subnetId :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Text)
spotFleetLaunchSpecification_subnetId :: Lens' SpotFleetLaunchSpecification (Maybe Text)
spotFleetLaunchSpecification_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Text
subnetId :: Maybe Text
$sel:subnetId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
subnetId} -> Maybe Text
subnetId) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Text
a -> SpotFleetLaunchSpecification
s {$sel:subnetId:SpotFleetLaunchSpecification' :: Maybe Text
subnetId = Maybe Text
a} :: SpotFleetLaunchSpecification)

-- | The tags to apply during creation.
spotFleetLaunchSpecification_tagSpecifications :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe [SpotFleetTagSpecification])
spotFleetLaunchSpecification_tagSpecifications :: Lens'
  SpotFleetLaunchSpecification (Maybe [SpotFleetTagSpecification])
spotFleetLaunchSpecification_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe [SpotFleetTagSpecification]
tagSpecifications :: Maybe [SpotFleetTagSpecification]
$sel:tagSpecifications:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [SpotFleetTagSpecification]
tagSpecifications} -> Maybe [SpotFleetTagSpecification]
tagSpecifications) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe [SpotFleetTagSpecification]
a -> SpotFleetLaunchSpecification
s {$sel:tagSpecifications:SpotFleetLaunchSpecification' :: Maybe [SpotFleetTagSpecification]
tagSpecifications = Maybe [SpotFleetTagSpecification]
a} :: SpotFleetLaunchSpecification) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Base64-encoded user data that instances use when starting up.
spotFleetLaunchSpecification_userData :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Text)
spotFleetLaunchSpecification_userData :: Lens' SpotFleetLaunchSpecification (Maybe Text)
spotFleetLaunchSpecification_userData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Text
userData :: Maybe Text
$sel:userData:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
userData} -> Maybe Text
userData) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Text
a -> SpotFleetLaunchSpecification
s {$sel:userData:SpotFleetLaunchSpecification' :: Maybe Text
userData = Maybe Text
a} :: SpotFleetLaunchSpecification)

-- | The number of units provided by the specified instance type. These are
-- the same units that you chose to set the target capacity in terms of
-- instances, or a performance characteristic such as vCPUs, memory, or
-- I\/O.
--
-- If the target capacity divided by this value is not a whole number,
-- Amazon EC2 rounds the number of instances to the next whole number. If
-- this value is not specified, the default is 1.
spotFleetLaunchSpecification_weightedCapacity :: Lens.Lens' SpotFleetLaunchSpecification (Prelude.Maybe Prelude.Double)
spotFleetLaunchSpecification_weightedCapacity :: Lens' SpotFleetLaunchSpecification (Maybe Double)
spotFleetLaunchSpecification_weightedCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotFleetLaunchSpecification' {Maybe Double
weightedCapacity :: Maybe Double
$sel:weightedCapacity:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Double
weightedCapacity} -> Maybe Double
weightedCapacity) (\s :: SpotFleetLaunchSpecification
s@SpotFleetLaunchSpecification' {} Maybe Double
a -> SpotFleetLaunchSpecification
s {$sel:weightedCapacity:SpotFleetLaunchSpecification' :: Maybe Double
weightedCapacity = Maybe Double
a} :: SpotFleetLaunchSpecification)

instance Data.FromXML SpotFleetLaunchSpecification where
  parseXML :: [Node] -> Either String SpotFleetLaunchSpecification
parseXML [Node]
x =
    Maybe Text
-> Maybe [BlockDeviceMapping]
-> Maybe Bool
-> Maybe IamInstanceProfileSpecification
-> Maybe Text
-> Maybe InstanceRequirements
-> Maybe InstanceType
-> Maybe Text
-> Maybe Text
-> Maybe SpotFleetMonitoring
-> Maybe [InstanceNetworkInterfaceSpecification]
-> Maybe SpotPlacement
-> Maybe Text
-> Maybe [GroupIdentifier]
-> Maybe Text
-> Maybe Text
-> Maybe [SpotFleetTagSpecification]
-> Maybe Text
-> Maybe Double
-> SpotFleetLaunchSpecification
SpotFleetLaunchSpecification'
      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
"addressingType")
      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
"blockDeviceMapping"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      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
"ebsOptimized")
      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
"iamInstanceProfile")
      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
"imageId")
      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
"instanceRequirements")
      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
"instanceType")
      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
"kernelId")
      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
"keyName")
      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
"monitoring")
      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
"networkInterfaceSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      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
"placement")
      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
"ramdiskId")
      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
"groupSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      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
"spotPrice")
      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
"subnetId")
      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
"tagSpecificationSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )
      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
"userData")
      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
"weightedCapacity")

instance
  Prelude.Hashable
    SpotFleetLaunchSpecification
  where
  hashWithSalt :: Int -> SpotFleetLaunchSpecification -> Int
hashWithSalt Int
_salt SpotFleetLaunchSpecification' {Maybe Bool
Maybe Double
Maybe [GroupIdentifier]
Maybe [InstanceNetworkInterfaceSpecification]
Maybe [SpotFleetTagSpecification]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe IamInstanceProfileSpecification
Maybe InstanceType
Maybe SpotFleetMonitoring
Maybe SpotPlacement
Maybe InstanceRequirements
weightedCapacity :: Maybe Double
userData :: Maybe Text
tagSpecifications :: Maybe [SpotFleetTagSpecification]
subnetId :: Maybe Text
spotPrice :: Maybe Text
securityGroups :: Maybe [GroupIdentifier]
ramdiskId :: Maybe Text
placement :: Maybe SpotPlacement
networkInterfaces :: Maybe [InstanceNetworkInterfaceSpecification]
monitoring :: Maybe SpotFleetMonitoring
keyName :: Maybe Text
kernelId :: Maybe Text
instanceType :: Maybe InstanceType
instanceRequirements :: Maybe InstanceRequirements
imageId :: Maybe Text
iamInstanceProfile :: Maybe IamInstanceProfileSpecification
ebsOptimized :: Maybe Bool
blockDeviceMappings :: Maybe [BlockDeviceMapping]
addressingType :: Maybe Text
$sel:weightedCapacity:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Double
$sel:userData:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:tagSpecifications:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [SpotFleetTagSpecification]
$sel:subnetId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:spotPrice:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:securityGroups:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [GroupIdentifier]
$sel:ramdiskId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:placement:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe SpotPlacement
$sel:networkInterfaces:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification
-> Maybe [InstanceNetworkInterfaceSpecification]
$sel:monitoring:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe SpotFleetMonitoring
$sel:keyName:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:kernelId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:instanceType:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe InstanceType
$sel:instanceRequirements:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe InstanceRequirements
$sel:imageId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:iamInstanceProfile:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification
-> Maybe IamInstanceProfileSpecification
$sel:ebsOptimized:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Bool
$sel:blockDeviceMappings:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [BlockDeviceMapping]
$sel:addressingType:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
addressingType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [BlockDeviceMapping]
blockDeviceMappings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ebsOptimized
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IamInstanceProfileSpecification
iamInstanceProfile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
imageId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceRequirements
instanceRequirements
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceType
instanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kernelId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotFleetMonitoring
monitoring
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotPlacement
placement
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
ramdiskId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GroupIdentifier]
securityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spotPrice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subnetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SpotFleetTagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userData
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Double
weightedCapacity

instance Prelude.NFData SpotFleetLaunchSpecification where
  rnf :: SpotFleetLaunchSpecification -> ()
rnf SpotFleetLaunchSpecification' {Maybe Bool
Maybe Double
Maybe [GroupIdentifier]
Maybe [InstanceNetworkInterfaceSpecification]
Maybe [SpotFleetTagSpecification]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe IamInstanceProfileSpecification
Maybe InstanceType
Maybe SpotFleetMonitoring
Maybe SpotPlacement
Maybe InstanceRequirements
weightedCapacity :: Maybe Double
userData :: Maybe Text
tagSpecifications :: Maybe [SpotFleetTagSpecification]
subnetId :: Maybe Text
spotPrice :: Maybe Text
securityGroups :: Maybe [GroupIdentifier]
ramdiskId :: Maybe Text
placement :: Maybe SpotPlacement
networkInterfaces :: Maybe [InstanceNetworkInterfaceSpecification]
monitoring :: Maybe SpotFleetMonitoring
keyName :: Maybe Text
kernelId :: Maybe Text
instanceType :: Maybe InstanceType
instanceRequirements :: Maybe InstanceRequirements
imageId :: Maybe Text
iamInstanceProfile :: Maybe IamInstanceProfileSpecification
ebsOptimized :: Maybe Bool
blockDeviceMappings :: Maybe [BlockDeviceMapping]
addressingType :: Maybe Text
$sel:weightedCapacity:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Double
$sel:userData:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:tagSpecifications:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [SpotFleetTagSpecification]
$sel:subnetId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:spotPrice:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:securityGroups:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [GroupIdentifier]
$sel:ramdiskId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:placement:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe SpotPlacement
$sel:networkInterfaces:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification
-> Maybe [InstanceNetworkInterfaceSpecification]
$sel:monitoring:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe SpotFleetMonitoring
$sel:keyName:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:kernelId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:instanceType:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe InstanceType
$sel:instanceRequirements:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe InstanceRequirements
$sel:imageId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:iamInstanceProfile:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification
-> Maybe IamInstanceProfileSpecification
$sel:ebsOptimized:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Bool
$sel:blockDeviceMappings:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [BlockDeviceMapping]
$sel:addressingType:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
addressingType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [BlockDeviceMapping]
blockDeviceMappings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ebsOptimized
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IamInstanceProfileSpecification
iamInstanceProfile
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
imageId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceRequirements
instanceRequirements
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceType
instanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kernelId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpotFleetMonitoring
monitoring
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpotPlacement
placement
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
ramdiskId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [GroupIdentifier]
securityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
spotPrice
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subnetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SpotFleetTagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Double
weightedCapacity

instance Data.ToQuery SpotFleetLaunchSpecification where
  toQuery :: SpotFleetLaunchSpecification -> QueryString
toQuery SpotFleetLaunchSpecification' {Maybe Bool
Maybe Double
Maybe [GroupIdentifier]
Maybe [InstanceNetworkInterfaceSpecification]
Maybe [SpotFleetTagSpecification]
Maybe [BlockDeviceMapping]
Maybe Text
Maybe IamInstanceProfileSpecification
Maybe InstanceType
Maybe SpotFleetMonitoring
Maybe SpotPlacement
Maybe InstanceRequirements
weightedCapacity :: Maybe Double
userData :: Maybe Text
tagSpecifications :: Maybe [SpotFleetTagSpecification]
subnetId :: Maybe Text
spotPrice :: Maybe Text
securityGroups :: Maybe [GroupIdentifier]
ramdiskId :: Maybe Text
placement :: Maybe SpotPlacement
networkInterfaces :: Maybe [InstanceNetworkInterfaceSpecification]
monitoring :: Maybe SpotFleetMonitoring
keyName :: Maybe Text
kernelId :: Maybe Text
instanceType :: Maybe InstanceType
instanceRequirements :: Maybe InstanceRequirements
imageId :: Maybe Text
iamInstanceProfile :: Maybe IamInstanceProfileSpecification
ebsOptimized :: Maybe Bool
blockDeviceMappings :: Maybe [BlockDeviceMapping]
addressingType :: Maybe Text
$sel:weightedCapacity:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Double
$sel:userData:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:tagSpecifications:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [SpotFleetTagSpecification]
$sel:subnetId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:spotPrice:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:securityGroups:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [GroupIdentifier]
$sel:ramdiskId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:placement:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe SpotPlacement
$sel:networkInterfaces:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification
-> Maybe [InstanceNetworkInterfaceSpecification]
$sel:monitoring:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe SpotFleetMonitoring
$sel:keyName:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:kernelId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:instanceType:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe InstanceType
$sel:instanceRequirements:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe InstanceRequirements
$sel:imageId:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
$sel:iamInstanceProfile:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification
-> Maybe IamInstanceProfileSpecification
$sel:ebsOptimized:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Bool
$sel:blockDeviceMappings:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe [BlockDeviceMapping]
$sel:addressingType:SpotFleetLaunchSpecification' :: SpotFleetLaunchSpecification -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"AddressingType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
addressingType,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"BlockDeviceMapping"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [BlockDeviceMapping]
blockDeviceMappings
          ),
        ByteString
"EbsOptimized" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
ebsOptimized,
        ByteString
"IamInstanceProfile" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe IamInstanceProfileSpecification
iamInstanceProfile,
        ByteString
"ImageId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
imageId,
        ByteString
"InstanceRequirements" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceRequirements
instanceRequirements,
        ByteString
"InstanceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceType
instanceType,
        ByteString
"KernelId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kernelId,
        ByteString
"KeyName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
keyName,
        ByteString
"Monitoring" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SpotFleetMonitoring
monitoring,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"NetworkInterfaceSet"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [InstanceNetworkInterfaceSpecification]
networkInterfaces
          ),
        ByteString
"Placement" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SpotPlacement
placement,
        ByteString
"RamdiskId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
ramdiskId,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"GroupSet"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [GroupIdentifier]
securityGroups
          ),
        ByteString
"SpotPrice" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
spotPrice,
        ByteString
"SubnetId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
subnetId,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecificationSet"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [SpotFleetTagSpecification]
tagSpecifications
          ),
        ByteString
"UserData" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
userData,
        ByteString
"WeightedCapacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Double
weightedCapacity
      ]