{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.RequestSpotInstances
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a Spot Instance request.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-requests.html Spot Instance requests>
-- in the /Amazon EC2 User Guide for Linux Instances/.
--
-- We strongly discourage using the RequestSpotInstances API because it is
-- a legacy API with no planned investment. For options for requesting Spot
-- Instances, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-best-practices.html#which-spot-request-method-to-use Which is the best Spot request method to use?>
-- in the /Amazon EC2 User Guide for Linux Instances/.
--
-- We are retiring EC2-Classic. We recommend that you migrate from
-- EC2-Classic to a VPC. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/vpc-migrate.html Migrate from EC2-Classic to a VPC>
-- in the /Amazon EC2 User Guide for Linux Instances/.
module Amazonka.EC2.RequestSpotInstances
  ( -- * Creating a Request
    RequestSpotInstances (..),
    newRequestSpotInstances,

    -- * Request Lenses
    requestSpotInstances_availabilityZoneGroup,
    requestSpotInstances_blockDurationMinutes,
    requestSpotInstances_clientToken,
    requestSpotInstances_dryRun,
    requestSpotInstances_instanceCount,
    requestSpotInstances_instanceInterruptionBehavior,
    requestSpotInstances_launchGroup,
    requestSpotInstances_launchSpecification,
    requestSpotInstances_spotPrice,
    requestSpotInstances_tagSpecifications,
    requestSpotInstances_type,
    requestSpotInstances_validFrom,
    requestSpotInstances_validUntil,

    -- * Destructuring the Response
    RequestSpotInstancesResponse (..),
    newRequestSpotInstancesResponse,

    -- * Response Lenses
    requestSpotInstancesResponse_spotInstanceRequests,
    requestSpotInstancesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Contains the parameters for RequestSpotInstances.
--
-- /See:/ 'newRequestSpotInstances' smart constructor.
data RequestSpotInstances = RequestSpotInstances'
  { -- | The user-specified name for a logical grouping of requests.
    --
    -- When you specify an Availability Zone group in a Spot Instance request,
    -- all Spot Instances in the request are launched in the same Availability
    -- Zone. Instance proximity is maintained with this parameter, but the
    -- choice of Availability Zone is not. The group applies only to requests
    -- for Spot Instances of the same instance type. Any additional Spot
    -- Instance requests that are specified with the same Availability Zone
    -- group name are launched in that same Availability Zone, as long as at
    -- least one instance from the group is still active.
    --
    -- If there is no active instance running in the Availability Zone group
    -- that you specify for a new Spot Instance request (all instances are
    -- terminated, the request is expired, or the maximum price you specified
    -- falls below current Spot price), then Amazon EC2 launches the instance
    -- in any Availability Zone where the constraint can be met. Consequently,
    -- the subsequent set of Spot Instances could be placed in a different zone
    -- from the original request, even if you specified the same Availability
    -- Zone group.
    --
    -- Default: Instances are launched in any available Availability Zone.
    RequestSpotInstances -> Maybe Text
availabilityZoneGroup :: Prelude.Maybe Prelude.Text,
    -- | Deprecated.
    RequestSpotInstances -> Maybe Int
blockDurationMinutes :: Prelude.Maybe Prelude.Int,
    -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Run_Instance_Idempotency.html How to Ensure Idempotency>
    -- in the /Amazon EC2 User Guide for Linux Instances/.
    RequestSpotInstances -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    RequestSpotInstances -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The maximum number of Spot Instances to launch.
    --
    -- Default: 1
    RequestSpotInstances -> Maybe Int
instanceCount :: Prelude.Maybe Prelude.Int,
    -- | The behavior when a Spot Instance is interrupted. The default is
    -- @terminate@.
    RequestSpotInstances -> Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior :: Prelude.Maybe InstanceInterruptionBehavior,
    -- | The instance launch group. Launch groups are Spot Instances that launch
    -- together and terminate together.
    --
    -- Default: Instances are launched and terminated individually
    RequestSpotInstances -> Maybe Text
launchGroup :: Prelude.Maybe Prelude.Text,
    -- | The launch specification.
    RequestSpotInstances -> Maybe RequestSpotLaunchSpecification
launchSpecification :: Prelude.Maybe RequestSpotLaunchSpecification,
    -- | 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.
    RequestSpotInstances -> Maybe Text
spotPrice :: Prelude.Maybe Prelude.Text,
    -- | The key-value pair for tagging the Spot Instance request on creation.
    -- The value for @ResourceType@ must be @spot-instances-request@, otherwise
    -- the Spot Instance request fails. To tag the Spot Instance request after
    -- it has been created, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_CreateTags.html CreateTags>.
    RequestSpotInstances -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The Spot Instance request type.
    --
    -- Default: @one-time@
    RequestSpotInstances -> Maybe SpotInstanceType
type' :: Prelude.Maybe SpotInstanceType,
    -- | The start date of the request. If this is a one-time request, the
    -- request becomes active at this date and time and remains active until
    -- all instances launch, the request expires, or the request is canceled.
    -- If the request is persistent, the request becomes active at this date
    -- and time and remains active until it expires or is canceled.
    --
    -- The specified start date and time cannot be equal to the current date
    -- and time. You must specify a start date and time that occurs after the
    -- current date and time.
    RequestSpotInstances -> Maybe ISO8601
validFrom :: Prelude.Maybe Data.ISO8601,
    -- | The end date of the request, in UTC format
    -- (/YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
    --
    -- -   For a persistent request, the request remains active until the
    --     @ValidUntil@ date and time is reached. Otherwise, the request
    --     remains active until you cancel it.
    --
    -- -   For a one-time request, the request remains active until all
    --     instances launch, the request is canceled, or the @ValidUntil@ date
    --     and time is reached. By default, the request is valid for 7 days
    --     from the date the request was created.
    RequestSpotInstances -> Maybe ISO8601
validUntil :: Prelude.Maybe Data.ISO8601
  }
  deriving (RequestSpotInstances -> RequestSpotInstances -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestSpotInstances -> RequestSpotInstances -> Bool
$c/= :: RequestSpotInstances -> RequestSpotInstances -> Bool
== :: RequestSpotInstances -> RequestSpotInstances -> Bool
$c== :: RequestSpotInstances -> RequestSpotInstances -> Bool
Prelude.Eq, ReadPrec [RequestSpotInstances]
ReadPrec RequestSpotInstances
Int -> ReadS RequestSpotInstances
ReadS [RequestSpotInstances]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestSpotInstances]
$creadListPrec :: ReadPrec [RequestSpotInstances]
readPrec :: ReadPrec RequestSpotInstances
$creadPrec :: ReadPrec RequestSpotInstances
readList :: ReadS [RequestSpotInstances]
$creadList :: ReadS [RequestSpotInstances]
readsPrec :: Int -> ReadS RequestSpotInstances
$creadsPrec :: Int -> ReadS RequestSpotInstances
Prelude.Read, Int -> RequestSpotInstances -> ShowS
[RequestSpotInstances] -> ShowS
RequestSpotInstances -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestSpotInstances] -> ShowS
$cshowList :: [RequestSpotInstances] -> ShowS
show :: RequestSpotInstances -> String
$cshow :: RequestSpotInstances -> String
showsPrec :: Int -> RequestSpotInstances -> ShowS
$cshowsPrec :: Int -> RequestSpotInstances -> ShowS
Prelude.Show, forall x. Rep RequestSpotInstances x -> RequestSpotInstances
forall x. RequestSpotInstances -> Rep RequestSpotInstances x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestSpotInstances x -> RequestSpotInstances
$cfrom :: forall x. RequestSpotInstances -> Rep RequestSpotInstances x
Prelude.Generic)

-- |
-- Create a value of 'RequestSpotInstances' 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:
--
-- 'availabilityZoneGroup', 'requestSpotInstances_availabilityZoneGroup' - The user-specified name for a logical grouping of requests.
--
-- When you specify an Availability Zone group in a Spot Instance request,
-- all Spot Instances in the request are launched in the same Availability
-- Zone. Instance proximity is maintained with this parameter, but the
-- choice of Availability Zone is not. The group applies only to requests
-- for Spot Instances of the same instance type. Any additional Spot
-- Instance requests that are specified with the same Availability Zone
-- group name are launched in that same Availability Zone, as long as at
-- least one instance from the group is still active.
--
-- If there is no active instance running in the Availability Zone group
-- that you specify for a new Spot Instance request (all instances are
-- terminated, the request is expired, or the maximum price you specified
-- falls below current Spot price), then Amazon EC2 launches the instance
-- in any Availability Zone where the constraint can be met. Consequently,
-- the subsequent set of Spot Instances could be placed in a different zone
-- from the original request, even if you specified the same Availability
-- Zone group.
--
-- Default: Instances are launched in any available Availability Zone.
--
-- 'blockDurationMinutes', 'requestSpotInstances_blockDurationMinutes' - Deprecated.
--
-- 'clientToken', 'requestSpotInstances_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Run_Instance_Idempotency.html How to Ensure Idempotency>
-- in the /Amazon EC2 User Guide for Linux Instances/.
--
-- 'dryRun', 'requestSpotInstances_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'instanceCount', 'requestSpotInstances_instanceCount' - The maximum number of Spot Instances to launch.
--
-- Default: 1
--
-- 'instanceInterruptionBehavior', 'requestSpotInstances_instanceInterruptionBehavior' - The behavior when a Spot Instance is interrupted. The default is
-- @terminate@.
--
-- 'launchGroup', 'requestSpotInstances_launchGroup' - The instance launch group. Launch groups are Spot Instances that launch
-- together and terminate together.
--
-- Default: Instances are launched and terminated individually
--
-- 'launchSpecification', 'requestSpotInstances_launchSpecification' - The launch specification.
--
-- 'spotPrice', 'requestSpotInstances_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.
--
-- 'tagSpecifications', 'requestSpotInstances_tagSpecifications' - The key-value pair for tagging the Spot Instance request on creation.
-- The value for @ResourceType@ must be @spot-instances-request@, otherwise
-- the Spot Instance request fails. To tag the Spot Instance request after
-- it has been created, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_CreateTags.html CreateTags>.
--
-- 'type'', 'requestSpotInstances_type' - The Spot Instance request type.
--
-- Default: @one-time@
--
-- 'validFrom', 'requestSpotInstances_validFrom' - The start date of the request. If this is a one-time request, the
-- request becomes active at this date and time and remains active until
-- all instances launch, the request expires, or the request is canceled.
-- If the request is persistent, the request becomes active at this date
-- and time and remains active until it expires or is canceled.
--
-- The specified start date and time cannot be equal to the current date
-- and time. You must specify a start date and time that occurs after the
-- current date and time.
--
-- 'validUntil', 'requestSpotInstances_validUntil' - The end date of the request, in UTC format
-- (/YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
--
-- -   For a persistent request, the request remains active until the
--     @ValidUntil@ date and time is reached. Otherwise, the request
--     remains active until you cancel it.
--
-- -   For a one-time request, the request remains active until all
--     instances launch, the request is canceled, or the @ValidUntil@ date
--     and time is reached. By default, the request is valid for 7 days
--     from the date the request was created.
newRequestSpotInstances ::
  RequestSpotInstances
newRequestSpotInstances :: RequestSpotInstances
newRequestSpotInstances =
  RequestSpotInstances'
    { $sel:availabilityZoneGroup:RequestSpotInstances' :: Maybe Text
availabilityZoneGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:blockDurationMinutes:RequestSpotInstances' :: Maybe Int
blockDurationMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:RequestSpotInstances' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:RequestSpotInstances' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceCount:RequestSpotInstances' :: Maybe Int
instanceCount = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceInterruptionBehavior:RequestSpotInstances' :: Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:launchGroup:RequestSpotInstances' :: Maybe Text
launchGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:launchSpecification:RequestSpotInstances' :: Maybe RequestSpotLaunchSpecification
launchSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:spotPrice:RequestSpotInstances' :: Maybe Text
spotPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:RequestSpotInstances' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:type':RequestSpotInstances' :: Maybe SpotInstanceType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:validFrom:RequestSpotInstances' :: Maybe ISO8601
validFrom = forall a. Maybe a
Prelude.Nothing,
      $sel:validUntil:RequestSpotInstances' :: Maybe ISO8601
validUntil = forall a. Maybe a
Prelude.Nothing
    }

-- | The user-specified name for a logical grouping of requests.
--
-- When you specify an Availability Zone group in a Spot Instance request,
-- all Spot Instances in the request are launched in the same Availability
-- Zone. Instance proximity is maintained with this parameter, but the
-- choice of Availability Zone is not. The group applies only to requests
-- for Spot Instances of the same instance type. Any additional Spot
-- Instance requests that are specified with the same Availability Zone
-- group name are launched in that same Availability Zone, as long as at
-- least one instance from the group is still active.
--
-- If there is no active instance running in the Availability Zone group
-- that you specify for a new Spot Instance request (all instances are
-- terminated, the request is expired, or the maximum price you specified
-- falls below current Spot price), then Amazon EC2 launches the instance
-- in any Availability Zone where the constraint can be met. Consequently,
-- the subsequent set of Spot Instances could be placed in a different zone
-- from the original request, even if you specified the same Availability
-- Zone group.
--
-- Default: Instances are launched in any available Availability Zone.
requestSpotInstances_availabilityZoneGroup :: Lens.Lens' RequestSpotInstances (Prelude.Maybe Prelude.Text)
requestSpotInstances_availabilityZoneGroup :: Lens' RequestSpotInstances (Maybe Text)
requestSpotInstances_availabilityZoneGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe Text
availabilityZoneGroup :: Maybe Text
$sel:availabilityZoneGroup:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
availabilityZoneGroup} -> Maybe Text
availabilityZoneGroup) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe Text
a -> RequestSpotInstances
s {$sel:availabilityZoneGroup:RequestSpotInstances' :: Maybe Text
availabilityZoneGroup = Maybe Text
a} :: RequestSpotInstances)

