{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.EC2.ModifyFleet
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the specified EC2 Fleet.
--
-- You can only modify an EC2 Fleet request of type @maintain@.
--
-- While the EC2 Fleet is being modified, it is in the @modifying@ state.
--
-- To scale up your EC2 Fleet, increase its target capacity. The EC2 Fleet
-- launches the additional Spot Instances according to the allocation
-- strategy for the EC2 Fleet request. If the allocation strategy is
-- @lowest-price@, the EC2 Fleet launches instances using the Spot Instance
-- pool with the lowest price. If the allocation strategy is @diversified@,
-- the EC2 Fleet distributes the instances across the Spot Instance pools.
-- If the allocation strategy is @capacity-optimized@, EC2 Fleet launches
-- instances from Spot Instance pools with optimal capacity for the number
-- of instances that are launching.
--
-- To scale down your EC2 Fleet, decrease its target capacity. First, the
-- EC2 Fleet cancels any open requests that exceed the new target capacity.
-- You can request that the EC2 Fleet terminate Spot Instances until the
-- size of the fleet no longer exceeds the new target capacity. If the
-- allocation strategy is @lowest-price@, the EC2 Fleet terminates the
-- instances with the highest price per unit. If the allocation strategy is
-- @capacity-optimized@, the EC2 Fleet terminates the instances in the Spot
-- Instance pools that have the least available Spot Instance capacity. If
-- the allocation strategy is @diversified@, the EC2 Fleet terminates
-- instances across the Spot Instance pools. Alternatively, you can request
-- that the EC2 Fleet keep the fleet at its current size, but not replace
-- any Spot Instances that are interrupted or that you terminate manually.
--
-- If you are finished with your EC2 Fleet for now, but will use it again
-- later, you can set the target capacity to 0.
module Amazonka.EC2.ModifyFleet
  ( -- * Creating a Request
    ModifyFleet (..),
    newModifyFleet,

    -- * Request Lenses
    modifyFleet_context,
    modifyFleet_dryRun,
    modifyFleet_excessCapacityTerminationPolicy,
    modifyFleet_launchTemplateConfigs,
    modifyFleet_targetCapacitySpecification,
    modifyFleet_fleetId,

    -- * Destructuring the Response
    ModifyFleetResponse (..),
    newModifyFleetResponse,

    -- * Response Lenses
    modifyFleetResponse_return,
    modifyFleetResponse_httpStatus,
  )
where

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

-- | /See:/ 'newModifyFleet' smart constructor.
data ModifyFleet = ModifyFleet'
  { -- | Reserved.
    ModifyFleet -> Maybe Text
context :: Prelude.Maybe Prelude.Text,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ModifyFleet -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | Indicates whether running instances should be terminated if the total
    -- target capacity of the EC2 Fleet is decreased below the current size of
    -- the EC2 Fleet.
    ModifyFleet -> Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy :: Prelude.Maybe FleetExcessCapacityTerminationPolicy,
    -- | The launch template and overrides.
    ModifyFleet -> Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs :: Prelude.Maybe [FleetLaunchTemplateConfigRequest],
    -- | The size of the EC2 Fleet.
    ModifyFleet -> Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification :: Prelude.Maybe TargetCapacitySpecificationRequest,
    -- | The ID of the EC2 Fleet.
    ModifyFleet -> Text
fleetId :: Prelude.Text
  }
  deriving (ModifyFleet -> ModifyFleet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyFleet -> ModifyFleet -> Bool
$c/= :: ModifyFleet -> ModifyFleet -> Bool
== :: ModifyFleet -> ModifyFleet -> Bool
$c== :: ModifyFleet -> ModifyFleet -> Bool
Prelude.Eq, ReadPrec [ModifyFleet]
ReadPrec ModifyFleet
Int -> ReadS ModifyFleet
ReadS [ModifyFleet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyFleet]
$creadListPrec :: ReadPrec [ModifyFleet]
readPrec :: ReadPrec ModifyFleet
$creadPrec :: ReadPrec ModifyFleet
readList :: ReadS [ModifyFleet]
$creadList :: ReadS [ModifyFleet]
readsPrec :: Int -> ReadS ModifyFleet
$creadsPrec :: Int -> ReadS ModifyFleet
Prelude.Read, Int -> ModifyFleet -> ShowS
[ModifyFleet] -> ShowS
ModifyFleet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyFleet] -> ShowS
$cshowList :: [ModifyFleet] -> ShowS
show :: ModifyFleet -> String
$cshow :: ModifyFleet -> String
showsPrec :: Int -> ModifyFleet -> ShowS
$cshowsPrec :: Int -> ModifyFleet -> ShowS
Prelude.Show, forall x. Rep ModifyFleet x -> ModifyFleet
forall x. ModifyFleet -> Rep ModifyFleet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyFleet x -> ModifyFleet
$cfrom :: forall x. ModifyFleet -> Rep ModifyFleet x
Prelude.Generic)

