{-# 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.DeleteSubnet
-- 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 the specified subnet. You must terminate all running instances
-- in the subnet before you can delete the subnet.
module Amazonka.EC2.DeleteSubnet
  ( -- * Creating a Request
    DeleteSubnet (..),
    newDeleteSubnet,

    -- * Request Lenses
    deleteSubnet_dryRun,
    deleteSubnet_subnetId,

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

-- |
-- Create a value of 'DeleteSubnet' 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', 'deleteSubnet_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@.
--
-- 'subnetId', 'deleteSubnet_subnetId' - The ID of the subnet.
newDeleteSubnet ::
  -- | 'subnetId'
  Prelude.Text ->
  DeleteSubnet
newDeleteSubnet :: Text -> DeleteSubnet
newDeleteSubnet Text
pSubnetId_ =
  DeleteSubnet'
    { $sel:dryRun:DeleteSubnet' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetId:DeleteSubnet' :: Text
subnetId = Text
pSubnetId_
    }

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

-- | The ID of the subnet.
deleteSubnet_subnetId :: Lens.Lens' DeleteSubnet Prelude.Text
deleteSubnet_subnetId :: Lens' DeleteSubnet Text
deleteSubnet_subnetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteSubnet' {Text
subnetId :: Text
$sel:subnetId:DeleteSubnet' :: DeleteSubnet -> Text
subnetId} -> Text
subnetId) (\s :: DeleteSubnet
s@DeleteSubnet' {} Text
a -> DeleteSubnet
s {$sel:subnetId:DeleteSubnet' :: Text
subnetId = Text
a} :: DeleteSubnet)

instance Core.AWSRequest DeleteSubnet where
  type AWSResponse DeleteSubnet = DeleteSubnetResponse
  request :: (Service -> Service) -> DeleteSubnet -> Request DeleteSubnet
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 DeleteSubnet
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteSubnet)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteSubnetResponse
DeleteSubnetResponse'

instance Prelude.Hashable DeleteSubnet where
  hashWithSalt :: Int -> DeleteSubnet -> Int
hashWithSalt Int
_salt DeleteSubnet' {Maybe Bool
Text
subnetId :: Text
dryRun :: Maybe Bool
$sel:subnetId:DeleteSubnet' :: DeleteSubnet -> Text
$sel:dryRun:DeleteSubnet' :: DeleteSubnet -> 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
subnetId

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

instance Data.ToHeaders DeleteSubnet where
  toHeaders :: DeleteSubnet -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

-- | /See:/ 'newDeleteSubnetResponse' smart constructor.
data DeleteSubnetResponse = DeleteSubnetResponse'
  {
  }
  deriving (DeleteSubnetResponse -> DeleteSubnetResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteSubnetResponse -> DeleteSubnetResponse -> Bool
$c/= :: DeleteSubnetResponse -> DeleteSubnetResponse -> Bool
== :: DeleteSubnetResponse -> DeleteSubnetResponse -> Bool
$c== :: DeleteSubnetResponse -> DeleteSubnetResponse -> Bool
Prelude.Eq, ReadPrec [DeleteSubnetResponse]
ReadPrec DeleteSubnetResponse
Int -> ReadS DeleteSubnetResponse
ReadS [DeleteSubnetResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteSubnetResponse]
$creadListPrec :: ReadPrec [DeleteSubnetResponse]
readPrec :: ReadPrec DeleteSubnetResponse
$creadPrec :: ReadPrec DeleteSubnetResponse
readList :: ReadS [DeleteSubnetResponse]
$creadList :: ReadS [DeleteSubnetResponse]
readsPrec :: Int -> ReadS DeleteSubnetResponse
$creadsPrec :: Int -> ReadS DeleteSubnetResponse
Prelude.Read, Int -> DeleteSubnetResponse -> ShowS
[DeleteSubnetResponse] -> ShowS
DeleteSubnetResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteSubnetResponse] -> ShowS
$cshowList :: [DeleteSubnetResponse] -> ShowS
show :: DeleteSubnetResponse -> String
$cshow :: DeleteSubnetResponse -> String
showsPrec :: Int -> DeleteSubnetResponse -> ShowS
$cshowsPrec :: Int -> DeleteSubnetResponse -> ShowS
Prelude.Show, forall x. Rep DeleteSubnetResponse x -> DeleteSubnetResponse
forall x. DeleteSubnetResponse -> Rep DeleteSubnetResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteSubnetResponse x -> DeleteSubnetResponse
$cfrom :: forall x. DeleteSubnetResponse -> Rep DeleteSubnetResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteSubnetResponse' 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.
newDeleteSubnetResponse ::
  DeleteSubnetResponse
newDeleteSubnetResponse :: DeleteSubnetResponse
newDeleteSubnetResponse = DeleteSubnetResponse
DeleteSubnetResponse'

instance Prelude.NFData DeleteSubnetResponse where
  rnf :: DeleteSubnetResponse -> ()
rnf DeleteSubnetResponse
_ = ()