{-# 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.SpotMarketOptions
-- 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.SpotMarketOptions 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:/ 'newSpotMarketOptions' smart constructor.
data SpotMarketOptions = SpotMarketOptions'
  { -- | Deprecated.
    SpotMarketOptions -> Maybe Int
blockDurationMinutes :: Prelude.Maybe Prelude.Int,
    -- | The behavior when a Spot Instance is interrupted. The default is
    -- @terminate@.
    SpotMarketOptions -> Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior :: Prelude.Maybe InstanceInterruptionBehavior,
    -- | The maximum hourly price that you\'re 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 Spot Instances will be interrupted
    -- more frequently than if you do not specify this parameter.
    SpotMarketOptions -> Maybe Text
maxPrice :: Prelude.Maybe Prelude.Text,
    -- | The Spot Instance request type. For
    -- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_RunInstances RunInstances>,
    -- persistent Spot Instance requests are only supported when the instance
    -- interruption behavior is either @hibernate@ or @stop@.
    SpotMarketOptions -> 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.
    SpotMarketOptions -> Maybe ISO8601
validUntil :: Prelude.Maybe Data.ISO8601
  }
  deriving (SpotMarketOptions -> SpotMarketOptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpotMarketOptions -> SpotMarketOptions -> Bool
$c/= :: SpotMarketOptions -> SpotMarketOptions -> Bool
== :: SpotMarketOptions -> SpotMarketOptions -> Bool
$c== :: SpotMarketOptions -> SpotMarketOptions -> Bool
Prelude.Eq, ReadPrec [SpotMarketOptions]
ReadPrec SpotMarketOptions
Int -> ReadS SpotMarketOptions
ReadS [SpotMarketOptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpotMarketOptions]
$creadListPrec :: ReadPrec [SpotMarketOptions]
readPrec :: ReadPrec SpotMarketOptions
$creadPrec :: ReadPrec SpotMarketOptions
readList :: ReadS [SpotMarketOptions]
$creadList :: ReadS [SpotMarketOptions]
readsPrec :: Int -> ReadS SpotMarketOptions
$creadsPrec :: Int -> ReadS SpotMarketOptions
Prelude.Read, Int -> SpotMarketOptions -> ShowS
[SpotMarketOptions] -> ShowS
SpotMarketOptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpotMarketOptions] -> ShowS
$cshowList :: [SpotMarketOptions] -> ShowS
show :: SpotMarketOptions -> String
$cshow :: SpotMarketOptions -> String
showsPrec :: Int -> SpotMarketOptions -> ShowS
$cshowsPrec :: Int -> SpotMarketOptions -> ShowS
Prelude.Show, forall x. Rep SpotMarketOptions x -> SpotMarketOptions
forall x. SpotMarketOptions -> Rep SpotMarketOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpotMarketOptions x -> SpotMarketOptions
$cfrom :: forall x. SpotMarketOptions -> Rep SpotMarketOptions x
Prelude.Generic)

-- |
-- Create a value of 'SpotMarketOptions' 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', 'spotMarketOptions_blockDurationMinutes' - Deprecated.
--
-- 'instanceInterruptionBehavior', 'spotMarketOptions_instanceInterruptionBehavior' - The behavior when a Spot Instance is interrupted. The default is
-- @terminate@.
--
-- 'maxPrice', 'spotMarketOptions_maxPrice' - The maximum hourly price that you\'re 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 Spot Instances will be interrupted
-- more frequently than if you do not specify this parameter.
--
-- 'spotInstanceType', 'spotMarketOptions_spotInstanceType' - The Spot Instance request type. For
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_RunInstances RunInstances>,
-- persistent Spot Instance requests are only supported when the instance
-- interruption behavior is either @hibernate@ or @stop@.
--
-- 'validUntil', 'spotMarketOptions_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.
newSpotMarketOptions ::
  SpotMarketOptions
newSpotMarketOptions :: SpotMarketOptions
newSpotMarketOptions =
  SpotMarketOptions'
    { $sel:blockDurationMinutes:SpotMarketOptions' :: Maybe Int
blockDurationMinutes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:instanceInterruptionBehavior:SpotMarketOptions' :: Maybe InstanceInterruptionBehavior
instanceInterruptionBehavior = forall a. Maybe a
Prelude.Nothing,
      $sel:maxPrice:SpotMarketOptions' :: Maybe Text
maxPrice = forall a. Maybe a
Prelude.Nothing,
      $sel:spotInstanceType:SpotMarketOptions' :: Maybe SpotInstanceType
spotInstanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:validUntil:SpotMarketOptions' :: Maybe ISO8601
validUntil = forall a. Maybe a
Prelude.Nothing
    }

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

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

-- | The maximum hourly price that you\'re 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 Spot Instances will be interrupted
-- more frequently than if you do not specify this parameter.
spotMarketOptions_maxPrice :: Lens.Lens' SpotMarketOptions (Prelude.Maybe Prelude.Text)
spotMarketOptions_maxPrice :: Lens' SpotMarketOptions (Maybe Text)
spotMarketOptions_maxPrice = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotMarketOptions' {Maybe Text
maxPrice :: Maybe Text
$sel:maxPrice:SpotMarketOptions' :: SpotMarketOptions -> Maybe Text
maxPrice} -> Maybe Text
maxPrice) (\s :: SpotMarketOptions
s@SpotMarketOptions' {} Maybe Text
a -> SpotMarketOptions
s {$sel:maxPrice:SpotMarketOptions' :: Maybe Text
maxPrice = Maybe Text
a} :: SpotMarketOptions)

-- | The Spot Instance request type. For
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_RunInstances RunInstances>,
-- persistent Spot Instance requests are only supported when the instance
-- interruption behavior is either @hibernate@ or @stop@.
spotMarketOptions_spotInstanceType :: Lens.Lens' SpotMarketOptions (Prelude.Maybe SpotInstanceType)
spotMarketOptions_spotInstanceType :: Lens' SpotMarketOptions (Maybe SpotInstanceType)
spotMarketOptions_spotInstanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotMarketOptions' {Maybe SpotInstanceType
spotInstanceType :: Maybe SpotInstanceType
$sel:spotInstanceType:SpotMarketOptions' :: SpotMarketOptions -> Maybe SpotInstanceType
spotInstanceType} -> Maybe SpotInstanceType
spotInstanceType) (\s :: SpotMarketOptions
s@SpotMarketOptions' {} Maybe SpotInstanceType
a -> SpotMarketOptions
s {$sel:spotInstanceType:SpotMarketOptions' :: Maybe SpotInstanceType
spotInstanceType = Maybe SpotInstanceType
a} :: SpotMarketOptions)

-- | 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.
spotMarketOptions_validUntil :: Lens.Lens' SpotMarketOptions (Prelude.Maybe Prelude.UTCTime)
spotMarketOptions_validUntil :: Lens' SpotMarketOptions (Maybe UTCTime)
spotMarketOptions_validUntil = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpotMarketOptions' {Maybe ISO8601
validUntil :: Maybe ISO8601
$sel:validUntil:SpotMarketOptions' :: SpotMarketOptions -> Maybe ISO8601
validUntil} -> Maybe ISO8601
validUntil) (\s :: SpotMarketOptions
s@SpotMarketOptions' {} Maybe ISO8601
a -> SpotMarketOptions
s {$sel:validUntil:SpotMarketOptions' :: Maybe ISO8601
validUntil = Maybe ISO8601
a} :: SpotMarketOptions) 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 SpotMarketOptions where
  hashWithSalt :: Int -> SpotMarketOptions -> Int
hashWithSalt Int
_salt SpotMarketOptions' {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:SpotMarketOptions' :: SpotMarketOptions -> Maybe ISO8601
$sel:spotInstanceType:SpotMarketOptions' :: SpotMarketOptions -> Maybe SpotInstanceType
$sel:maxPrice:SpotMarketOptions' :: SpotMarketOptions -> Maybe Text
$sel:instanceInterruptionBehavior:SpotMarketOptions' :: SpotMarketOptions -> Maybe InstanceInterruptionBehavior
$sel:blockDurationMinutes:SpotMarketOptions' :: SpotMarketOptions -> 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 SpotMarketOptions where
  rnf :: SpotMarketOptions -> ()
rnf SpotMarketOptions' {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:SpotMarketOptions' :: SpotMarketOptions -> Maybe ISO8601
$sel:spotInstanceType:SpotMarketOptions' :: SpotMarketOptions -> Maybe SpotInstanceType
$sel:maxPrice:SpotMarketOptions' :: SpotMarketOptions -> Maybe Text
$sel:instanceInterruptionBehavior:SpotMarketOptions' :: SpotMarketOptions -> Maybe InstanceInterruptionBehavior
$sel:blockDurationMinutes:SpotMarketOptions' :: SpotMarketOptions -> 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 SpotMarketOptions where
  toQuery :: SpotMarketOptions -> QueryString
toQuery SpotMarketOptions' {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:SpotMarketOptions' :: SpotMarketOptions -> Maybe ISO8601
$sel:spotInstanceType:SpotMarketOptions' :: SpotMarketOptions -> Maybe SpotInstanceType
$sel:maxPrice:SpotMarketOptions' :: SpotMarketOptions -> Maybe Text
$sel:instanceInterruptionBehavior:SpotMarketOptions' :: SpotMarketOptions -> Maybe InstanceInterruptionBehavior
$sel:blockDurationMinutes:SpotMarketOptions' :: SpotMarketOptions -> 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
      ]