{-# 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.LaunchTemplateSpotMarketOptionsRequest
-- 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.LaunchTemplateSpotMarketOptionsRequest 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.SpotInstanceType
import qualified Amazonka.Prelude as Prelude

-- | The options for Spot Instances.
--
-- /See:/ 'newLaunchTemplateSpotMarketOptionsRequest' smart constructor.
data LaunchTemplateSpotMarketOptionsRequest = LaunchTemplateSpotMarketOptionsRequest'
  { -- | Deprecated.
    LaunchTemplateSpotMarketOptionsRequest -> Maybe Int
blockDurationMinutes :: Prelude.Maybe Prelude.Int,
    -- | The behavior when a Spot Instance is interrupted. The default is
    -- @terminate@.
    LaunchTemplateSpotMarketOptionsRequest
-> Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior :: Prelude.Maybe InstanceInterruptionBehavior,
    -- | The maximum hourly price you\'re willing to pay for the Spot Instances.
    -- We do not recommend using this parameter because it can lead to
    -- increased interruptions. If you do not specify this parameter, you will
    -- pay the current Spot price.
    --
    -- If you specify a maximum price, your Spot Instances will be interrupted
    -- more frequently than if you do not specify this parameter.
    LaunchTemplateSpotMarketOptionsRequest -> Maybe Text
maxPrice :: Prelude.Maybe Prelude.Text,
    -- | The Spot Instance request type.
    LaunchTemplateSpotMarketOptionsRequest -> Maybe SpotInstanceType
spotInstanceType :: Prelude.Maybe SpotInstanceType,
    -- | The end date of the request, in UTC format (/YYYY-MM-DD/T/HH:MM:SS/Z).
    -- Supported only for persistent requests.
    --
    -- -   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, @ValidUntil@ is not supported. The request
    --     remains active until all instances launch or you cancel the request.
    --
    -- Default: 7 days from the current date
    LaunchTemplateSpotMarketOptionsRequest -> Maybe ISO8601
validUntil :: Prelude.Maybe Data.ISO8601
  }
  deriving (LaunchTemplateSpotMarketOptionsRequest
-> LaunchTemplateSpotMarketOptionsRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LaunchTemplateSpotMarketOptionsRequest
-> LaunchTemplateSpotMarketOptionsRequest -> Bool
$c/= :: LaunchTemplateSpotMarketOptionsRequest
-> LaunchTemplateSpotMarketOptionsRequest -> Bool
== :: LaunchTemplateSpotMarketOptionsRequest
-> LaunchTemplateSpotMarketOptionsRequest -> Bool
$c== :: LaunchTemplateSpotMarketOptionsRequest
-> LaunchTemplateSpotMarketOptionsRequest -> Bool
Prelude.Eq, ReadPrec [LaunchTemplateSpotMarketOptionsRequest]
ReadPrec LaunchTemplateSpotMarketOptionsRequest
Int -> ReadS LaunchTemplateSpotMarketOptionsRequest
ReadS [LaunchTemplateSpotMarketOptionsRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LaunchTemplateSpotMarketOptionsRequest]
$creadListPrec :: ReadPrec [LaunchTemplateSpotMarketOptionsRequest]
readPrec :: ReadPrec LaunchTemplateSpotMarketOptionsRequest
$creadPrec :: ReadPrec LaunchTemplateSpotMarketOptionsRequest
readList :: ReadS [LaunchTemplateSpotMarketOptionsRequest]
$creadList :: ReadS [LaunchTemplateSpotMarketOptionsRequest]
readsPrec :: Int -> ReadS LaunchTemplateSpotMarketOptionsRequest
$creadsPrec :: Int -> ReadS LaunchTemplateSpotMarketOptionsRequest
Prelude.Read, Int -> LaunchTemplateSpotMarketOptionsRequest -> ShowS
[LaunchTemplateSpotMarketOptionsRequest] -> ShowS
LaunchTemplateSpotMarketOptionsRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LaunchTemplateSpotMarketOptionsRequest] -> ShowS
$cshowList :: [LaunchTemplateSpotMarketOptionsRequest] -> ShowS
show :: LaunchTemplateSpotMarketOptionsRequest -> String
$cshow :: LaunchTemplateSpotMarketOptionsRequest -> String
showsPrec :: Int -> LaunchTemplateSpotMarketOptionsRequest -> ShowS
$cshowsPrec :: Int -> LaunchTemplateSpotMarketOptionsRequest -> ShowS
Prelude.Show, forall x.
Rep LaunchTemplateSpotMarketOptionsRequest x
-> LaunchTemplateSpotMarketOptionsRequest
forall x.
LaunchTemplateSpotMarketOptionsRequest
-> Rep LaunchTemplateSpotMarketOptionsRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep LaunchTemplateSpotMarketOptionsRequest x
-> LaunchTemplateSpotMarketOptionsRequest
$cfrom :: forall x.
LaunchTemplateSpotMarketOptionsRequest
-> Rep LaunchTemplateSpotMarketOptionsRequest x
Prelude.Generic)