-- | Deprecated.
requestSpotInstances_blockDurationMinutes :: Lens.Lens' RequestSpotInstances (Prelude.Maybe Prelude.Int)
requestSpotInstances_blockDurationMinutes :: Lens' RequestSpotInstances (Maybe Int)
requestSpotInstances_blockDurationMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe Int
blockDurationMinutes :: Maybe Int
$sel:blockDurationMinutes:RequestSpotInstances' :: RequestSpotInstances -> Maybe Int
blockDurationMinutes} -> Maybe Int
blockDurationMinutes) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe Int
a -> RequestSpotInstances
s {$sel:blockDurationMinutes:RequestSpotInstances' :: Maybe Int
blockDurationMinutes = Maybe Int
a} :: RequestSpotInstances)

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Run_Instance_Idempotency.html How to Ensure Idempotency>
-- in the /Amazon EC2 User Guide for Linux Instances/.
requestSpotInstances_clientToken :: Lens.Lens' RequestSpotInstances (Prelude.Maybe Prelude.Text)
requestSpotInstances_clientToken :: Lens' RequestSpotInstances (Maybe Text)
requestSpotInstances_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe Text
a -> RequestSpotInstances
s {$sel:clientToken:RequestSpotInstances' :: Maybe Text
clientToken = Maybe Text
a} :: RequestSpotInstances)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
requestSpotInstances_dryRun :: Lens.Lens' RequestSpotInstances (Prelude.Maybe Prelude.Bool)
requestSpotInstances_dryRun :: Lens' RequestSpotInstances (Maybe Bool)
requestSpotInstances_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:RequestSpotInstances' :: RequestSpotInstances -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe Bool
a -> RequestSpotInstances
s {$sel:dryRun:RequestSpotInstances' :: Maybe Bool
dryRun = Maybe Bool
a} :: RequestSpotInstances)

