{-# 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.SpotInstanceRequest
-- 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.SpotInstanceRequest 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.InstanceInterruptionBehavior
import Amazonka.EC2.Types.LaunchSpecification
import Amazonka.EC2.Types.RIProductDescription
import Amazonka.EC2.Types.SpotInstanceState
import Amazonka.EC2.Types.SpotInstanceStateFault
import Amazonka.EC2.Types.SpotInstanceStatus
import Amazonka.EC2.Types.SpotInstanceType
import Amazonka.EC2.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Describes a Spot Instance request.
--
-- /See:/ 'newSpotInstanceRequest' smart constructor.
data SpotInstanceRequest = SpotInstanceRequest'
  { -- | Deprecated.
    SpotInstanceRequest -> Maybe Text
actualBlockHourlyPrice :: Prelude.Maybe Prelude.Text,
    -- | The Availability Zone group. If you specify the same Availability Zone
    -- group for all Spot Instance requests, all Spot Instances are launched in
    -- the same Availability Zone.
    SpotInstanceRequest -> Maybe Text
availabilityZoneGroup :: Prelude.Maybe Prelude.Text,
    -- | Deprecated.
    SpotInstanceRequest -> Maybe Int
blockDurationMinutes :: Prelude.Maybe Prelude.Int,
    -- | The date and time when the Spot Instance request was created, in UTC
    -- format (for example, /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
    SpotInstanceRequest -> Maybe ISO8601
createTime :: Prelude.Maybe Data.ISO8601,
    -- | The fault codes for the Spot Instance request, if any.
    SpotInstanceRequest -> Maybe SpotInstanceStateFault
fault :: Prelude.Maybe SpotInstanceStateFault,
    -- | The instance ID, if an instance has been launched to fulfill the Spot
    -- Instance request.
    SpotInstanceRequest -> Maybe Text
instanceId :: Prelude.Maybe Prelude.Text,
    -- | The behavior when a Spot Instance is interrupted.
    SpotInstanceRequest -> Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior :: Prelude.Maybe InstanceInterruptionBehavior,
    -- | The instance launch group. Launch groups are Spot Instances that launch
    -- together and terminate together.
    SpotInstanceRequest -> Maybe Text
launchGroup :: Prelude.Maybe Prelude.Text,
    -- | Additional information for launching instances.
    SpotInstanceRequest -> Maybe LaunchSpecification
launchSpecification :: Prelude.Maybe LaunchSpecification,
    -- | The Availability Zone in which the request is launched.
    SpotInstanceRequest -> Maybe Text
launchedAvailabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The product description associated with the Spot Instance.
    SpotInstanceRequest -> Maybe RIProductDescription
productDescription :: Prelude.Maybe RIProductDescription,
    -- | The ID of the Spot Instance request.
    SpotInstanceRequest -> Maybe Text
spotInstanceRequestId :: Prelude.Maybe Prelude.Text,
    -- | 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.
    SpotInstanceRequest -> Maybe Text
spotPrice :: Prelude.Maybe Prelude.Text,
    -- | The state of the Spot Instance request. Spot request status information
    -- helps track your Spot Instance requests. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-request-status.html Spot request status>
    -- in the /Amazon EC2 User Guide for Linux Instances/.
    SpotInstanceRequest -> Maybe SpotInstanceState
state :: Prelude.Maybe SpotInstanceState,
    -- | The status code and status message describing the Spot Instance request.
    SpotInstanceRequest -> Maybe SpotInstanceStatus
status :: Prelude.Maybe SpotInstanceStatus,
    -- | Any tags assigned to the resource.
    SpotInstanceRequest -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The Spot Instance request type.
    SpotInstanceRequest -> Maybe SpotInstanceType
type' :: Prelude.Maybe SpotInstanceType,
    -- | The start date of the request, in UTC format (for example,
    -- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z). The request becomes active at this
    -- date and time.
    SpotInstanceRequest -> 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.
    SpotInstanceRequest -> Maybe ISO8601
validUntil :: Prelude.Maybe Data.ISO8601
  }
  deriving (SpotInstanceRequest -> SpotInstanceRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpotInstanceRequest -> SpotInstanceRequest -> Bool
$c/= :: SpotInstanceRequest -> SpotInstanceRequest -> Bool
== :: SpotInstanceRequest -> SpotInstanceRequest -> Bool
$c== :: SpotInstanceRequest -> SpotInstanceRequest -> Bool
Prelude.Eq, ReadPrec [SpotInstanceRequest]
ReadPrec SpotInstanceRequest
Int -> ReadS SpotInstanceRequest
ReadS [SpotInstanceRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpotInstanceRequest]
$creadListPrec :: ReadPrec [SpotInstanceRequest]
readPrec :: ReadPrec SpotInstanceRequest
$creadPrec :: ReadPrec SpotInstanceRequest
readList :: ReadS [SpotInstanceRequest]
$creadList :: ReadS [SpotInstanceRequest]
readsPrec :: Int -> ReadS SpotInstanceRequest
$creadsPrec :: Int -> ReadS SpotInstanceRequest
Prelude.Read, Int -> SpotInstanceRequest -> ShowS
[SpotInstanceRequest] -> ShowS
SpotInstanceRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpotInstanceRequest] -> ShowS
$cshowList :: [SpotInstanceRequest] -> ShowS
show :: SpotInstanceRequest -> String
$cshow :: SpotInstanceRequest -> String
showsPrec :: Int -> SpotInstanceRequest -> ShowS
$cshowsPrec :: Int -> SpotInstanceRequest -> ShowS
Prelude.Show, forall x. Rep SpotInstanceRequest x -> SpotInstanceRequest
forall x. SpotInstanceRequest -> Rep SpotInstanceRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpotInstanceRequest x -> SpotInstanceRequest
$cfrom :: forall x. SpotInstanceRequest -> Rep SpotInstanceRequest x
Prelude.Generic)

-- |
-- Create a value of 'SpotInstanceRequest' 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:
--
-- 'actualBlockHourlyPrice', 'spotInstanceRequest_actualBlockHourlyPrice' - Deprecated.
--
-- 'availabilityZoneGroup', 'spotInstanceRequest_availabilityZoneGroup' - The Availability Zone group. If you specify the same Availability Zone
-- group for all Spot Instance requests, all Spot Instances are launched in
-- the same Availability Zone.
--
-- 'blockDurationMinutes', 'spotInstanceRequest_blockDurationMinutes' - Deprecated.
--
-- 'createTime', 'spotInstanceRequest_createTime' - The date and time when the Spot Instance request was created, in UTC
-- format (for example, /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
--
-- 'fault', 'spotInstanceRequest_fault' - The fault codes for the Spot Instance request, if any.
--
-- 'instanceId', 'spotInstanceRequest_instanceId' - The instance ID, if an instance has been launched to fulfill the Spot
-- Instance request.
--
-- 'instanceInterruptionBehavior', 'spotInstanceRequest_instanceInterruptionBehavior' - The behavior when a Spot Instance is interrupted.
--
-- 'launchGroup', 'spotInstanceRequest_launchGroup' - The instance launch group. Launch groups are Spot Instances that launch
-- together and terminate together.
--
-- 'launchSpecification', 'spotInstanceRequest_launchSpecification' - Additional information for launching instances.
--
-- 'launchedAvailabilityZone', 'spotInstanceRequest_launchedAvailabilityZone' - The Availability Zone in which the request is launched.
--
-- 'productDescription', 'spotInstanceRequest_productDescription' - The product description associated with the Spot Instance.
--
-- 'spotInstanceRequestId', 'spotInstanceRequest_spotInstanceRequestId' - The ID of the Spot Instance request.
--
-- 'spotPrice', 'spotInstanceRequest_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.
--
-- 'state', 'spotInstanceRequest_state' - The state of the Spot Instance request. Spot request status information
-- helps track your Spot Instance requests. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-request-status.html Spot request status>
-- in the /Amazon EC2 User Guide for Linux Instances/.
--
-- 'status', 'spotInstanceRequest_status' - The status code and status message describing the Spot Instance request.
--
-- 'tags', 'spotInstanceRequest_tags' - Any tags assigned to the resource.
--
-- 'type'', 'spotInstanceRequest_type' - The Spot Instance request type.
--
-- 'validFrom', 'spotInstanceRequest_validFrom' - The start date of the request, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z). The request becomes active at this
-- date and time.
--
-- 'validUntil', 'spotInstanceRequest_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.
newSpotInstanceRequest ::
  SpotInstanceRequest
newSpotInstanceRequest :: SpotInstanceRequest
newSpotInstanceRequest =
  SpotInstanceRequest'
    { $sel:actualBlockHourlyPrice:SpotInstanceRequest' :: Maybe Text
actualBlockHourlyPrice =
        forall a. Maybe a
Prelude.Nothing,
      $sel:availabilityZoneGroup:SpotInstanceRequest' :: Maybe Text
availabilityZoneGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:blockDurationMinutes:SpotInstanceRequest' :: Maybe Int
blockDurationMinutes = forall a. Maybe a
Prelude.Nothing,
      $sel:createTime:SpotInstanceRequest' :: Maybe ISO8601
createTime = forall a. Maybe a
Prelude.Nothing,
      $sel:fault:SpotInstanceRequest' :: Maybe SpotInstanceStateFault
fault = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceId:SpotInstanceRequest' :: Maybe Text
instanceId = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceInterruptionBehavior:SpotInstanceRequest' :: Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:launchGroup:SpotInstanceRequest' :: Maybe Text
launchGroup = forall a. Maybe a
Prelude.Nothing,
      $sel:launchSpecification:SpotInstanceRequest' :: Maybe LaunchSpecification
launchSpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:launchedAvailabilityZone:SpotInstanceRequest' :: Maybe Text
launchedAvailabilityZone = forall a. Maybe a
Prelude.Nothing,
      $sel:productDescription:SpotInstanceRequest' :: Maybe RIProductDescription
productDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:spotInstanceRequestId:SpotInstanceRequest' :: Maybe Text
spotInstanceRequestId = forall a. Maybe a
Prelude.Nothing,
      $sel:spotPrice:SpotInstanceRequest' :: Maybe Text
spotPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:state:SpotInstanceRequest' :: Maybe SpotInstanceState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:status:SpotInstanceRequest' :: Maybe SpotInstanceStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:SpotInstanceRequest' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:type':SpotInstanceRequest' :: Maybe SpotInstanceType
type' = forall a. Maybe a
Prelude.Nothing,
      $sel:validFrom:SpotInstanceRequest' :: Maybe ISO8601
validFrom = forall a. Maybe a
Prelude.Nothing,
      $sel:validUntil:SpotInstanceRequest' :: Maybe ISO8601
validUntil = forall a. Maybe a
Prelude.Nothing
    }

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

-- | The Availability Zone group. If you specify the same Availability Zone
-- group for all Spot Instance requests, all Spot Instances are launched in
-- the same Availability Zone.
spotInstanceRequest_availabilityZoneGroup :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe Prelude.Text)
spotInstanceRequest_availabilityZoneGroup :: Lens' SpotInstanceRequest (Maybe Text)
spotInstanceRequest_availabilityZoneGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe Text
availabilityZoneGroup :: Maybe Text
$sel:availabilityZoneGroup:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
availabilityZoneGroup} -> Maybe Text
availabilityZoneGroup) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe Text
a -> SpotInstanceRequest
s {$sel:availabilityZoneGroup:SpotInstanceRequest' :: Maybe Text
availabilityZoneGroup = Maybe Text
a} :: SpotInstanceRequest)

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

-- | The date and time when the Spot Instance request was created, in UTC
-- format (for example, /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z).
spotInstanceRequest_createTime :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe Prelude.UTCTime)
spotInstanceRequest_createTime :: Lens' SpotInstanceRequest (Maybe UTCTime)
spotInstanceRequest_createTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe ISO8601
createTime :: Maybe ISO8601
$sel:createTime:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
createTime} -> Maybe ISO8601
createTime) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe ISO8601
a -> SpotInstanceRequest
s {$sel:createTime:SpotInstanceRequest' :: Maybe ISO8601
createTime = Maybe ISO8601
a} :: SpotInstanceRequest) 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 fault codes for the Spot Instance request, if any.
spotInstanceRequest_fault :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe SpotInstanceStateFault)
spotInstanceRequest_fault :: Lens' SpotInstanceRequest (Maybe SpotInstanceStateFault)
spotInstanceRequest_fault = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe SpotInstanceStateFault
fault :: Maybe SpotInstanceStateFault
$sel:fault:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceStateFault
fault} -> Maybe SpotInstanceStateFault
fault) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe SpotInstanceStateFault
a -> SpotInstanceRequest
s {$sel:fault:SpotInstanceRequest' :: Maybe SpotInstanceStateFault
fault = Maybe SpotInstanceStateFault
a} :: SpotInstanceRequest)