-- |
-- Create a value of 'LaunchTemplateSpotMarketOptionsRequest' 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:
--
-- 'blockDurationMinutes', 'launchTemplateSpotMarketOptionsRequest_blockDurationMinutes' - Deprecated.
--
-- 'instanceInterruptionBehavior', 'launchTemplateSpotMarketOptionsRequest_instanceInterruptionBehavior' - The behavior when a Spot Instance is interrupted. The default is
-- @terminate@.
--
-- 'maxPrice', 'launchTemplateSpotMarketOptionsRequest_maxPrice' - The maximum hourly price you\'re willing to pay for the Spot Instances.
-- We do not recommend using this parameter because it can lead to
-- increased interruptions. If you do not specify this parameter, you will
-- pay the current Spot price.
--
-- If you specify a maximum price, your Spot Instances will be interrupted
-- more frequently than if you do not specify this parameter.
--
-- 'spotInstanceType', 'launchTemplateSpotMarketOptionsRequest_spotInstanceType' - The Spot Instance request type.
--
-- 'validUntil', 'launchTemplateSpotMarketOptionsRequest_validUntil' - The end date of the request, in UTC format (/YYYY-MM-DD/T/HH:MM:SS/Z).
-- Supported only for persistent requests.
--
-- -   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, @ValidUntil@ is not supported. The request
--     remains active until all instances launch or you cancel the request.
--
-- Default: 7 days from the current date
newLaunchTemplateSpotMarketOptionsRequest ::
  LaunchTemplateSpotMarketOptionsRequest
newLaunchTemplateSpotMarketOptionsRequest :: LaunchTemplateSpotMarketOptionsRequest
newLaunchTemplateSpotMarketOptionsRequest =
  LaunchTemplateSpotMarketOptionsRequest'
    { $sel:blockDurationMinutes:LaunchTemplateSpotMarketOptionsRequest' :: Maybe Int
blockDurationMinutes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:instanceInterruptionBehavior:LaunchTemplateSpotMarketOptionsRequest' :: Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxPrice:LaunchTemplateSpotMarketOptionsRequest' :: Maybe Text
maxPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:spotInstanceType:LaunchTemplateSpotMarketOptionsRequest' :: Maybe SpotInstanceType
spotInstanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:validUntil:LaunchTemplateSpotMarketOptionsRequest' :: Maybe ISO8601
validUntil = forall a. Maybe a
Prelude.Nothing
    }

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

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

-- | The maximum hourly price you\'re willing to pay for the Spot Instances.
-- We do not recommend using this parameter because it can lead to
-- increased interruptions. If you do not specify this parameter, you will
-- pay the current Spot price.
--
-- If you specify a maximum price, your Spot Instances will be interrupted
-- more frequently than if you do not specify this parameter.
launchTemplateSpotMarketOptionsRequest_maxPrice :: Lens.Lens' LaunchTemplateSpotMarketOptionsRequest (Prelude.Maybe Prelude.Text)
launchTemplateSpotMarketOptionsRequest_maxPrice :: Lens' LaunchTemplateSpotMarketOptionsRequest (Maybe Text)
launchTemplateSpotMarketOptionsRequest_maxPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LaunchTemplateSpotMarketOptionsRequest' {Maybe Text
maxPrice :: Maybe Text
$sel:maxPrice:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe Text
maxPrice} -> Maybe Text
maxPrice) (\s :: LaunchTemplateSpotMarketOptionsRequest
s@LaunchTemplateSpotMarketOptionsRequest' {} Maybe Text
a -> LaunchTemplateSpotMarketOptionsRequest
s {$sel:maxPrice:LaunchTemplateSpotMarketOptionsRequest' :: Maybe Text
maxPrice = Maybe Text
a} :: LaunchTemplateSpotMarketOptionsRequest)

-- | The Spot Instance request type.
launchTemplateSpotMarketOptionsRequest_spotInstanceType :: Lens.Lens' LaunchTemplateSpotMarketOptionsRequest (Prelude.Maybe SpotInstanceType)
launchTemplateSpotMarketOptionsRequest_spotInstanceType :: Lens'
  LaunchTemplateSpotMarketOptionsRequest (Maybe SpotInstanceType)
launchTemplateSpotMarketOptionsRequest_spotInstanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LaunchTemplateSpotMarketOptionsRequest' {Maybe SpotInstanceType
spotInstanceType :: Maybe SpotInstanceType
$sel:spotInstanceType:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe SpotInstanceType
spotInstanceType} -> Maybe SpotInstanceType
spotInstanceType) (\s :: LaunchTemplateSpotMarketOptionsRequest
s@LaunchTemplateSpotMarketOptionsRequest' {} Maybe SpotInstanceType
a -> LaunchTemplateSpotMarketOptionsRequest
s {$sel:spotInstanceType:LaunchTemplateSpotMarketOptionsRequest' :: Maybe SpotInstanceType
spotInstanceType = Maybe SpotInstanceType
a} :: LaunchTemplateSpotMarketOptionsRequest)

-- | The end date of the request, in UTC format (/YYYY-MM-DD/T/HH:MM:SS/Z).
-- Supported only for persistent requests.
--
-- -   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, @ValidUntil@ is not supported. The request
--     remains active until all instances launch or you cancel the request.
--
-- Default: 7 days from the current date
launchTemplateSpotMarketOptionsRequest_validUntil :: Lens.Lens' LaunchTemplateSpotMarketOptionsRequest (Prelude.Maybe Prelude.UTCTime)
launchTemplateSpotMarketOptionsRequest_validUntil :: Lens' LaunchTemplateSpotMarketOptionsRequest (Maybe UTCTime)
launchTemplateSpotMarketOptionsRequest_validUntil = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LaunchTemplateSpotMarketOptionsRequest' {Maybe ISO8601
validUntil :: Maybe ISO8601
$sel:validUntil:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe ISO8601
validUntil} -> Maybe ISO8601
validUntil) (\s :: LaunchTemplateSpotMarketOptionsRequest
s@LaunchTemplateSpotMarketOptionsRequest' {} Maybe ISO8601
a -> LaunchTemplateSpotMarketOptionsRequest
s {$sel:validUntil:LaunchTemplateSpotMarketOptionsRequest' :: Maybe ISO8601
validUntil = Maybe ISO8601
a} :: LaunchTemplateSpotMarketOptionsRequest) 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
  Prelude.Hashable
    LaunchTemplateSpotMarketOptionsRequest
  where
  hashWithSalt :: Int -> LaunchTemplateSpotMarketOptionsRequest -> Int
hashWithSalt
    Int
_salt
    LaunchTemplateSpotMarketOptionsRequest' {Maybe Int
Maybe Text
Maybe ISO8601
Maybe InstanceInterruptionBehavior
Maybe SpotInstanceType
validUntil :: Maybe ISO8601
spotInstanceType :: Maybe SpotInstanceType
maxPrice :: Maybe Text
instanceInterruptionBehavior :: Maybe InstanceInterruptionBehavior
blockDurationMinutes :: Maybe Int
$sel:validUntil:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe ISO8601
$sel:spotInstanceType:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe SpotInstanceType
$sel:maxPrice:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe Text
$sel:instanceInterruptionBehavior:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest
-> Maybe InstanceInterruptionBehavior
$sel:blockDurationMinutes:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe Int
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
blockDurationMinutes
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxPrice
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SpotInstanceType
spotInstanceType
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
validUntil

instance
  Prelude.NFData
    LaunchTemplateSpotMarketOptionsRequest
  where
  rnf :: LaunchTemplateSpotMarketOptionsRequest -> ()
rnf LaunchTemplateSpotMarketOptionsRequest' {Maybe Int
Maybe Text
Maybe ISO8601
Maybe InstanceInterruptionBehavior
Maybe SpotInstanceType
validUntil :: Maybe ISO8601
spotInstanceType :: Maybe SpotInstanceType
maxPrice :: Maybe Text
instanceInterruptionBehavior :: Maybe InstanceInterruptionBehavior
blockDurationMinutes :: Maybe Int
$sel:validUntil:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe ISO8601
$sel:spotInstanceType:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe SpotInstanceType
$sel:maxPrice:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe Text
$sel:instanceInterruptionBehavior:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest
-> Maybe InstanceInterruptionBehavior
$sel:blockDurationMinutes:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe Int
..} =
    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 InstanceInterruptionBehavior
instanceInterruptionBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
maxPrice
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SpotInstanceType
spotInstanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
validUntil

instance
  Data.ToQuery
    LaunchTemplateSpotMarketOptionsRequest
  where
  toQuery :: LaunchTemplateSpotMarketOptionsRequest -> QueryString
toQuery LaunchTemplateSpotMarketOptionsRequest' {Maybe Int
Maybe Text
Maybe ISO8601
Maybe InstanceInterruptionBehavior
Maybe SpotInstanceType
validUntil :: Maybe ISO8601
spotInstanceType :: Maybe SpotInstanceType
maxPrice :: Maybe Text
instanceInterruptionBehavior :: Maybe InstanceInterruptionBehavior
blockDurationMinutes :: Maybe Int
$sel:validUntil:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe ISO8601
$sel:spotInstanceType:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe SpotInstanceType
$sel:maxPrice:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe Text
$sel:instanceInterruptionBehavior:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest
-> Maybe InstanceInterruptionBehavior
$sel:blockDurationMinutes:LaunchTemplateSpotMarketOptionsRequest' :: LaunchTemplateSpotMarketOptionsRequest -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"BlockDurationMinutes" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
blockDurationMinutes,
        ByteString
"InstanceInterruptionBehavior"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior,
        ByteString
"MaxPrice" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
maxPrice,
        ByteString
"SpotInstanceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SpotInstanceType
spotInstanceType,
        ByteString
"ValidUntil" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
validUntil
      ]