-- |
-- Create a value of 'ModifyFleet' 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:
--
-- 'context', 'modifyFleet_context' - Reserved.
--
-- 'dryRun', 'modifyFleet_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'excessCapacityTerminationPolicy', 'modifyFleet_excessCapacityTerminationPolicy' - Indicates whether running instances should be terminated if the total
-- target capacity of the EC2 Fleet is decreased below the current size of
-- the EC2 Fleet.
--
-- 'launchTemplateConfigs', 'modifyFleet_launchTemplateConfigs' - The launch template and overrides.
--
-- 'targetCapacitySpecification', 'modifyFleet_targetCapacitySpecification' - The size of the EC2 Fleet.
--
-- 'fleetId', 'modifyFleet_fleetId' - The ID of the EC2 Fleet.
newModifyFleet ::
  -- | 'fleetId'
  Prelude.Text ->
  ModifyFleet
newModifyFleet :: Text -> ModifyFleet
newModifyFleet Text
pFleetId_ =
  ModifyFleet'
    { $sel:context:ModifyFleet' :: Maybe Text
context = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifyFleet' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:excessCapacityTerminationPolicy:ModifyFleet' :: Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy = forall a. Maybe a
Prelude.Nothing,
      $sel:launchTemplateConfigs:ModifyFleet' :: Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs = forall a. Maybe a
Prelude.Nothing,
      $sel:targetCapacitySpecification:ModifyFleet' :: Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification = forall a. Maybe a
Prelude.Nothing,
      $sel:fleetId:ModifyFleet' :: Text
fleetId = Text
pFleetId_
    }

-- | Reserved.
modifyFleet_context :: Lens.Lens' ModifyFleet (Prelude.Maybe Prelude.Text)
modifyFleet_context :: Lens' ModifyFleet (Maybe Text)
modifyFleet_context = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyFleet' {Maybe Text
context :: Maybe Text
$sel:context:ModifyFleet' :: ModifyFleet -> Maybe Text
context} -> Maybe Text
context) (\s :: ModifyFleet
s@ModifyFleet' {} Maybe Text
a -> ModifyFleet
s {$sel:context:ModifyFleet' :: Maybe Text
context = Maybe Text
a} :: ModifyFleet)

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

-- | Indicates whether running instances should be terminated if the total
-- target capacity of the EC2 Fleet is decreased below the current size of
-- the EC2 Fleet.
modifyFleet_excessCapacityTerminationPolicy :: Lens.Lens' ModifyFleet (Prelude.Maybe FleetExcessCapacityTerminationPolicy)
modifyFleet_excessCapacityTerminationPolicy :: Lens' ModifyFleet (Maybe FleetExcessCapacityTerminationPolicy)
modifyFleet_excessCapacityTerminationPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyFleet' {Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy :: Maybe FleetExcessCapacityTerminationPolicy
$sel:excessCapacityTerminationPolicy:ModifyFleet' :: ModifyFleet -> Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy} -> Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy) (\s :: ModifyFleet
s@ModifyFleet' {} Maybe FleetExcessCapacityTerminationPolicy
a -> ModifyFleet
s {$sel:excessCapacityTerminationPolicy:ModifyFleet' :: Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy = Maybe FleetExcessCapacityTerminationPolicy
a} :: ModifyFleet)

