{-# 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.RDS.DeleteDBSecurityGroup
-- 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 DB security group.
--
-- The specified DB security group must not be associated with any DB
-- instances.
--
-- EC2-Classic was retired on August 15, 2022. If you haven\'t migrated
-- from EC2-Classic to a VPC, we recommend that you migrate as soon as
-- possible. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/vpc-migrate.html Migrate from EC2-Classic to a VPC>
-- in the /Amazon EC2 User Guide/, the blog
-- <http://aws.amazon.com/blogs/aws/ec2-classic-is-retiring-heres-how-to-prepare/ EC2-Classic Networking is Retiring – Here’s How to Prepare>,
-- and
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_VPC.Non-VPC2VPC.html Moving a DB instance not in a VPC into a VPC>
-- in the /Amazon RDS User Guide/.
module Amazonka.RDS.DeleteDBSecurityGroup
  ( -- * Creating a Request
    DeleteDBSecurityGroup (..),
    newDeleteDBSecurityGroup,

    -- * Request Lenses
    deleteDBSecurityGroup_dbSecurityGroupName,

    -- * Destructuring the Response
    DeleteDBSecurityGroupResponse (..),
    newDeleteDBSecurityGroupResponse,
  )
where

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

-- |
--
-- /See:/ 'newDeleteDBSecurityGroup' smart constructor.
data DeleteDBSecurityGroup = DeleteDBSecurityGroup'
  { -- | The name of the DB security group to delete.
    --
    -- You can\'t delete the default DB security group.
    --
    -- Constraints:
    --
    -- -   Must be 1 to 255 letters, numbers, or hyphens.
    --
    -- -   First character must be a letter
    --
    -- -   Can\'t end with a hyphen or contain two consecutive hyphens
    --
    -- -   Must not be \"Default\"
    DeleteDBSecurityGroup -> Text
dbSecurityGroupName :: Prelude.Text
  }
  deriving (DeleteDBSecurityGroup -> DeleteDBSecurityGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDBSecurityGroup -> DeleteDBSecurityGroup -> Bool
$c/= :: DeleteDBSecurityGroup -> DeleteDBSecurityGroup -> Bool
== :: DeleteDBSecurityGroup -> DeleteDBSecurityGroup -> Bool
$c== :: DeleteDBSecurityGroup -> DeleteDBSecurityGroup -> Bool
Prelude.Eq, ReadPrec [DeleteDBSecurityGroup]
ReadPrec DeleteDBSecurityGroup
Int -> ReadS DeleteDBSecurityGroup
ReadS [DeleteDBSecurityGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDBSecurityGroup]
$creadListPrec :: ReadPrec [DeleteDBSecurityGroup]
readPrec :: ReadPrec DeleteDBSecurityGroup
$creadPrec :: ReadPrec DeleteDBSecurityGroup
readList :: ReadS [DeleteDBSecurityGroup]
$creadList :: ReadS [DeleteDBSecurityGroup]
readsPrec :: Int -> ReadS DeleteDBSecurityGroup
$creadsPrec :: Int -> ReadS DeleteDBSecurityGroup
Prelude.Read, Int -> DeleteDBSecurityGroup -> ShowS
[DeleteDBSecurityGroup] -> ShowS
DeleteDBSecurityGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDBSecurityGroup] -> ShowS
$cshowList :: [DeleteDBSecurityGroup] -> ShowS
show :: DeleteDBSecurityGroup -> String
$cshow :: DeleteDBSecurityGroup -> String
showsPrec :: Int -> DeleteDBSecurityGroup -> ShowS
$cshowsPrec :: Int -> DeleteDBSecurityGroup -> ShowS
Prelude.Show, forall x. Rep DeleteDBSecurityGroup x -> DeleteDBSecurityGroup
forall x. DeleteDBSecurityGroup -> Rep DeleteDBSecurityGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteDBSecurityGroup x -> DeleteDBSecurityGroup
$cfrom :: forall x. DeleteDBSecurityGroup -> Rep DeleteDBSecurityGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDBSecurityGroup' 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:
--
-- 'dbSecurityGroupName', 'deleteDBSecurityGroup_dbSecurityGroupName' - The name of the DB security group to delete.
--
-- You can\'t delete the default DB security group.
--
-- Constraints:
--
-- -   Must be 1 to 255 letters, numbers, or hyphens.
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- -   Must not be \"Default\"
newDeleteDBSecurityGroup ::
  -- | 'dbSecurityGroupName'
  Prelude.Text ->
  DeleteDBSecurityGroup
newDeleteDBSecurityGroup :: Text -> DeleteDBSecurityGroup
newDeleteDBSecurityGroup Text
pDBSecurityGroupName_ =
  DeleteDBSecurityGroup'
    { $sel:dbSecurityGroupName:DeleteDBSecurityGroup' :: Text
dbSecurityGroupName =
        Text
pDBSecurityGroupName_
    }

-- | The name of the DB security group to delete.
--
-- You can\'t delete the default DB security group.
--
-- Constraints:
--
-- -   Must be 1 to 255 letters, numbers, or hyphens.
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- -   Must not be \"Default\"
deleteDBSecurityGroup_dbSecurityGroupName :: Lens.Lens' DeleteDBSecurityGroup Prelude.Text
deleteDBSecurityGroup_dbSecurityGroupName :: Lens' DeleteDBSecurityGroup Text
deleteDBSecurityGroup_dbSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDBSecurityGroup' {Text
dbSecurityGroupName :: Text
$sel:dbSecurityGroupName:DeleteDBSecurityGroup' :: DeleteDBSecurityGroup -> Text
dbSecurityGroupName} -> Text
dbSecurityGroupName) (\s :: DeleteDBSecurityGroup
s@DeleteDBSecurityGroup' {} Text
a -> DeleteDBSecurityGroup
s {$sel:dbSecurityGroupName:DeleteDBSecurityGroup' :: Text
dbSecurityGroupName = Text
a} :: DeleteDBSecurityGroup)

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

instance Prelude.Hashable DeleteDBSecurityGroup where
  hashWithSalt :: Int -> DeleteDBSecurityGroup -> Int
hashWithSalt Int
_salt DeleteDBSecurityGroup' {Text
dbSecurityGroupName :: Text
$sel:dbSecurityGroupName:DeleteDBSecurityGroup' :: DeleteDBSecurityGroup -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbSecurityGroupName

instance Prelude.NFData DeleteDBSecurityGroup where
  rnf :: DeleteDBSecurityGroup -> ()
rnf DeleteDBSecurityGroup' {Text
dbSecurityGroupName :: Text
$sel:dbSecurityGroupName:DeleteDBSecurityGroup' :: DeleteDBSecurityGroup -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
dbSecurityGroupName

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

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

instance Data.ToQuery DeleteDBSecurityGroup where
  toQuery :: DeleteDBSecurityGroup -> QueryString
toQuery DeleteDBSecurityGroup' {Text
dbSecurityGroupName :: Text
$sel:dbSecurityGroupName:DeleteDBSecurityGroup' :: DeleteDBSecurityGroup -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteDBSecurityGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DBSecurityGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbSecurityGroupName
      ]

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

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

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