-- | The maximum number of Spot Instances to launch.
--
-- Default: 1
requestSpotInstances_instanceCount :: Lens.Lens' RequestSpotInstances (Prelude.Maybe Prelude.Int)
requestSpotInstances_instanceCount :: Lens' RequestSpotInstances (Maybe Int)
requestSpotInstances_instanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe Int
instanceCount :: Maybe Int
$sel:instanceCount:RequestSpotInstances' :: RequestSpotInstances -> Maybe Int
instanceCount} -> Maybe Int
instanceCount) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe Int
a -> RequestSpotInstances
s {$sel:instanceCount:RequestSpotInstances' :: Maybe Int
instanceCount = Maybe Int
a} :: RequestSpotInstances)

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

-- | The instance launch group. Launch groups are Spot Instances that launch
-- together and terminate together.
--
-- Default: Instances are launched and terminated individually
requestSpotInstances_launchGroup :: Lens.Lens' RequestSpotInstances (Prelude.Maybe Prelude.Text)
requestSpotInstances_launchGroup :: Lens' RequestSpotInstances (Maybe Text)
requestSpotInstances_launchGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe Text
launchGroup :: Maybe Text
$sel:launchGroup:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
launchGroup} -> Maybe Text
launchGroup) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe Text
a -> RequestSpotInstances
s {$sel:launchGroup:RequestSpotInstances' :: Maybe Text
launchGroup = Maybe Text
a} :: RequestSpotInstances)