-- | The launch template and overrides.
modifyFleet_launchTemplateConfigs :: Lens.Lens' ModifyFleet (Prelude.Maybe [FleetLaunchTemplateConfigRequest])
modifyFleet_launchTemplateConfigs :: Lens' ModifyFleet (Maybe [FleetLaunchTemplateConfigRequest])
modifyFleet_launchTemplateConfigs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyFleet' {Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs :: Maybe [FleetLaunchTemplateConfigRequest]
$sel:launchTemplateConfigs:ModifyFleet' :: ModifyFleet -> Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs} -> Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs) (\s :: ModifyFleet
s@ModifyFleet' {} Maybe [FleetLaunchTemplateConfigRequest]
a -> ModifyFleet
s {$sel:launchTemplateConfigs:ModifyFleet' :: Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs = Maybe [FleetLaunchTemplateConfigRequest]
a} :: ModifyFleet) 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 size of the EC2 Fleet.
modifyFleet_targetCapacitySpecification :: Lens.Lens' ModifyFleet (Prelude.Maybe TargetCapacitySpecificationRequest)
modifyFleet_targetCapacitySpecification :: Lens' ModifyFleet (Maybe TargetCapacitySpecificationRequest)
modifyFleet_targetCapacitySpecification = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyFleet' {Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification :: Maybe TargetCapacitySpecificationRequest
$sel:targetCapacitySpecification:ModifyFleet' :: ModifyFleet -> Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification} -> Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification) (\s :: ModifyFleet
s@ModifyFleet' {} Maybe TargetCapacitySpecificationRequest
a -> ModifyFleet
s {$sel:targetCapacitySpecification:ModifyFleet' :: Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification = Maybe TargetCapacitySpecificationRequest
a} :: ModifyFleet)

-- | The ID of the EC2 Fleet.
modifyFleet_fleetId :: Lens.Lens' ModifyFleet Prelude.Text
modifyFleet_fleetId :: Lens' ModifyFleet Text
modifyFleet_fleetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyFleet' {Text
fleetId :: Text
$sel:fleetId:ModifyFleet' :: ModifyFleet -> Text
fleetId} -> Text
fleetId) (\s :: ModifyFleet
s@ModifyFleet' {} Text
a -> ModifyFleet
s {$sel:fleetId:ModifyFleet' :: Text
fleetId = Text
a} :: ModifyFleet)

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

instance Prelude.Hashable ModifyFleet where
  hashWithSalt :: Int -> ModifyFleet -> Int
hashWithSalt Int
_salt ModifyFleet' {Maybe Bool
Maybe [FleetLaunchTemplateConfigRequest]
Maybe Text
Maybe FleetExcessCapacityTerminationPolicy
Maybe TargetCapacitySpecificationRequest
Text
fleetId :: Text
targetCapacitySpecification :: Maybe TargetCapacitySpecificationRequest
launchTemplateConfigs :: Maybe [FleetLaunchTemplateConfigRequest]
excessCapacityTerminationPolicy :: Maybe FleetExcessCapacityTerminationPolicy
dryRun :: Maybe Bool
context :: Maybe Text
$sel:fleetId:ModifyFleet' :: ModifyFleet -> Text
$sel:targetCapacitySpecification:ModifyFleet' :: ModifyFleet -> Maybe TargetCapacitySpecificationRequest
$sel:launchTemplateConfigs:ModifyFleet' :: ModifyFleet -> Maybe [FleetLaunchTemplateConfigRequest]
$sel:excessCapacityTerminationPolicy:ModifyFleet' :: ModifyFleet -> Maybe FleetExcessCapacityTerminationPolicy
$sel:dryRun:ModifyFleet' :: ModifyFleet -> Maybe Bool
$sel:context:ModifyFleet' :: ModifyFleet -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
context
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fleetId

