{-# 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.TargetCapacitySpecificationRequest
-- 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.TargetCapacitySpecificationRequest 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.DefaultTargetCapacityType
import Amazonka.EC2.Types.TargetCapacityUnitType
import qualified Amazonka.Prelude as Prelude

-- | The number of units to request. You can choose to set the target
-- capacity as the number of instances. Or you can set the target capacity
-- to a performance characteristic that is important to your application
-- workload, such as vCPUs, memory, or I\/O. If the request type is
-- @maintain@, you can specify a target capacity of 0 and add capacity
-- later.
--
-- You can use the On-Demand Instance @MaxTotalPrice@ parameter, the Spot
-- Instance @MaxTotalPrice@ parameter, or both parameters to ensure that
-- your fleet cost does not exceed your budget. If you set a maximum price
-- per hour for the On-Demand Instances and Spot Instances in your request,
-- EC2 Fleet will launch instances until it reaches the maximum amount that
-- you\'re willing to pay. When the maximum amount you\'re willing to pay
-- is reached, the fleet stops launching instances even if it hasn’t met
-- the target capacity. The @MaxTotalPrice@ parameters are located in
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_OnDemandOptionsRequest OnDemandOptionsRequest>
-- and
-- <https://docs.aws.amazon.com/AWSEC2/latest/APIReference/API_SpotOptionsRequest SpotOptionsRequest>.
--
-- /See:/ 'newTargetCapacitySpecificationRequest' smart constructor.
data TargetCapacitySpecificationRequest = TargetCapacitySpecificationRequest'
  { -- | The default @TotalTargetCapacity@, which is either @Spot@ or
    -- @On-Demand@.
    TargetCapacitySpecificationRequest
-> Maybe DefaultTargetCapacityType
defaultTargetCapacityType :: Prelude.Maybe DefaultTargetCapacityType,
    -- | The number of On-Demand units to request.
    TargetCapacitySpecificationRequest -> Maybe Int
onDemandTargetCapacity :: Prelude.Maybe Prelude.Int,
    -- | The number of Spot units to request.
    TargetCapacitySpecificationRequest -> Maybe Int
spotTargetCapacity :: Prelude.Maybe Prelude.Int,
    -- | The unit for the target capacity.
    --
    -- Default: @units@ (translates to number of instances)
    TargetCapacitySpecificationRequest -> Maybe TargetCapacityUnitType
targetCapacityUnitType :: Prelude.Maybe TargetCapacityUnitType,
    -- | The number of units to request, filled using
    -- @DefaultTargetCapacityType@.
    TargetCapacitySpecificationRequest -> Int
totalTargetCapacity :: Prelude.Int
  }
  deriving (TargetCapacitySpecificationRequest
-> TargetCapacitySpecificationRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetCapacitySpecificationRequest
-> TargetCapacitySpecificationRequest -> Bool
$c/= :: TargetCapacitySpecificationRequest
-> TargetCapacitySpecificationRequest -> Bool
== :: TargetCapacitySpecificationRequest
-> TargetCapacitySpecificationRequest -> Bool
$c== :: TargetCapacitySpecificationRequest
-> TargetCapacitySpecificationRequest -> Bool
Prelude.Eq, ReadPrec [TargetCapacitySpecificationRequest]
ReadPrec TargetCapacitySpecificationRequest
Int -> ReadS TargetCapacitySpecificationRequest
ReadS [TargetCapacitySpecificationRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TargetCapacitySpecificationRequest]
$creadListPrec :: ReadPrec [TargetCapacitySpecificationRequest]
readPrec :: ReadPrec TargetCapacitySpecificationRequest
$creadPrec :: ReadPrec TargetCapacitySpecificationRequest
readList :: ReadS [TargetCapacitySpecificationRequest]
$creadList :: ReadS [TargetCapacitySpecificationRequest]
readsPrec :: Int -> ReadS TargetCapacitySpecificationRequest
$creadsPrec :: Int -> ReadS TargetCapacitySpecificationRequest
Prelude.Read, Int -> TargetCapacitySpecificationRequest -> ShowS
[TargetCapacitySpecificationRequest] -> ShowS
TargetCapacitySpecificationRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetCapacitySpecificationRequest] -> ShowS
$cshowList :: [TargetCapacitySpecificationRequest] -> ShowS
show :: TargetCapacitySpecificationRequest -> String
$cshow :: TargetCapacitySpecificationRequest -> String
showsPrec :: Int -> TargetCapacitySpecificationRequest -> ShowS
$cshowsPrec :: Int -> TargetCapacitySpecificationRequest -> ShowS
Prelude.Show, forall x.
Rep TargetCapacitySpecificationRequest x
-> TargetCapacitySpecificationRequest
forall x.
TargetCapacitySpecificationRequest
-> Rep TargetCapacitySpecificationRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep TargetCapacitySpecificationRequest x
-> TargetCapacitySpecificationRequest
$cfrom :: forall x.
TargetCapacitySpecificationRequest
-> Rep TargetCapacitySpecificationRequest x
Prelude.Generic)