-- | The launch specification.
requestSpotInstances_launchSpecification :: Lens.Lens' RequestSpotInstances (Prelude.Maybe RequestSpotLaunchSpecification)
requestSpotInstances_launchSpecification :: Lens' RequestSpotInstances (Maybe RequestSpotLaunchSpecification)
requestSpotInstances_launchSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe RequestSpotLaunchSpecification
launchSpecification :: Maybe RequestSpotLaunchSpecification
$sel:launchSpecification:RequestSpotInstances' :: RequestSpotInstances -> Maybe RequestSpotLaunchSpecification
launchSpecification} -> Maybe RequestSpotLaunchSpecification
launchSpecification) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe RequestSpotLaunchSpecification
a -> RequestSpotInstances
s {$sel:launchSpecification:RequestSpotInstances' :: Maybe RequestSpotLaunchSpecification
launchSpecification = Maybe RequestSpotLaunchSpecification
a} :: RequestSpotInstances)

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

-- | The key-value pair for tagging the Spot Instance request on creation.
-- The value for @ResourceType@ must be @spot-instances-request@, otherwise
-- the Spot Instance request fails. To tag the Spot Instance request after
-- it has been created, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_CreateTags.html CreateTags>.
requestSpotInstances_tagSpecifications :: Lens.Lens' RequestSpotInstances (Prelude.Maybe [TagSpecification])
requestSpotInstances_tagSpecifications :: Lens' RequestSpotInstances (Maybe [TagSpecification])
requestSpotInstances_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:RequestSpotInstances' :: RequestSpotInstances -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe [TagSpecification]
a -> RequestSpotInstances
s {$sel:tagSpecifications:RequestSpotInstances' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: RequestSpotInstances) 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 Spot Instance request type.
--
-- Default: @one-time@
requestSpotInstances_type :: Lens.Lens' RequestSpotInstances (Prelude.Maybe SpotInstanceType)
requestSpotInstances_type :: Lens' RequestSpotInstances (Maybe SpotInstanceType)
requestSpotInstances_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe SpotInstanceType
type' :: Maybe SpotInstanceType
$sel:type':RequestSpotInstances' :: RequestSpotInstances -> Maybe SpotInstanceType
type'} -> Maybe SpotInstanceType
type') (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe SpotInstanceType
a -> RequestSpotInstances
s {$sel:type':RequestSpotInstances' :: Maybe SpotInstanceType
type' = Maybe SpotInstanceType
a} :: RequestSpotInstances)

-- | The start date of the request. If this is a one-time request, the
-- request becomes active at this date and time and remains active until
-- all instances launch, the request expires, or the request is canceled.
-- If the request is persistent, the request becomes active at this date
-- and time and remains active until it expires or is canceled.
--
-- The specified start date and time cannot be equal to the current date
-- and time. You must specify a start date and time that occurs after the
-- current date and time.
requestSpotInstances_validFrom :: Lens.Lens' RequestSpotInstances (Prelude.Maybe Prelude.UTCTime)
requestSpotInstances_validFrom :: Lens' RequestSpotInstances (Maybe UTCTime)
requestSpotInstances_validFrom = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe ISO8601
validFrom :: Maybe ISO8601
$sel:validFrom:RequestSpotInstances' :: RequestSpotInstances -> Maybe ISO8601
validFrom} -> Maybe ISO8601
validFrom) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe ISO8601
a -> RequestSpotInstances
s {$sel:validFrom:RequestSpotInstances' :: Maybe ISO8601
validFrom = Maybe ISO8601
a} :: RequestSpotInstances) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The end date of the request, in UTC format
-- (/YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
--
-- -   For a persistent request, the request remains active until the
--     @ValidUntil@ date and time is reached. Otherwise, the request
--     remains active until you cancel it.
--
-- -   For a one-time request, the request remains active until all
--     instances launch, the request is canceled, or the @ValidUntil@ date
--     and time is reached. By default, the request is valid for 7 days
--     from the date the request was created.
requestSpotInstances_validUntil :: Lens.Lens' RequestSpotInstances (Prelude.Maybe Prelude.UTCTime)
requestSpotInstances_validUntil :: Lens' RequestSpotInstances (Maybe UTCTime)
requestSpotInstances_validUntil = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstances' {Maybe ISO8601
validUntil :: Maybe ISO8601
$sel:validUntil:RequestSpotInstances' :: RequestSpotInstances -> Maybe ISO8601
validUntil} -> Maybe ISO8601
validUntil) (\s :: RequestSpotInstances
s@RequestSpotInstances' {} Maybe ISO8601
a -> RequestSpotInstances
s {$sel:validUntil:RequestSpotInstances' :: Maybe ISO8601
validUntil = Maybe ISO8601
a} :: RequestSpotInstances) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSRequest RequestSpotInstances where
  type
    AWSResponse RequestSpotInstances =
      RequestSpotInstancesResponse
  request :: (Service -> Service)