instance Prelude.NFData ModifyFleet where
  rnf :: ModifyFleet -> ()
rnf ModifyFleet' {Maybe Bool
Maybe [FleetLaunchTemplateConfigRequest]
Maybe Text
Maybe FleetExcessCapacityTerminationPolicy
Maybe TargetCapacitySpecificationRequest
Text
fleetId :: Text
targetCapacitySpecification :: Maybe TargetCapacitySpecificationRequest
launchTemplateConfigs :: Maybe [FleetLaunchTemplateConfigRequest]
excessCapacityTerminationPolicy :: Maybe FleetExcessCapacityTerminationPolicy
dryRun :: Maybe Bool
context :: Maybe Text
$sel:fleetId:ModifyFleet' :: ModifyFleet -> Text
$sel:targetCapacitySpecification:ModifyFleet' :: ModifyFleet -> Maybe TargetCapacitySpecificationRequest
$sel:launchTemplateConfigs:ModifyFleet' :: ModifyFleet -> Maybe [FleetLaunchTemplateConfigRequest]
$sel:excessCapacityTerminationPolicy:ModifyFleet' :: ModifyFleet -> Maybe FleetExcessCapacityTerminationPolicy
$sel:dryRun:ModifyFleet' :: ModifyFleet -> Maybe Bool
$sel:context:ModifyFleet' :: ModifyFleet -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
context
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fleetId

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

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

instance Data.ToQuery ModifyFleet where
  toQuery :: ModifyFleet -> QueryString
toQuery ModifyFleet' {Maybe Bool
Maybe [FleetLaunchTemplateConfigRequest]
Maybe Text
Maybe FleetExcessCapacityTerminationPolicy
Maybe TargetCapacitySpecificationRequest
Text
fleetId :: Text
targetCapacitySpecification :: Maybe TargetCapacitySpecificationRequest
launchTemplateConfigs :: Maybe [FleetLaunchTemplateConfigRequest]
excessCapacityTerminationPolicy :: Maybe FleetExcessCapacityTerminationPolicy
dryRun :: Maybe Bool
context :: Maybe Text
$sel:fleetId:ModifyFleet' :: ModifyFleet -> Text
$sel:targetCapacitySpecification:ModifyFleet' :: ModifyFleet -> Maybe TargetCapacitySpecificationRequest
$sel:launchTemplateConfigs:ModifyFleet' :: ModifyFleet -> Maybe [FleetLaunchTemplateConfigRequest]
$sel:excessCapacityTerminationPolicy:ModifyFleet' :: ModifyFleet -> Maybe FleetExcessCapacityTerminationPolicy
$sel:dryRun:ModifyFleet' :: ModifyFleet -> Maybe Bool
$sel:context:ModifyFleet' :: ModifyFleet -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyFleet" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Context" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
context,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"ExcessCapacityTerminationPolicy"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe FleetExcessCapacityTerminationPolicy
excessCapacityTerminationPolicy,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"LaunchTemplateConfig"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [FleetLaunchTemplateConfigRequest]
launchTemplateConfigs
          ),
        ByteString
"TargetCapacitySpecification"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TargetCapacitySpecificationRequest
targetCapacitySpecification,
        ByteString
"FleetId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
fleetId
      ]

-- | /See:/ 'newModifyFleetResponse' smart constructor.
data ModifyFleetResponse = ModifyFleetResponse'
  { -- | If the request succeeds, the response returns @true@. If the request
    -- fails, no response is returned, and instead an error message is
    -- returned.
    ModifyFleetResponse -> Maybe Bool
return' :: Prelude.Maybe Prelude.Bool,
    -- | The response's http status code.
    ModifyFleetResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifyFleetResponse -> ModifyFleetResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyFleetResponse -> ModifyFleetResponse -> Bool
$c/= :: ModifyFleetResponse -> ModifyFleetResponse -> Bool
== :: ModifyFleetResponse -> ModifyFleetResponse -> Bool
$c== :: ModifyFleetResponse -> ModifyFleetResponse -> Bool
Prelude.Eq, ReadPrec [ModifyFleetResponse]
ReadPrec ModifyFleetResponse
Int -> ReadS ModifyFleetResponse
ReadS [ModifyFleetResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyFleetResponse]
$creadListPrec :: ReadPrec [ModifyFleetResponse]
readPrec :: ReadPrec ModifyFleetResponse
$creadPrec :: ReadPrec ModifyFleetResponse
readList :: ReadS [ModifyFleetResponse]
$creadList :: ReadS [ModifyFleetResponse]
readsPrec :: Int -> ReadS ModifyFleetResponse
$creadsPrec :: Int -> ReadS ModifyFleetResponse
Prelude.Read, Int -> ModifyFleetResponse -> ShowS
[ModifyFleetResponse] -> ShowS
ModifyFleetResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyFleetResponse] -> ShowS
$cshowList :: [ModifyFleetResponse] -> ShowS
show :: ModifyFleetResponse -> String
$cshow :: ModifyFleetResponse -> String
showsPrec :: Int -> ModifyFleetResponse -> ShowS
$cshowsPrec :: Int -> ModifyFleetResponse -> ShowS
Prelude.Show, forall x. Rep ModifyFleetResponse x -> ModifyFleetResponse
forall x. ModifyFleetResponse -> Rep ModifyFleetResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifyFleetResponse x -> ModifyFleetResponse
$cfrom :: forall x. ModifyFleetResponse -> Rep ModifyFleetResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifyFleetResponse' 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:
--
-- 'return'', 'modifyFleetResponse_return' - If the request succeeds, the response returns @true@. If the request
-- fails, no response is returned, and instead an error message is
-- returned.
--
-- 'httpStatus', 'modifyFleetResponse_httpStatus' - The response's http status code.
newModifyFleetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyFleetResponse
newModifyFleetResponse :: Int -> ModifyFleetResponse
newModifyFleetResponse Int
pHttpStatus_ =
  ModifyFleetResponse'
    { $sel:return':ModifyFleetResponse' :: Maybe Bool
return' = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyFleetResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the request succeeds, the response returns @true@. If the request
-- fails, no response is returned, and instead an error message is
-- returned.
modifyFleetResponse_return :: Lens.Lens' ModifyFleetResponse (Prelude.Maybe Prelude.Bool)
modifyFleetResponse_return :: Lens' ModifyFleetResponse (Maybe Bool)
modifyFleetResponse_return = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyFleetResponse' {Maybe Bool
return' :: Maybe Bool
$sel:return':ModifyFleetResponse' :: ModifyFleetResponse -> Maybe Bool
return'} -> Maybe Bool
return') (\s :: ModifyFleetResponse
s@ModifyFleetResponse' {} Maybe Bool
a -> ModifyFleetResponse
s {$sel:return':ModifyFleetResponse' :: Maybe Bool
return' = Maybe Bool
a} :: ModifyFleetResponse)

-- | The response's http status code.
modifyFleetResponse_httpStatus :: Lens.Lens' ModifyFleetResponse Prelude.Int
modifyFleetResponse_httpStatus :: Lens' ModifyFleetResponse Int
modifyFleetResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyFleetResponse' {Int
httpStatus :: Int
$sel:httpStatus:ModifyFleetResponse' :: ModifyFleetResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ModifyFleetResponse
s@ModifyFleetResponse' {} Int
a -> ModifyFleetResponse
s {$sel:httpStatus:ModifyFleetResponse' :: Int
httpStatus = Int
a} :: ModifyFleetResponse)

instance Prelude.NFData ModifyFleetResponse where
  rnf :: ModifyFleetResponse -> ()
rnf ModifyFleetResponse' {Int
Maybe Bool
httpStatus :: Int
return' :: Maybe Bool
$sel:httpStatus:ModifyFleetResponse' :: ModifyFleetResponse -> Int
$sel:return':ModifyFleetResponse' :: ModifyFleetResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
return'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus