{-# 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.ModifyCapacityReservation
-- 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 a Capacity Reservation\'s capacity and the conditions under
-- which it is to be released. You cannot change a Capacity Reservation\'s
-- instance type, EBS optimization, instance store settings, platform,
-- Availability Zone, or instance eligibility. If you need to modify any of
-- these attributes, we recommend that you cancel the Capacity Reservation,
-- and then create a new one with the required attributes.
module Amazonka.EC2.ModifyCapacityReservation
  ( -- * Creating a Request
    ModifyCapacityReservation (..),
    newModifyCapacityReservation,

    -- * Request Lenses
    modifyCapacityReservation_accept,
    modifyCapacityReservation_additionalInfo,
    modifyCapacityReservation_dryRun,
    modifyCapacityReservation_endDate,
    modifyCapacityReservation_endDateType,
    modifyCapacityReservation_instanceCount,
    modifyCapacityReservation_capacityReservationId,

    -- * Destructuring the Response
    ModifyCapacityReservationResponse (..),
    newModifyCapacityReservationResponse,

    -- * Response Lenses
    modifyCapacityReservationResponse_return,
    modifyCapacityReservationResponse_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:/ 'newModifyCapacityReservation' smart constructor.
data ModifyCapacityReservation = ModifyCapacityReservation'
  { -- | Reserved. Capacity Reservations you have created are accepted by
    -- default.
    ModifyCapacityReservation -> Maybe Bool
accept :: Prelude.Maybe Prelude.Bool,
    -- | Reserved for future use.
    ModifyCapacityReservation -> Maybe Text
additionalInfo :: 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@.
    ModifyCapacityReservation -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The date and time at which the Capacity Reservation expires. When a
    -- Capacity Reservation expires, the reserved capacity is released and you
    -- can no longer launch instances into it. The Capacity Reservation\'s
    -- state changes to @expired@ when it reaches its end date and time.
    --
    -- The Capacity Reservation is cancelled within an hour from the specified
    -- time. For example, if you specify 5\/31\/2019, 13:30:55, the Capacity
    -- Reservation is guaranteed to end between 13:30:55 and 14:30:55 on
    -- 5\/31\/2019.
    --
    -- You must provide an @EndDate@ value if @EndDateType@ is @limited@. Omit
    -- @EndDate@ if @EndDateType@ is @unlimited@.
    ModifyCapacityReservation -> Maybe ISO8601
endDate :: Prelude.Maybe Data.ISO8601,
    -- | Indicates the way in which the Capacity Reservation ends. A Capacity
    -- Reservation can have one of the following end types:
    --
    -- -   @unlimited@ - The Capacity Reservation remains active until you
    --     explicitly cancel it. Do not provide an @EndDate@ value if
    --     @EndDateType@ is @unlimited@.
    --
    -- -   @limited@ - The Capacity Reservation expires automatically at a
    --     specified date and time. You must provide an @EndDate@ value if
    --     @EndDateType@ is @limited@.
    ModifyCapacityReservation -> Maybe EndDateType
endDateType :: Prelude.Maybe EndDateType,
    -- | The number of instances for which to reserve capacity. The number of
    -- instances can\'t be increased or decreased by more than @1000@ in a
    -- single request.
    ModifyCapacityReservation -> Maybe Int
instanceCount :: Prelude.Maybe Prelude.Int,
    -- | The ID of the Capacity Reservation.
    ModifyCapacityReservation -> Text
capacityReservationId :: Prelude.Text
  }
  deriving (ModifyCapacityReservation -> ModifyCapacityReservation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyCapacityReservation -> ModifyCapacityReservation -> Bool
$c/= :: ModifyCapacityReservation -> ModifyCapacityReservation -> Bool
== :: ModifyCapacityReservation -> ModifyCapacityReservation -> Bool
$c== :: ModifyCapacityReservation -> ModifyCapacityReservation -> Bool
Prelude.Eq, ReadPrec [ModifyCapacityReservation]
ReadPrec ModifyCapacityReservation
Int -> ReadS ModifyCapacityReservation
ReadS [ModifyCapacityReservation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyCapacityReservation]
$creadListPrec :: ReadPrec [ModifyCapacityReservation]
readPrec :: ReadPrec ModifyCapacityReservation
$creadPrec :: ReadPrec ModifyCapacityReservation
readList :: ReadS [ModifyCapacityReservation]
$creadList :: ReadS [ModifyCapacityReservation]
readsPrec :: Int -> ReadS ModifyCapacityReservation
$creadsPrec :: Int -> ReadS ModifyCapacityReservation
Prelude.Read, Int -> ModifyCapacityReservation -> ShowS
[ModifyCapacityReservation] -> ShowS
ModifyCapacityReservation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyCapacityReservation] -> ShowS
$cshowList :: [ModifyCapacityReservation] -> ShowS
show :: ModifyCapacityReservation -> String
$cshow :: ModifyCapacityReservation -> String
showsPrec :: Int -> ModifyCapacityReservation -> ShowS
$cshowsPrec :: Int -> ModifyCapacityReservation -> ShowS
Prelude.Show, forall x.
Rep ModifyCapacityReservation x -> ModifyCapacityReservation
forall x.
ModifyCapacityReservation -> Rep ModifyCapacityReservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyCapacityReservation x -> ModifyCapacityReservation
$cfrom :: forall x.
ModifyCapacityReservation -> Rep ModifyCapacityReservation x
Prelude.Generic)

-- |
-- Create a value of 'ModifyCapacityReservation' 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:
--
-- 'accept', 'modifyCapacityReservation_accept' - Reserved. Capacity Reservations you have created are accepted by
-- default.
--
-- 'additionalInfo', 'modifyCapacityReservation_additionalInfo' - Reserved for future use.
--
-- 'dryRun', 'modifyCapacityReservation_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@.
--
-- 'endDate', 'modifyCapacityReservation_endDate' - The date and time at which the Capacity Reservation expires. When a
-- Capacity Reservation expires, the reserved capacity is released and you
-- can no longer launch instances into it. The Capacity Reservation\'s
-- state changes to @expired@ when it reaches its end date and time.
--
-- The Capacity Reservation is cancelled within an hour from the specified
-- time. For example, if you specify 5\/31\/2019, 13:30:55, the Capacity
-- Reservation is guaranteed to end between 13:30:55 and 14:30:55 on
-- 5\/31\/2019.
--
-- You must provide an @EndDate@ value if @EndDateType@ is @limited@. Omit
-- @EndDate@ if @EndDateType@ is @unlimited@.
--
-- 'endDateType', 'modifyCapacityReservation_endDateType' - Indicates the way in which the Capacity Reservation ends. A Capacity
-- Reservation can have one of the following end types:
--
-- -   @unlimited@ - The Capacity Reservation remains active until you
--     explicitly cancel it. Do not provide an @EndDate@ value if
--     @EndDateType@ is @unlimited@.
--
-- -   @limited@ - The Capacity Reservation expires automatically at a
--     specified date and time. You must provide an @EndDate@ value if
--     @EndDateType@ is @limited@.
--
-- 'instanceCount', 'modifyCapacityReservation_instanceCount' - The number of instances for which to reserve capacity. The number of
-- instances can\'t be increased or decreased by more than @1000@ in a
-- single request.
--
-- 'capacityReservationId', 'modifyCapacityReservation_capacityReservationId' - The ID of the Capacity Reservation.
newModifyCapacityReservation ::
  -- | 'capacityReservationId'
  Prelude.Text ->
  ModifyCapacityReservation
newModifyCapacityReservation :: Text -> ModifyCapacityReservation
newModifyCapacityReservation Text
pCapacityReservationId_ =
  ModifyCapacityReservation'
    { $sel:accept:ModifyCapacityReservation' :: Maybe Bool
accept =
        forall a. Maybe a
Prelude.Nothing,
      $sel:additionalInfo:ModifyCapacityReservation' :: Maybe Text
additionalInfo = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:ModifyCapacityReservation' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:endDate:ModifyCapacityReservation' :: Maybe ISO8601
endDate = forall a. Maybe a
Prelude.Nothing,
      $sel:endDateType:ModifyCapacityReservation' :: Maybe EndDateType
endDateType = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceCount:ModifyCapacityReservation' :: Maybe Int
instanceCount = forall a. Maybe a
Prelude.Nothing,
      $sel:capacityReservationId:ModifyCapacityReservation' :: Text
capacityReservationId = Text
pCapacityReservationId_
    }

-- | Reserved. Capacity Reservations you have created are accepted by
-- default.
modifyCapacityReservation_accept :: Lens.Lens' ModifyCapacityReservation (Prelude.Maybe Prelude.Bool)
modifyCapacityReservation_accept :: Lens' ModifyCapacityReservation (Maybe Bool)
modifyCapacityReservation_accept = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCapacityReservation' {Maybe Bool
accept :: Maybe Bool
$sel:accept:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Bool
accept} -> Maybe Bool
accept) (\s :: ModifyCapacityReservation
s@ModifyCapacityReservation' {} Maybe Bool
a -> ModifyCapacityReservation
s {$sel:accept:ModifyCapacityReservation' :: Maybe Bool
accept = Maybe Bool
a} :: ModifyCapacityReservation)

-- | Reserved for future use.
modifyCapacityReservation_additionalInfo :: Lens.Lens' ModifyCapacityReservation (Prelude.Maybe Prelude.Text)
modifyCapacityReservation_additionalInfo :: Lens' ModifyCapacityReservation (Maybe Text)
modifyCapacityReservation_additionalInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCapacityReservation' {Maybe Text
additionalInfo :: Maybe Text
$sel:additionalInfo:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Text
additionalInfo} -> Maybe Text
additionalInfo) (\s :: ModifyCapacityReservation
s@ModifyCapacityReservation' {} Maybe Text
a -> ModifyCapacityReservation
s {$sel:additionalInfo:ModifyCapacityReservation' :: Maybe Text
additionalInfo = Maybe Text
a} :: ModifyCapacityReservation)

-- | 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@.
modifyCapacityReservation_dryRun :: Lens.Lens' ModifyCapacityReservation (Prelude.Maybe Prelude.Bool)
modifyCapacityReservation_dryRun :: Lens' ModifyCapacityReservation (Maybe Bool)
modifyCapacityReservation_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCapacityReservation' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ModifyCapacityReservation
s@ModifyCapacityReservation' {} Maybe Bool
a -> ModifyCapacityReservation
s {$sel:dryRun:ModifyCapacityReservation' :: Maybe Bool
dryRun = Maybe Bool
a} :: ModifyCapacityReservation)

-- | The date and time at which the Capacity Reservation expires. When a
-- Capacity Reservation expires, the reserved capacity is released and you
-- can no longer launch instances into it. The Capacity Reservation\'s
-- state changes to @expired@ when it reaches its end date and time.
--
-- The Capacity Reservation is cancelled within an hour from the specified
-- time. For example, if you specify 5\/31\/2019, 13:30:55, the Capacity
-- Reservation is guaranteed to end between 13:30:55 and 14:30:55 on
-- 5\/31\/2019.
--
-- You must provide an @EndDate@ value if @EndDateType@ is @limited@. Omit
-- @EndDate@ if @EndDateType@ is @unlimited@.
modifyCapacityReservation_endDate :: Lens.Lens' ModifyCapacityReservation (Prelude.Maybe Prelude.UTCTime)
modifyCapacityReservation_endDate :: Lens' ModifyCapacityReservation (Maybe UTCTime)
modifyCapacityReservation_endDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCapacityReservation' {Maybe ISO8601
endDate :: Maybe ISO8601
$sel:endDate:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe ISO8601
endDate} -> Maybe ISO8601
endDate) (\s :: ModifyCapacityReservation
s@ModifyCapacityReservation' {} Maybe ISO8601
a -> ModifyCapacityReservation
s {$sel:endDate:ModifyCapacityReservation' :: Maybe ISO8601
endDate = Maybe ISO8601
a} :: ModifyCapacityReservation) 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

-- | Indicates the way in which the Capacity Reservation ends. A Capacity
-- Reservation can have one of the following end types:
--
-- -   @unlimited@ - The Capacity Reservation remains active until you
--     explicitly cancel it. Do not provide an @EndDate@ value if
--     @EndDateType@ is @unlimited@.
--
-- -   @limited@ - The Capacity Reservation expires automatically at a
--     specified date and time. You must provide an @EndDate@ value if
--     @EndDateType@ is @limited@.
modifyCapacityReservation_endDateType :: Lens.Lens' ModifyCapacityReservation (Prelude.Maybe EndDateType)
modifyCapacityReservation_endDateType :: Lens' ModifyCapacityReservation (Maybe EndDateType)
modifyCapacityReservation_endDateType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCapacityReservation' {Maybe EndDateType
endDateType :: Maybe EndDateType
$sel:endDateType:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe EndDateType
endDateType} -> Maybe EndDateType
endDateType) (\s :: ModifyCapacityReservation
s@ModifyCapacityReservation' {} Maybe EndDateType
a -> ModifyCapacityReservation
s {$sel:endDateType:ModifyCapacityReservation' :: Maybe EndDateType
endDateType = Maybe EndDateType
a} :: ModifyCapacityReservation)

-- | The number of instances for which to reserve capacity. The number of
-- instances can\'t be increased or decreased by more than @1000@ in a
-- single request.
modifyCapacityReservation_instanceCount :: Lens.Lens' ModifyCapacityReservation (Prelude.Maybe Prelude.Int)
modifyCapacityReservation_instanceCount :: Lens' ModifyCapacityReservation (Maybe Int)
modifyCapacityReservation_instanceCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCapacityReservation' {Maybe Int
instanceCount :: Maybe Int
$sel:instanceCount:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Int
instanceCount} -> Maybe Int
instanceCount) (\s :: ModifyCapacityReservation
s@ModifyCapacityReservation' {} Maybe Int
a -> ModifyCapacityReservation
s {$sel:instanceCount:ModifyCapacityReservation' :: Maybe Int
instanceCount = Maybe Int
a} :: ModifyCapacityReservation)

-- | The ID of the Capacity Reservation.
modifyCapacityReservation_capacityReservationId :: Lens.Lens' ModifyCapacityReservation Prelude.Text
modifyCapacityReservation_capacityReservationId :: Lens' ModifyCapacityReservation Text
modifyCapacityReservation_capacityReservationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCapacityReservation' {Text
capacityReservationId :: Text
$sel:capacityReservationId:ModifyCapacityReservation' :: ModifyCapacityReservation -> Text
capacityReservationId} -> Text
capacityReservationId) (\s :: ModifyCapacityReservation
s@ModifyCapacityReservation' {} Text
a -> ModifyCapacityReservation
s {$sel:capacityReservationId:ModifyCapacityReservation' :: Text
capacityReservationId = Text
a} :: ModifyCapacityReservation)

instance Core.AWSRequest ModifyCapacityReservation where
  type
    AWSResponse ModifyCapacityReservation =
      ModifyCapacityReservationResponse
  request :: (Service -> Service)
-> ModifyCapacityReservation -> Request ModifyCapacityReservation
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 ModifyCapacityReservation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifyCapacityReservation)))
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 -> ModifyCapacityReservationResponse
ModifyCapacityReservationResponse'
            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 ModifyCapacityReservation where
  hashWithSalt :: Int -> ModifyCapacityReservation -> Int
hashWithSalt Int
_salt ModifyCapacityReservation' {Maybe Bool
Maybe Int
Maybe Text
Maybe ISO8601
Maybe EndDateType
Text
capacityReservationId :: Text
instanceCount :: Maybe Int
endDateType :: Maybe EndDateType
endDate :: Maybe ISO8601
dryRun :: Maybe Bool
additionalInfo :: Maybe Text
accept :: Maybe Bool
$sel:capacityReservationId:ModifyCapacityReservation' :: ModifyCapacityReservation -> Text
$sel:instanceCount:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Int
$sel:endDateType:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe EndDateType
$sel:endDate:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe ISO8601
$sel:dryRun:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Bool
$sel:additionalInfo:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Text
$sel:accept:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
accept
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
additionalInfo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
endDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndDateType
endDateType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
instanceCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
capacityReservationId

instance Prelude.NFData ModifyCapacityReservation where
  rnf :: ModifyCapacityReservation -> ()
rnf ModifyCapacityReservation' {Maybe Bool
Maybe Int
Maybe Text
Maybe ISO8601
Maybe EndDateType
Text
capacityReservationId :: Text
instanceCount :: Maybe Int
endDateType :: Maybe EndDateType
endDate :: Maybe ISO8601
dryRun :: Maybe Bool
additionalInfo :: Maybe Text
accept :: Maybe Bool
$sel:capacityReservationId:ModifyCapacityReservation' :: ModifyCapacityReservation -> Text
$sel:instanceCount:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Int
$sel:endDateType:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe EndDateType
$sel:endDate:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe ISO8601
$sel:dryRun:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Bool
$sel:additionalInfo:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Text
$sel:accept:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
accept
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
additionalInfo
      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 ISO8601
endDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndDateType
endDateType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
instanceCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
capacityReservationId

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

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

instance Data.ToQuery ModifyCapacityReservation where
  toQuery :: ModifyCapacityReservation -> QueryString
toQuery ModifyCapacityReservation' {Maybe Bool
Maybe Int
Maybe Text
Maybe ISO8601
Maybe EndDateType
Text
capacityReservationId :: Text
instanceCount :: Maybe Int
endDateType :: Maybe EndDateType
endDate :: Maybe ISO8601
dryRun :: Maybe Bool
additionalInfo :: Maybe Text
accept :: Maybe Bool
$sel:capacityReservationId:ModifyCapacityReservation' :: ModifyCapacityReservation -> Text
$sel:instanceCount:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Int
$sel:endDateType:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe EndDateType
$sel:endDate:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe ISO8601
$sel:dryRun:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Bool
$sel:additionalInfo:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Text
$sel:accept:ModifyCapacityReservation' :: ModifyCapacityReservation -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyCapacityReservation" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"Accept" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
accept,
        ByteString
"AdditionalInfo" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
additionalInfo,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"EndDate" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
endDate,
        ByteString
"EndDateType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe EndDateType
endDateType,
        ByteString
"InstanceCount" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
instanceCount,
        ByteString
"CapacityReservationId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
capacityReservationId
      ]

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

-- |
-- Create a value of 'ModifyCapacityReservationResponse' 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'', 'modifyCapacityReservationResponse_return' - Returns @true@ if the request succeeds; otherwise, it returns an error.
--
-- 'httpStatus', 'modifyCapacityReservationResponse_httpStatus' - The response's http status code.
newModifyCapacityReservationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifyCapacityReservationResponse
newModifyCapacityReservationResponse :: Int -> ModifyCapacityReservationResponse
newModifyCapacityReservationResponse Int
pHttpStatus_ =
  ModifyCapacityReservationResponse'
    { $sel:return':ModifyCapacityReservationResponse' :: Maybe Bool
return' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifyCapacityReservationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns @true@ if the request succeeds; otherwise, it returns an error.
modifyCapacityReservationResponse_return :: Lens.Lens' ModifyCapacityReservationResponse (Prelude.Maybe Prelude.Bool)
modifyCapacityReservationResponse_return :: Lens' ModifyCapacityReservationResponse (Maybe Bool)
modifyCapacityReservationResponse_return = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCapacityReservationResponse' {Maybe Bool
return' :: Maybe Bool
$sel:return':ModifyCapacityReservationResponse' :: ModifyCapacityReservationResponse -> Maybe Bool
return'} -> Maybe Bool
return') (\s :: ModifyCapacityReservationResponse
s@ModifyCapacityReservationResponse' {} Maybe Bool
a -> ModifyCapacityReservationResponse
s {$sel:return':ModifyCapacityReservationResponse' :: Maybe Bool
return' = Maybe Bool
a} :: ModifyCapacityReservationResponse)

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

instance
  Prelude.NFData
    ModifyCapacityReservationResponse
  where
  rnf :: ModifyCapacityReservationResponse -> ()
rnf ModifyCapacityReservationResponse' {Int
Maybe Bool
httpStatus :: Int
return' :: Maybe Bool
$sel:httpStatus:ModifyCapacityReservationResponse' :: ModifyCapacityReservationResponse -> Int
$sel:return':ModifyCapacityReservationResponse' :: ModifyCapacityReservationResponse -> 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