-> RequestSpotInstances -> Request RequestSpotInstances
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RequestSpotInstances
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RequestSpotInstances)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [SpotInstanceRequest] -> Int -> RequestSpotInstancesResponse
RequestSpotInstancesResponse'
            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
"spotInstanceRequestSet"
                            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable RequestSpotInstances where
  hashWithSalt :: Int -> RequestSpotInstances -> Int
hashWithSalt Int
_salt RequestSpotInstances' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe ISO8601
Maybe InstanceInterruptionBehavior
Maybe SpotInstanceType
Maybe RequestSpotLaunchSpecification
validUntil :: Maybe ISO8601
validFrom :: Maybe ISO8601
type' :: Maybe SpotInstanceType
tagSpecifications :: Maybe [TagSpecification]
spotPrice :: Maybe Text
launchSpecification :: Maybe RequestSpotLaunchSpecification
launchGroup :: Maybe Text
instanceInterruptionBehavior :: Maybe InstanceInterruptionBehavior
instanceCount :: Maybe Int
dryRun :: Maybe Bool
clientToken :: Maybe Text
blockDurationMinutes :: Maybe Int
availabilityZoneGroup :: Maybe Text
$sel:validUntil:RequestSpotInstances' :: RequestSpotInstances -> Maybe ISO8601
$sel:validFrom:RequestSpotInstances' :: RequestSpotInstances -> Maybe ISO8601
$sel:type':RequestSpotInstances' :: RequestSpotInstances -> Maybe SpotInstanceType
$sel:tagSpecifications:RequestSpotInstances' :: RequestSpotInstances -> Maybe [TagSpecification]
$sel:spotPrice:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:launchSpecification:RequestSpotInstances' :: RequestSpotInstances -> Maybe RequestSpotLaunchSpecification
$sel:launchGroup:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:instanceInterruptionBehavior:RequestSpotInstances' :: RequestSpotInstances -> Maybe InstanceInterruptionBehavior
$sel:instanceCount:RequestSpotInstances' :: RequestSpotInstances -> Maybe Int
$sel:dryRun:RequestSpotInstances' :: RequestSpotInstances -> Maybe Bool
$sel:clientToken:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:blockDurationMinutes:RequestSpotInstances' :: RequestSpotInstances -> Maybe Int
$sel:availabilityZoneGroup:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
availabilityZoneGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
blockDurationMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
instanceCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
launchGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RequestSpotLaunchSpecification
launchSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spotPrice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotInstanceType
type'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
validFrom
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
validUntil

instance Prelude.NFData RequestSpotInstances where
  rnf :: RequestSpotInstances -> ()