-- | The instance ID, if an instance has been launched to fulfill the Spot
-- Instance request.
spotInstanceRequest_instanceId :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe Prelude.Text)
spotInstanceRequest_instanceId :: Lens' SpotInstanceRequest (Maybe Text)
spotInstanceRequest_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe Text
instanceId :: Maybe Text
$sel:instanceId:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
instanceId} -> Maybe Text
instanceId) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe Text
a -> SpotInstanceRequest
s {$sel:instanceId:SpotInstanceRequest' :: Maybe Text
instanceId = Maybe Text
a} :: SpotInstanceRequest)

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

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

-- | Additional information for launching instances.
spotInstanceRequest_launchSpecification :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe LaunchSpecification)
spotInstanceRequest_launchSpecification :: Lens' SpotInstanceRequest (Maybe LaunchSpecification)
spotInstanceRequest_launchSpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe LaunchSpecification
launchSpecification :: Maybe LaunchSpecification
$sel:launchSpecification:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe LaunchSpecification
launchSpecification} -> Maybe LaunchSpecification
launchSpecification) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe LaunchSpecification
a -> SpotInstanceRequest
s {$sel:launchSpecification:SpotInstanceRequest' :: Maybe LaunchSpecification
launchSpecification = Maybe LaunchSpecification
a} :: SpotInstanceRequest)