-- |
-- Create a value of 'TargetCapacitySpecificationRequest' 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:
--
-- 'defaultTargetCapacityType', 'targetCapacitySpecificationRequest_defaultTargetCapacityType' - The default @TotalTargetCapacity@, which is either @Spot@ or
-- @On-Demand@.
--
-- 'onDemandTargetCapacity', 'targetCapacitySpecificationRequest_onDemandTargetCapacity' - The number of On-Demand units to request.
--
-- 'spotTargetCapacity', 'targetCapacitySpecificationRequest_spotTargetCapacity' - The number of Spot units to request.
--
-- 'targetCapacityUnitType', 'targetCapacitySpecificationRequest_targetCapacityUnitType' - The unit for the target capacity.
--
-- Default: @units@ (translates to number of instances)
--
-- 'totalTargetCapacity', 'targetCapacitySpecificationRequest_totalTargetCapacity' - The number of units to request, filled using
-- @DefaultTargetCapacityType@.
newTargetCapacitySpecificationRequest ::
  -- | 'totalTargetCapacity'
  Prelude.Int ->
  TargetCapacitySpecificationRequest
newTargetCapacitySpecificationRequest :: Int -> TargetCapacitySpecificationRequest
newTargetCapacitySpecificationRequest
  Int
pTotalTargetCapacity_ =
    TargetCapacitySpecificationRequest'
      { $sel:defaultTargetCapacityType:TargetCapacitySpecificationRequest' :: Maybe DefaultTargetCapacityType
defaultTargetCapacityType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:onDemandTargetCapacity:TargetCapacitySpecificationRequest' :: Maybe Int
onDemandTargetCapacity =
          forall a. Maybe a
Prelude.Nothing,
        $sel:spotTargetCapacity:TargetCapacitySpecificationRequest' :: Maybe Int
spotTargetCapacity = forall a. Maybe a
Prelude.Nothing,
        $sel:targetCapacityUnitType:TargetCapacitySpecificationRequest' :: Maybe TargetCapacityUnitType
targetCapacityUnitType =
          forall a. Maybe a
Prelude.Nothing,
        $sel:totalTargetCapacity:TargetCapacitySpecificationRequest' :: Int
totalTargetCapacity =
          Int
pTotalTargetCapacity_
      }

-- | The default @TotalTargetCapacity@, which is either @Spot@ or
-- @On-Demand@.
targetCapacitySpecificationRequest_defaultTargetCapacityType :: Lens.Lens' TargetCapacitySpecificationRequest (Prelude.Maybe DefaultTargetCapacityType)
targetCapacitySpecificationRequest_defaultTargetCapacityType :: Lens'
  TargetCapacitySpecificationRequest
  (Maybe DefaultTargetCapacityType)
targetCapacitySpecificationRequest_defaultTargetCapacityType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetCapacitySpecificationRequest' {Maybe DefaultTargetCapacityType
defaultTargetCapacityType :: Maybe DefaultTargetCapacityType
$sel:defaultTargetCapacityType:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest
-> Maybe DefaultTargetCapacityType
defaultTargetCapacityType} -> Maybe DefaultTargetCapacityType
defaultTargetCapacityType) (\s :: TargetCapacitySpecificationRequest
s@TargetCapacitySpecificationRequest' {} Maybe DefaultTargetCapacityType
a -> TargetCapacitySpecificationRequest
s {$sel:defaultTargetCapacityType:TargetCapacitySpecificationRequest' :: Maybe DefaultTargetCapacityType
defaultTargetCapacityType = Maybe DefaultTargetCapacityType
a} :: TargetCapacitySpecificationRequest)

-- | The number of On-Demand units to request.
targetCapacitySpecificationRequest_onDemandTargetCapacity :: Lens.Lens' TargetCapacitySpecificationRequest (Prelude.Maybe Prelude.Int)
targetCapacitySpecificationRequest_onDemandTargetCapacity :: Lens' TargetCapacitySpecificationRequest (Maybe Int)
targetCapacitySpecificationRequest_onDemandTargetCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetCapacitySpecificationRequest' {Maybe Int
onDemandTargetCapacity :: Maybe Int
$sel:onDemandTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe Int
onDemandTargetCapacity} -> Maybe Int
onDemandTargetCapacity) (\s :: TargetCapacitySpecificationRequest
s@TargetCapacitySpecificationRequest' {} Maybe Int
a -> TargetCapacitySpecificationRequest
s {$sel:onDemandTargetCapacity:TargetCapacitySpecificationRequest' :: Maybe Int
onDemandTargetCapacity = Maybe Int
a} :: TargetCapacitySpecificationRequest)

-- | The number of Spot units to request.
targetCapacitySpecificationRequest_spotTargetCapacity :: Lens.Lens' TargetCapacitySpecificationRequest (Prelude.Maybe Prelude.Int)
targetCapacitySpecificationRequest_spotTargetCapacity :: Lens' TargetCapacitySpecificationRequest (Maybe Int)
targetCapacitySpecificationRequest_spotTargetCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetCapacitySpecificationRequest' {Maybe Int
spotTargetCapacity :: Maybe Int
$sel:spotTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe Int
spotTargetCapacity} -> Maybe Int
spotTargetCapacity) (\s :: TargetCapacitySpecificationRequest
s@TargetCapacitySpecificationRequest' {} Maybe Int
a -> TargetCapacitySpecificationRequest
s {$sel:spotTargetCapacity:TargetCapacitySpecificationRequest' :: Maybe Int
spotTargetCapacity = Maybe Int
a} :: TargetCapacitySpecificationRequest)

-- | The unit for the target capacity.
--
-- Default: @units@ (translates to number of instances)
targetCapacitySpecificationRequest_targetCapacityUnitType :: Lens.Lens' TargetCapacitySpecificationRequest (Prelude.Maybe TargetCapacityUnitType)
targetCapacitySpecificationRequest_targetCapacityUnitType :: Lens'
  TargetCapacitySpecificationRequest (Maybe TargetCapacityUnitType)
targetCapacitySpecificationRequest_targetCapacityUnitType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetCapacitySpecificationRequest' {Maybe TargetCapacityUnitType
targetCapacityUnitType :: Maybe TargetCapacityUnitType
$sel:targetCapacityUnitType:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe TargetCapacityUnitType
targetCapacityUnitType} -> Maybe TargetCapacityUnitType
targetCapacityUnitType) (\s :: TargetCapacitySpecificationRequest
s@TargetCapacitySpecificationRequest' {} Maybe TargetCapacityUnitType
a -> TargetCapacitySpecificationRequest
s {$sel:targetCapacityUnitType:TargetCapacitySpecificationRequest' :: Maybe TargetCapacityUnitType
targetCapacityUnitType = Maybe TargetCapacityUnitType
a} :: TargetCapacitySpecificationRequest)

-- | The number of units to request, filled using
-- @DefaultTargetCapacityType@.
targetCapacitySpecificationRequest_totalTargetCapacity :: Lens.Lens' TargetCapacitySpecificationRequest Prelude.Int
targetCapacitySpecificationRequest_totalTargetCapacity :: Lens' TargetCapacitySpecificationRequest Int
targetCapacitySpecificationRequest_totalTargetCapacity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetCapacitySpecificationRequest' {Int
totalTargetCapacity :: Int
$sel:totalTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Int
totalTargetCapacity} -> Int
totalTargetCapacity) (\s :: TargetCapacitySpecificationRequest
s@TargetCapacitySpecificationRequest' {} Int
a -> TargetCapacitySpecificationRequest
s {$sel:totalTargetCapacity:TargetCapacitySpecificationRequest' :: Int
totalTargetCapacity = Int
a} :: TargetCapacitySpecificationRequest)

instance
  Prelude.Hashable
    TargetCapacitySpecificationRequest
  where
  hashWithSalt :: Int -> TargetCapacitySpecificationRequest -> Int
hashWithSalt
    Int
_salt
    TargetCapacitySpecificationRequest' {Int
Maybe Int
Maybe DefaultTargetCapacityType
Maybe TargetCapacityUnitType
totalTargetCapacity :: Int
targetCapacityUnitType :: Maybe TargetCapacityUnitType
spotTargetCapacity :: Maybe Int
onDemandTargetCapacity :: Maybe Int
defaultTargetCapacityType :: Maybe DefaultTargetCapacityType
$sel:totalTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Int
$sel:targetCapacityUnitType:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe TargetCapacityUnitType
$sel:spotTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe Int
$sel:onDemandTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe Int
$sel:defaultTargetCapacityType:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest
-> Maybe DefaultTargetCapacityType
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DefaultTargetCapacityType
defaultTargetCapacityType
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
onDemandTargetCapacity
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
spotTargetCapacity
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetCapacityUnitType
targetCapacityUnitType
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
totalTargetCapacity

instance
  Prelude.NFData
    TargetCapacitySpecificationRequest
  where
  rnf :: TargetCapacitySpecificationRequest -> ()
rnf TargetCapacitySpecificationRequest' {Int
Maybe Int
Maybe DefaultTargetCapacityType
Maybe TargetCapacityUnitType
totalTargetCapacity :: Int
targetCapacityUnitType :: Maybe TargetCapacityUnitType
spotTargetCapacity :: Maybe Int
onDemandTargetCapacity :: Maybe Int
defaultTargetCapacityType :: Maybe DefaultTargetCapacityType
$sel:totalTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Int
$sel:targetCapacityUnitType:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe TargetCapacityUnitType
$sel:spotTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe Int
$sel:onDemandTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe Int
$sel:defaultTargetCapacityType:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest
-> Maybe DefaultTargetCapacityType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DefaultTargetCapacityType
defaultTargetCapacityType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
onDemandTargetCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
spotTargetCapacity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetCapacityUnitType
targetCapacityUnitType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
totalTargetCapacity

instance
  Data.ToQuery
    TargetCapacitySpecificationRequest
  where
  toQuery :: TargetCapacitySpecificationRequest -> QueryString
toQuery TargetCapacitySpecificationRequest' {Int
Maybe Int
Maybe DefaultTargetCapacityType
Maybe TargetCapacityUnitType
totalTargetCapacity :: Int
targetCapacityUnitType :: Maybe TargetCapacityUnitType
spotTargetCapacity :: Maybe Int
onDemandTargetCapacity :: Maybe Int
defaultTargetCapacityType :: Maybe DefaultTargetCapacityType
$sel:totalTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Int
$sel:targetCapacityUnitType:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe TargetCapacityUnitType
$sel:spotTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe Int
$sel:onDemandTargetCapacity:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest -> Maybe Int
$sel:defaultTargetCapacityType:TargetCapacitySpecificationRequest' :: TargetCapacitySpecificationRequest
-> Maybe DefaultTargetCapacityType
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"DefaultTargetCapacityType"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DefaultTargetCapacityType
defaultTargetCapacityType,
        ByteString
"OnDemandTargetCapacity"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
onDemandTargetCapacity,
        ByteString
"SpotTargetCapacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
spotTargetCapacity,
        ByteString
"TargetCapacityUnitType"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TargetCapacityUnitType
targetCapacityUnitType,
        ByteString
"TotalTargetCapacity" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Int
totalTargetCapacity
      ]