rnf RequestSpotInstances' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe ISO8601
Maybe InstanceInterruptionBehavior
Maybe SpotInstanceType
Maybe RequestSpotLaunchSpecification
validUntil :: Maybe ISO8601
validFrom :: Maybe ISO8601
type' :: Maybe SpotInstanceType
tagSpecifications :: Maybe [TagSpecification]
spotPrice :: Maybe Text
launchSpecification :: Maybe RequestSpotLaunchSpecification
launchGroup :: Maybe Text
instanceInterruptionBehavior :: Maybe InstanceInterruptionBehavior
instanceCount :: Maybe Int
dryRun :: Maybe Bool
clientToken :: Maybe Text
blockDurationMinutes :: Maybe Int
availabilityZoneGroup :: Maybe Text
$sel:validUntil:RequestSpotInstances' :: RequestSpotInstances -> Maybe ISO8601
$sel:validFrom:RequestSpotInstances' :: RequestSpotInstances -> Maybe ISO8601
$sel:type':RequestSpotInstances' :: RequestSpotInstances -> Maybe SpotInstanceType
$sel:tagSpecifications:RequestSpotInstances' :: RequestSpotInstances -> Maybe [TagSpecification]
$sel:spotPrice:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:launchSpecification:RequestSpotInstances' :: RequestSpotInstances -> Maybe RequestSpotLaunchSpecification
$sel:launchGroup:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:instanceInterruptionBehavior:RequestSpotInstances' :: RequestSpotInstances -> Maybe InstanceInterruptionBehavior
$sel:instanceCount:RequestSpotInstances' :: RequestSpotInstances -> Maybe Int
$sel:dryRun:RequestSpotInstances' :: RequestSpotInstances -> Maybe Bool
$sel:clientToken:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:blockDurationMinutes:RequestSpotInstances' :: RequestSpotInstances -> Maybe Int
$sel:availabilityZoneGroup:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
availabilityZoneGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
blockDurationMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
instanceCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
launchGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestSpotLaunchSpecification
launchSpecification
      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 [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpotInstanceType
type'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
validFrom
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
validUntil

instance Data.ToHeaders RequestSpotInstances where
  toHeaders :: RequestSpotInstances -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath RequestSpotInstances where
  toPath :: RequestSpotInstances -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery RequestSpotInstances where
  toQuery :: RequestSpotInstances -> QueryString
toQuery RequestSpotInstances' {Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe ISO8601
Maybe InstanceInterruptionBehavior
Maybe SpotInstanceType
Maybe RequestSpotLaunchSpecification
validUntil :: Maybe ISO8601
validFrom :: Maybe ISO8601
type' :: Maybe SpotInstanceType
tagSpecifications :: Maybe [TagSpecification]
spotPrice :: Maybe Text
launchSpecification :: Maybe RequestSpotLaunchSpecification
launchGroup :: Maybe Text
instanceInterruptionBehavior :: Maybe InstanceInterruptionBehavior
instanceCount :: Maybe Int
dryRun :: Maybe Bool
clientToken :: Maybe Text
blockDurationMinutes :: Maybe Int
availabilityZoneGroup :: Maybe Text
$sel:validUntil:RequestSpotInstances' :: RequestSpotInstances -> Maybe ISO8601
$sel:validFrom:RequestSpotInstances' :: RequestSpotInstances -> Maybe ISO8601
$sel:type':RequestSpotInstances' :: RequestSpotInstances -> Maybe SpotInstanceType
$sel:tagSpecifications:RequestSpotInstances' :: RequestSpotInstances -> Maybe [TagSpecification]
$sel:spotPrice:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:launchSpecification:RequestSpotInstances' :: RequestSpotInstances -> Maybe RequestSpotLaunchSpecification
$sel:launchGroup:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:instanceInterruptionBehavior:RequestSpotInstances' :: RequestSpotInstances -> Maybe InstanceInterruptionBehavior
$sel:instanceCount:RequestSpotInstances' :: RequestSpotInstances -> Maybe Int
$sel:dryRun:RequestSpotInstances' :: RequestSpotInstances -> Maybe Bool
$sel:clientToken:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
$sel:blockDurationMinutes:RequestSpotInstances' :: RequestSpotInstances -> Maybe Int
$sel:availabilityZoneGroup:RequestSpotInstances' :: RequestSpotInstances -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RequestSpotInstances" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"AvailabilityZoneGroup"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
availabilityZoneGroup,
        ByteString
"BlockDurationMinutes" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
blockDurationMinutes,
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"InstanceCount" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
instanceCount,
        ByteString
"InstanceInterruptionBehavior"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior,
        ByteString
"LaunchGroup" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
launchGroup,
        ByteString
"LaunchSpecification" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe RequestSpotLaunchSpecification
launchSpecification,
        ByteString
"SpotPrice" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
spotPrice,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"Type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SpotInstanceType
type',
        ByteString
"ValidFrom" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
validFrom,
        ByteString
"ValidUntil" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
validUntil
      ]

-- | Contains the output of RequestSpotInstances.
--
-- /See:/ 'newRequestSpotInstancesResponse' smart constructor.
data RequestSpotInstancesResponse = RequestSpotInstancesResponse'
  { -- | One or more Spot Instance requests.
    RequestSpotInstancesResponse -> Maybe [SpotInstanceRequest]
spotInstanceRequests :: Prelude.Maybe [SpotInstanceRequest],
    -- | The response's http status code.
    RequestSpotInstancesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (RequestSpotInstancesResponse
-> RequestSpotInstancesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestSpotInstancesResponse
-> RequestSpotInstancesResponse -> Bool
$c/= :: RequestSpotInstancesResponse
-> RequestSpotInstancesResponse -> Bool
== :: RequestSpotInstancesResponse
-> RequestSpotInstancesResponse -> Bool
$c== :: RequestSpotInstancesResponse
-> RequestSpotInstancesResponse -> Bool
Prelude.Eq, ReadPrec [RequestSpotInstancesResponse]
ReadPrec RequestSpotInstancesResponse
Int -> ReadS RequestSpotInstancesResponse
ReadS [RequestSpotInstancesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RequestSpotInstancesResponse]
$creadListPrec :: ReadPrec [RequestSpotInstancesResponse]
readPrec :: ReadPrec RequestSpotInstancesResponse
$creadPrec :: ReadPrec RequestSpotInstancesResponse
readList :: ReadS [RequestSpotInstancesResponse]
$creadList :: ReadS [RequestSpotInstancesResponse]
readsPrec :: Int -> ReadS RequestSpotInstancesResponse
$creadsPrec :: Int -> ReadS RequestSpotInstancesResponse
Prelude.Read, Int -> RequestSpotInstancesResponse -> ShowS
[RequestSpotInstancesResponse] -> ShowS
RequestSpotInstancesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestSpotInstancesResponse] -> ShowS
$cshowList :: [RequestSpotInstancesResponse] -> ShowS
show :: RequestSpotInstancesResponse -> String
$cshow :: RequestSpotInstancesResponse -> String
showsPrec :: Int -> RequestSpotInstancesResponse -> ShowS
$cshowsPrec :: Int -> RequestSpotInstancesResponse -> ShowS
Prelude.Show, forall x.
Rep RequestSpotInstancesResponse x -> RequestSpotInstancesResponse
forall x.
RequestSpotInstancesResponse -> Rep RequestSpotInstancesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RequestSpotInstancesResponse x -> RequestSpotInstancesResponse
$cfrom :: forall x.
RequestSpotInstancesResponse -> Rep RequestSpotInstancesResponse x
Prelude.Generic)