-- | The Availability Zone in which the request is launched.
spotInstanceRequest_launchedAvailabilityZone :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe Prelude.Text)
spotInstanceRequest_launchedAvailabilityZone :: Lens' SpotInstanceRequest (Maybe Text)
spotInstanceRequest_launchedAvailabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe Text
launchedAvailabilityZone :: Maybe Text
$sel:launchedAvailabilityZone:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
launchedAvailabilityZone} -> Maybe Text
launchedAvailabilityZone) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe Text
a -> SpotInstanceRequest
s {$sel:launchedAvailabilityZone:SpotInstanceRequest' :: Maybe Text
launchedAvailabilityZone = Maybe Text
a} :: SpotInstanceRequest)

-- | The product description associated with the Spot Instance.
spotInstanceRequest_productDescription :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe RIProductDescription)
spotInstanceRequest_productDescription :: Lens' SpotInstanceRequest (Maybe RIProductDescription)
spotInstanceRequest_productDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe RIProductDescription
productDescription :: Maybe RIProductDescription
$sel:productDescription:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe RIProductDescription
productDescription} -> Maybe RIProductDescription
productDescription) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe RIProductDescription
a -> SpotInstanceRequest
s {$sel:productDescription:SpotInstanceRequest' :: Maybe RIProductDescription
productDescription = Maybe RIProductDescription
a} :: SpotInstanceRequest)

-- | The ID of the Spot Instance request.
spotInstanceRequest_spotInstanceRequestId :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe Prelude.Text)
spotInstanceRequest_spotInstanceRequestId :: Lens' SpotInstanceRequest (Maybe Text)
spotInstanceRequest_spotInstanceRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe Text
spotInstanceRequestId :: Maybe Text
$sel:spotInstanceRequestId:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
spotInstanceRequestId} -> Maybe Text
spotInstanceRequestId) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe Text
a -> SpotInstanceRequest
s {$sel:spotInstanceRequestId:SpotInstanceRequest' :: Maybe Text
spotInstanceRequestId = Maybe Text
a} :: SpotInstanceRequest)

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

-- | The state of the Spot Instance request. Spot request status information
-- helps track your Spot Instance requests. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/spot-request-status.html Spot request status>
-- in the /Amazon EC2 User Guide for Linux Instances/.
spotInstanceRequest_state :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe SpotInstanceState)
spotInstanceRequest_state :: Lens' SpotInstanceRequest (Maybe SpotInstanceState)
spotInstanceRequest_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe SpotInstanceState
state :: Maybe SpotInstanceState
$sel:state:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceState
state} -> Maybe SpotInstanceState
state) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe SpotInstanceState
a -> SpotInstanceRequest
s {$sel:state:SpotInstanceRequest' :: Maybe SpotInstanceState
state = Maybe SpotInstanceState
a} :: SpotInstanceRequest)

-- | The status code and status message describing the Spot Instance request.
spotInstanceRequest_status :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe SpotInstanceStatus)
spotInstanceRequest_status :: Lens' SpotInstanceRequest (Maybe SpotInstanceStatus)
spotInstanceRequest_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe SpotInstanceStatus
status :: Maybe SpotInstanceStatus
$sel:status:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceStatus
status} -> Maybe SpotInstanceStatus
status) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe SpotInstanceStatus
a -> SpotInstanceRequest
s {$sel:status:SpotInstanceRequest' :: Maybe SpotInstanceStatus
status = Maybe SpotInstanceStatus
a} :: SpotInstanceRequest)

-- | Any tags assigned to the resource.
spotInstanceRequest_tags :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe [Tag])
spotInstanceRequest_tags :: Lens' SpotInstanceRequest (Maybe [Tag])
spotInstanceRequest_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe [Tag]
a -> SpotInstanceRequest
s {$sel:tags:SpotInstanceRequest' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: SpotInstanceRequest) 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.
spotInstanceRequest_type :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe SpotInstanceType)
spotInstanceRequest_type :: Lens' SpotInstanceRequest (Maybe SpotInstanceType)
spotInstanceRequest_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe SpotInstanceType
type' :: Maybe SpotInstanceType
$sel:type':SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceType
type'} -> Maybe SpotInstanceType
type') (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe SpotInstanceType
a -> SpotInstanceRequest
s {$sel:type':SpotInstanceRequest' :: Maybe SpotInstanceType
type' = Maybe SpotInstanceType
a} :: SpotInstanceRequest)

-- | The start date of the request, in UTC format (for example,
-- /YYYY/-/MM/-/DD/T/HH/:/MM/:/SS/Z). The request becomes active at this
-- date and time.
spotInstanceRequest_validFrom :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe Prelude.UTCTime)
spotInstanceRequest_validFrom :: Lens' SpotInstanceRequest (Maybe UTCTime)
spotInstanceRequest_validFrom = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe ISO8601
validFrom :: Maybe ISO8601
$sel:validFrom:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
validFrom} -> Maybe ISO8601
validFrom) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe ISO8601
a -> SpotInstanceRequest
s {$sel:validFrom:SpotInstanceRequest' :: Maybe ISO8601
validFrom = Maybe ISO8601
a} :: SpotInstanceRequest) 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.
spotInstanceRequest_validUntil :: Lens.Lens' SpotInstanceRequest (Prelude.Maybe Prelude.UTCTime)
spotInstanceRequest_validUntil :: Lens' SpotInstanceRequest (Maybe UTCTime)
spotInstanceRequest_validUntil = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotInstanceRequest' {Maybe ISO8601
validUntil :: Maybe ISO8601
$sel:validUntil:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
validUntil} -> Maybe ISO8601
validUntil) (\s :: SpotInstanceRequest
s@SpotInstanceRequest' {} Maybe ISO8601
a -> SpotInstanceRequest
s {$sel:validUntil:SpotInstanceRequest' :: Maybe ISO8601
validUntil = Maybe ISO8601
a} :: SpotInstanceRequest) 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 Data.FromXML SpotInstanceRequest where
  parseXML :: [Node] -> Either String SpotInstanceRequest
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe Int
-> Maybe ISO8601
-> Maybe SpotInstanceStateFault
-> Maybe Text
-> Maybe InstanceInterruptionBehavior
-> Maybe Text
-> Maybe LaunchSpecification
-> Maybe Text
-> Maybe RIProductDescription
-> Maybe Text
-> Maybe Text
-> Maybe SpotInstanceState
-> Maybe SpotInstanceStatus
-> Maybe [Tag]
-> Maybe SpotInstanceType
-> Maybe ISO8601
-> Maybe ISO8601
-> SpotInstanceRequest
SpotInstanceRequest'
      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
"actualBlockHourlyPrice")
      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
"availabilityZoneGroup")
      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
"blockDurationMinutes")
      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
"createTime")
      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
"fault")
      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
"instanceId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"instanceInterruptionBehavior")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"launchGroup")
      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
"launchSpecification")
      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
"launchedAvailabilityZone")
      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
"productDescription")
      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
"spotInstanceRequestId")
      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
"state")
      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
"status")
      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
"tagSet"
                      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
"type")
      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
"validFrom")
      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
"validUntil")

instance Prelude.Hashable SpotInstanceRequest where
  hashWithSalt :: Int -> SpotInstanceRequest -> Int
hashWithSalt Int
_salt SpotInstanceRequest' {Maybe Int
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe InstanceInterruptionBehavior
Maybe RIProductDescription
Maybe SpotInstanceState
Maybe SpotInstanceStateFault
Maybe SpotInstanceStatus
Maybe SpotInstanceType
Maybe LaunchSpecification
validUntil :: Maybe ISO8601
validFrom :: Maybe ISO8601
type' :: Maybe SpotInstanceType
tags :: Maybe [Tag]
status :: Maybe SpotInstanceStatus
state :: Maybe SpotInstanceState
spotPrice :: Maybe Text
spotInstanceRequestId :: Maybe Text
productDescription :: Maybe RIProductDescription
launchedAvailabilityZone :: Maybe Text
launchSpecification :: Maybe LaunchSpecification
launchGroup :: Maybe Text
instanceInterruptionBehavior :: Maybe InstanceInterruptionBehavior
instanceId :: Maybe Text
fault :: Maybe SpotInstanceStateFault
createTime :: Maybe ISO8601
blockDurationMinutes :: Maybe Int
availabilityZoneGroup :: Maybe Text
actualBlockHourlyPrice :: Maybe Text
$sel:validUntil:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
$sel:validFrom:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
$sel:type':SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceType
$sel:tags:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe [Tag]
$sel:status:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceStatus
$sel:state:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceState
$sel:spotPrice:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:spotInstanceRequestId:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:productDescription:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe RIProductDescription
$sel:launchedAvailabilityZone:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:launchSpecification:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe LaunchSpecification
$sel:launchGroup:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:instanceInterruptionBehavior:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe InstanceInterruptionBehavior
$sel:instanceId:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:fault:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceStateFault
$sel:createTime:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
$sel:blockDurationMinutes:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Int
$sel:availabilityZoneGroup:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:actualBlockHourlyPrice:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
actualBlockHourlyPrice
      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 ISO8601
createTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotInstanceStateFault
fault
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceId
      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 LaunchSpecification
launchSpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
launchedAvailabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RIProductDescription
productDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spotInstanceRequestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
spotPrice
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotInstanceState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotInstanceStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      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 SpotInstanceRequest where
  rnf :: SpotInstanceRequest -> ()
rnf SpotInstanceRequest' {Maybe Int
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe InstanceInterruptionBehavior
Maybe RIProductDescription
Maybe SpotInstanceState
Maybe SpotInstanceStateFault
Maybe SpotInstanceStatus
Maybe SpotInstanceType
Maybe LaunchSpecification
validUntil :: Maybe ISO8601
validFrom :: Maybe ISO8601
type' :: Maybe SpotInstanceType
tags :: Maybe [Tag]
status :: Maybe SpotInstanceStatus
state :: Maybe SpotInstanceState
spotPrice :: Maybe Text
spotInstanceRequestId :: Maybe Text
productDescription :: Maybe RIProductDescription
launchedAvailabilityZone :: Maybe Text
launchSpecification :: Maybe LaunchSpecification
launchGroup :: Maybe Text
instanceInterruptionBehavior :: Maybe InstanceInterruptionBehavior
instanceId :: Maybe Text
fault :: Maybe SpotInstanceStateFault
createTime :: Maybe ISO8601
blockDurationMinutes :: Maybe Int
availabilityZoneGroup :: Maybe Text
actualBlockHourlyPrice :: Maybe Text
$sel:validUntil:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
$sel:validFrom:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
$sel:type':SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceType
$sel:tags:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe [Tag]
$sel:status:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceStatus
$sel:state:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceState
$sel:spotPrice:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:spotInstanceRequestId:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:productDescription:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe RIProductDescription
$sel:launchedAvailabilityZone:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:launchSpecification:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe LaunchSpecification
$sel:launchGroup:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:instanceInterruptionBehavior:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe InstanceInterruptionBehavior
$sel:instanceId:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:fault:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe SpotInstanceStateFault
$sel:createTime:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe ISO8601
$sel:blockDurationMinutes:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Int
$sel:availabilityZoneGroup:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
$sel:actualBlockHourlyPrice:SpotInstanceRequest' :: SpotInstanceRequest -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
actualBlockHourlyPrice
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 ISO8601
createTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpotInstanceStateFault
fault
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceId
      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 LaunchSpecification
launchSpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
launchedAvailabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RIProductDescription
productDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
spotInstanceRequestId
      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 SpotInstanceState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpotInstanceStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      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