{-# 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.DeleteSubnetCidrReservation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a subnet CIDR reservation.
module Amazonka.EC2.DeleteSubnetCidrReservation
  ( -- * Creating a Request
    DeleteSubnetCidrReservation (..),
    newDeleteSubnetCidrReservation,

    -- * Request Lenses
    deleteSubnetCidrReservation_dryRun,
    deleteSubnetCidrReservation_subnetCidrReservationId,

    -- * Destructuring the Response
    DeleteSubnetCidrReservationResponse (..),
    newDeleteSubnetCidrReservationResponse,

    -- * Response Lenses
    deleteSubnetCidrReservationResponse_deletedSubnetCidrReservation,
    deleteSubnetCidrReservationResponse_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:/ 'newDeleteSubnetCidrReservation' smart constructor.
data DeleteSubnetCidrReservation = DeleteSubnetCidrReservation'
  { -- | 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@.
    DeleteSubnetCidrReservation -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the subnet CIDR reservation.
    DeleteSubnetCidrReservation -> Text
subnetCidrReservationId :: Prelude.Text
  }
  deriving (DeleteSubnetCidrReservation -> DeleteSubnetCidrReservation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSubnetCidrReservation -> DeleteSubnetCidrReservation -> Bool
$c/= :: DeleteSubnetCidrReservation -> DeleteSubnetCidrReservation -> Bool
== :: DeleteSubnetCidrReservation -> DeleteSubnetCidrReservation -> Bool
$c== :: DeleteSubnetCidrReservation -> DeleteSubnetCidrReservation -> Bool
Prelude.Eq, ReadPrec [DeleteSubnetCidrReservation]
ReadPrec DeleteSubnetCidrReservation
Int -> ReadS DeleteSubnetCidrReservation
ReadS [DeleteSubnetCidrReservation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSubnetCidrReservation]
$creadListPrec :: ReadPrec [DeleteSubnetCidrReservation]
readPrec :: ReadPrec DeleteSubnetCidrReservation
$creadPrec :: ReadPrec DeleteSubnetCidrReservation
readList :: ReadS [DeleteSubnetCidrReservation]
$creadList :: ReadS [DeleteSubnetCidrReservation]
readsPrec :: Int -> ReadS DeleteSubnetCidrReservation
$creadsPrec :: Int -> ReadS DeleteSubnetCidrReservation
Prelude.Read, Int -> DeleteSubnetCidrReservation -> ShowS
[DeleteSubnetCidrReservation] -> ShowS
DeleteSubnetCidrReservation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSubnetCidrReservation] -> ShowS
$cshowList :: [DeleteSubnetCidrReservation] -> ShowS
show :: DeleteSubnetCidrReservation -> String
$cshow :: DeleteSubnetCidrReservation -> String
showsPrec :: Int -> DeleteSubnetCidrReservation -> ShowS
$cshowsPrec :: Int -> DeleteSubnetCidrReservation -> ShowS
Prelude.Show, forall x.
Rep DeleteSubnetCidrReservation x -> DeleteSubnetCidrReservation
forall x.
DeleteSubnetCidrReservation -> Rep DeleteSubnetCidrReservation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteSubnetCidrReservation x -> DeleteSubnetCidrReservation
$cfrom :: forall x.
DeleteSubnetCidrReservation -> Rep DeleteSubnetCidrReservation x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSubnetCidrReservation' 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', 'deleteSubnetCidrReservation_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@.
--
-- 'subnetCidrReservationId', 'deleteSubnetCidrReservation_subnetCidrReservationId' - The ID of the subnet CIDR reservation.
newDeleteSubnetCidrReservation ::
  -- | 'subnetCidrReservationId'
  Prelude.Text ->
  DeleteSubnetCidrReservation
newDeleteSubnetCidrReservation :: Text -> DeleteSubnetCidrReservation
newDeleteSubnetCidrReservation
  Text
pSubnetCidrReservationId_ =
    DeleteSubnetCidrReservation'
      { $sel:dryRun:DeleteSubnetCidrReservation' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:subnetCidrReservationId:DeleteSubnetCidrReservation' :: Text
subnetCidrReservationId =
          Text
pSubnetCidrReservationId_
      }

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

-- | The ID of the subnet CIDR reservation.
deleteSubnetCidrReservation_subnetCidrReservationId :: Lens.Lens' DeleteSubnetCidrReservation Prelude.Text
deleteSubnetCidrReservation_subnetCidrReservationId :: Lens' DeleteSubnetCidrReservation Text
deleteSubnetCidrReservation_subnetCidrReservationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSubnetCidrReservation' {Text
subnetCidrReservationId :: Text
$sel:subnetCidrReservationId:DeleteSubnetCidrReservation' :: DeleteSubnetCidrReservation -> Text
subnetCidrReservationId} -> Text
subnetCidrReservationId) (\s :: DeleteSubnetCidrReservation
s@DeleteSubnetCidrReservation' {} Text
a -> DeleteSubnetCidrReservation
s {$sel:subnetCidrReservationId:DeleteSubnetCidrReservation' :: Text
subnetCidrReservationId = Text
a} :: DeleteSubnetCidrReservation)

instance Core.AWSRequest DeleteSubnetCidrReservation where
  type
    AWSResponse DeleteSubnetCidrReservation =
      DeleteSubnetCidrReservationResponse
  request :: (Service -> Service)
-> DeleteSubnetCidrReservation
-> Request DeleteSubnetCidrReservation
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 DeleteSubnetCidrReservation
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteSubnetCidrReservation)))
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 SubnetCidrReservation
-> Int -> DeleteSubnetCidrReservationResponse
DeleteSubnetCidrReservationResponse'
            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
"deletedSubnetCidrReservation")
            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 DeleteSubnetCidrReservation where
  hashWithSalt :: Int -> DeleteSubnetCidrReservation -> Int
hashWithSalt Int
_salt DeleteSubnetCidrReservation' {Maybe Bool
Text
subnetCidrReservationId :: Text
dryRun :: Maybe Bool
$sel:subnetCidrReservationId:DeleteSubnetCidrReservation' :: DeleteSubnetCidrReservation -> Text
$sel:dryRun:DeleteSubnetCidrReservation' :: DeleteSubnetCidrReservation -> 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
subnetCidrReservationId

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

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

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

instance Data.ToQuery DeleteSubnetCidrReservation where
  toQuery :: DeleteSubnetCidrReservation -> QueryString
toQuery DeleteSubnetCidrReservation' {Maybe Bool
Text
subnetCidrReservationId :: Text
dryRun :: Maybe Bool
$sel:subnetCidrReservationId:DeleteSubnetCidrReservation' :: DeleteSubnetCidrReservation -> Text
$sel:dryRun:DeleteSubnetCidrReservation' :: DeleteSubnetCidrReservation -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"DeleteSubnetCidrReservation" ::
                      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
"SubnetCidrReservationId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
subnetCidrReservationId
      ]

-- | /See:/ 'newDeleteSubnetCidrReservationResponse' smart constructor.
data DeleteSubnetCidrReservationResponse = DeleteSubnetCidrReservationResponse'
  { -- | Information about the deleted subnet CIDR reservation.
    DeleteSubnetCidrReservationResponse -> Maybe SubnetCidrReservation
deletedSubnetCidrReservation :: Prelude.Maybe SubnetCidrReservation,
    -- | The response's http status code.
    DeleteSubnetCidrReservationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteSubnetCidrReservationResponse
-> DeleteSubnetCidrReservationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSubnetCidrReservationResponse
-> DeleteSubnetCidrReservationResponse -> Bool
$c/= :: DeleteSubnetCidrReservationResponse
-> DeleteSubnetCidrReservationResponse -> Bool
== :: DeleteSubnetCidrReservationResponse
-> DeleteSubnetCidrReservationResponse -> Bool
$c== :: DeleteSubnetCidrReservationResponse
-> DeleteSubnetCidrReservationResponse -> Bool
Prelude.Eq, ReadPrec [DeleteSubnetCidrReservationResponse]
ReadPrec DeleteSubnetCidrReservationResponse
Int -> ReadS DeleteSubnetCidrReservationResponse
ReadS [DeleteSubnetCidrReservationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSubnetCidrReservationResponse]
$creadListPrec :: ReadPrec [DeleteSubnetCidrReservationResponse]
readPrec :: ReadPrec DeleteSubnetCidrReservationResponse
$creadPrec :: ReadPrec DeleteSubnetCidrReservationResponse
readList :: ReadS [DeleteSubnetCidrReservationResponse]
$creadList :: ReadS [DeleteSubnetCidrReservationResponse]
readsPrec :: Int -> ReadS DeleteSubnetCidrReservationResponse
$creadsPrec :: Int -> ReadS DeleteSubnetCidrReservationResponse
Prelude.Read, Int -> DeleteSubnetCidrReservationResponse -> ShowS
[DeleteSubnetCidrReservationResponse] -> ShowS
DeleteSubnetCidrReservationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSubnetCidrReservationResponse] -> ShowS
$cshowList :: [DeleteSubnetCidrReservationResponse] -> ShowS
show :: DeleteSubnetCidrReservationResponse -> String
$cshow :: DeleteSubnetCidrReservationResponse -> String
showsPrec :: Int -> DeleteSubnetCidrReservationResponse -> ShowS
$cshowsPrec :: Int -> DeleteSubnetCidrReservationResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteSubnetCidrReservationResponse x
-> DeleteSubnetCidrReservationResponse
forall x.
DeleteSubnetCidrReservationResponse
-> Rep DeleteSubnetCidrReservationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteSubnetCidrReservationResponse x
-> DeleteSubnetCidrReservationResponse
$cfrom :: forall x.
DeleteSubnetCidrReservationResponse
-> Rep DeleteSubnetCidrReservationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSubnetCidrReservationResponse' 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:
--
-- 'deletedSubnetCidrReservation', 'deleteSubnetCidrReservationResponse_deletedSubnetCidrReservation' - Information about the deleted subnet CIDR reservation.
--
-- 'httpStatus', 'deleteSubnetCidrReservationResponse_httpStatus' - The response's http status code.
newDeleteSubnetCidrReservationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteSubnetCidrReservationResponse
newDeleteSubnetCidrReservationResponse :: Int -> DeleteSubnetCidrReservationResponse
newDeleteSubnetCidrReservationResponse Int
pHttpStatus_ =
  DeleteSubnetCidrReservationResponse'
    { $sel:deletedSubnetCidrReservation:DeleteSubnetCidrReservationResponse' :: Maybe SubnetCidrReservation
deletedSubnetCidrReservation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteSubnetCidrReservationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the deleted subnet CIDR reservation.
deleteSubnetCidrReservationResponse_deletedSubnetCidrReservation :: Lens.Lens' DeleteSubnetCidrReservationResponse (Prelude.Maybe SubnetCidrReservation)
deleteSubnetCidrReservationResponse_deletedSubnetCidrReservation :: Lens'
  DeleteSubnetCidrReservationResponse (Maybe SubnetCidrReservation)
deleteSubnetCidrReservationResponse_deletedSubnetCidrReservation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSubnetCidrReservationResponse' {Maybe SubnetCidrReservation
deletedSubnetCidrReservation :: Maybe SubnetCidrReservation
$sel:deletedSubnetCidrReservation:DeleteSubnetCidrReservationResponse' :: DeleteSubnetCidrReservationResponse -> Maybe SubnetCidrReservation
deletedSubnetCidrReservation} -> Maybe SubnetCidrReservation
deletedSubnetCidrReservation) (\s :: DeleteSubnetCidrReservationResponse
s@DeleteSubnetCidrReservationResponse' {} Maybe SubnetCidrReservation
a -> DeleteSubnetCidrReservationResponse
s {$sel:deletedSubnetCidrReservation:DeleteSubnetCidrReservationResponse' :: Maybe SubnetCidrReservation
deletedSubnetCidrReservation = Maybe SubnetCidrReservation
a} :: DeleteSubnetCidrReservationResponse)

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

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