-- |
-- Create a value of 'RequestSpotInstancesResponse' 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:
--
-- 'spotInstanceRequests', 'requestSpotInstancesResponse_spotInstanceRequests' - One or more Spot Instance requests.
--
-- 'httpStatus', 'requestSpotInstancesResponse_httpStatus' - The response's http status code.
newRequestSpotInstancesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RequestSpotInstancesResponse
newRequestSpotInstancesResponse :: Int -> RequestSpotInstancesResponse
newRequestSpotInstancesResponse Int
pHttpStatus_ =
  RequestSpotInstancesResponse'
    { $sel:spotInstanceRequests:RequestSpotInstancesResponse' :: Maybe [SpotInstanceRequest]
spotInstanceRequests =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RequestSpotInstancesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | One or more Spot Instance requests.
requestSpotInstancesResponse_spotInstanceRequests :: Lens.Lens' RequestSpotInstancesResponse (Prelude.Maybe [SpotInstanceRequest])
requestSpotInstancesResponse_spotInstanceRequests :: Lens' RequestSpotInstancesResponse (Maybe [SpotInstanceRequest])
requestSpotInstancesResponse_spotInstanceRequests = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstancesResponse' {Maybe [SpotInstanceRequest]
spotInstanceRequests :: Maybe [SpotInstanceRequest]
$sel:spotInstanceRequests:RequestSpotInstancesResponse' :: RequestSpotInstancesResponse -> Maybe [SpotInstanceRequest]
spotInstanceRequests} -> Maybe [SpotInstanceRequest]
spotInstanceRequests) (\s :: RequestSpotInstancesResponse
s@RequestSpotInstancesResponse' {} Maybe [SpotInstanceRequest]
a -> RequestSpotInstancesResponse
s {$sel:spotInstanceRequests:RequestSpotInstancesResponse' :: Maybe [SpotInstanceRequest]
spotInstanceRequests = Maybe [SpotInstanceRequest]
a} :: RequestSpotInstancesResponse) 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 response's http status code.
requestSpotInstancesResponse_httpStatus :: Lens.Lens' RequestSpotInstancesResponse Prelude.Int
requestSpotInstancesResponse_httpStatus :: Lens' RequestSpotInstancesResponse Int
requestSpotInstancesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RequestSpotInstancesResponse' {Int
httpStatus :: Int
$sel:httpStatus:RequestSpotInstancesResponse' :: RequestSpotInstancesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: RequestSpotInstancesResponse
s@RequestSpotInstancesResponse' {} Int
a -> RequestSpotInstancesResponse
s {$sel:httpStatus:RequestSpotInstancesResponse' :: Int
httpStatus = Int
a} :: RequestSpotInstancesResponse)

instance Prelude.NFData RequestSpotInstancesResponse where
  rnf :: RequestSpotInstancesResponse -> ()
rnf RequestSpotInstancesResponse' {Int
Maybe [SpotInstanceRequest]
httpStatus :: Int
spotInstanceRequests :: Maybe [SpotInstanceRequest]
$sel:httpStatus:RequestSpotInstancesResponse' :: RequestSpotInstancesResponse -> Int
$sel:spotInstanceRequests:RequestSpotInstancesResponse' :: RequestSpotInstancesResponse -> Maybe [SpotInstanceRequest]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [SpotInstanceRequest]
spotInstanceRequests
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus