{-# 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.CancelCapacityReservation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Cancels the specified Capacity Reservation, releases the reserved
-- capacity, and changes the Capacity Reservation\'s state to @cancelled@.
--
-- Instances running in the reserved capacity continue running until you
-- stop them. Stopped instances that target the Capacity Reservation can no
-- longer launch. Modify these instances to either target a different
-- Capacity Reservation, launch On-Demand Instance capacity, or run in any
-- open Capacity Reservation that has matching attributes and sufficient
-- capacity.
module Amazonka.EC2.CancelCapacityReservation
  ( -- * Creating a Request
    CancelCapacityReservation (..),
    newCancelCapacityReservation,

    -- * Request Lenses
    cancelCapacityReservation_dryRun,
    cancelCapacityReservation_capacityReservationId,

    -- * Destructuring the Response
    CancelCapacityReservationResponse (..),
    newCancelCapacityReservationResponse,

    -- * Response Lenses
    cancelCapacityReservationResponse_return,
    cancelCapacityReservationResponse_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:/ 'newCancelCapacityReservation' smart constructor.
data CancelCapacityReservation = CancelCapacityReservation'
  { -- | 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@.
    CancelCapacityReservation -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Capacity Reservation to be cancelled.
    CancelCapacityReservation -> Text
capacityReservationId :: Prelude.Text
  }
  deriving (CancelCapacityReservation -> CancelCapacityReservation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CancelCapacityReservation -> CancelCapacityReservation -> Bool
$c/= :: CancelCapacityReservation -> CancelCapacityReservation -> Bool
== :: CancelCapacityReservation -> CancelCapacityReservation -> Bool
$c== :: CancelCapacityReservation -> CancelCapacityReservation -> Bool
Prelude.Eq, ReadPrec [CancelCapacityReservation]
ReadPrec CancelCapacityReservation
Int -> ReadS CancelCapacityReservation
ReadS [CancelCapacityReservation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CancelCapacityReservation]
$creadListPrec :: ReadPrec [CancelCapacityReservation]
readPrec :: ReadPrec CancelCapacityReservation
$creadPrec :: ReadPrec CancelCapacityReservation
readList :: ReadS [CancelCapacityReservation]
$creadList :: ReadS [CancelCapacityReservation]
readsPrec :: Int -> ReadS CancelCapacityReservation
$creadsPrec :: Int -> ReadS CancelCapacityReservation
Prelude.Read, Int -> CancelCapacityReservation -> ShowS
[CancelCapacityReservation] -> ShowS
CancelCapacityReservation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CancelCapacityReservation] -> ShowS
$cshowList :: [CancelCapacityReservation] -> ShowS
show :: CancelCapacityReservation -> String
$cshow :: CancelCapacityReservation -> String
showsPrec :: Int -> CancelCapacityReservation -> ShowS
$cshowsPrec :: Int -> CancelCapacityReservation -> ShowS
Prelude.Show, forall x.
Rep CancelCapacityReservation x -> CancelCapacityReservation
forall x.
CancelCapacityReservation -> Rep CancelCapacityReservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CancelCapacityReservation x -> CancelCapacityReservation
$cfrom :: forall x.
CancelCapacityReservation -> Rep CancelCapacityReservation x
Prelude.Generic)

-- |
-- Create a value of 'CancelCapacityReservation' 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:
--
-- 'dryRun', 'cancelCapacityReservation_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@.
--
-- 'capacityReservationId', 'cancelCapacityReservation_capacityReservationId' - The ID of the Capacity Reservation to be cancelled.
newCancelCapacityReservation ::
  -- | 'capacityReservationId'
  Prelude.Text ->
  CancelCapacityReservation
newCancelCapacityReservation :: Text -> CancelCapacityReservation
newCancelCapacityReservation Text
pCapacityReservationId_ =
  CancelCapacityReservation'
    { $sel:dryRun:CancelCapacityReservation' :: Maybe Bool
dryRun =
        forall a. Maybe a
Prelude.Nothing,
      $sel:capacityReservationId:CancelCapacityReservation' :: Text
capacityReservationId = Text
pCapacityReservationId_
    }

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

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

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

instance Prelude.NFData CancelCapacityReservation where
  rnf :: CancelCapacityReservation -> ()
rnf CancelCapacityReservation' {Maybe Bool
Text
capacityReservationId :: Text
dryRun :: Maybe Bool
$sel:capacityReservationId:CancelCapacityReservation' :: CancelCapacityReservation -> Text
$sel:dryRun:CancelCapacityReservation' :: CancelCapacityReservation -> Maybe Bool
..} =
    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 Text
capacityReservationId

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

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

instance Data.ToQuery CancelCapacityReservation where
  toQuery :: CancelCapacityReservation -> QueryString
toQuery CancelCapacityReservation' {Maybe Bool
Text
capacityReservationId :: Text
dryRun :: Maybe Bool
$sel:capacityReservationId:CancelCapacityReservation' :: CancelCapacityReservation -> Text
$sel:dryRun:CancelCapacityReservation' :: CancelCapacityReservation -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CancelCapacityReservation" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"CapacityReservationId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
capacityReservationId
      ]

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

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

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

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

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