{-# 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.Redshift.DeleteClusterSecurityGroup
-- 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 an Amazon Redshift security group.
--
-- You cannot delete a security group that is associated with any clusters.
-- You cannot delete the default security group.
--
-- For information about managing security groups, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-security-groups.html Amazon Redshift Cluster Security Groups>
-- in the /Amazon Redshift Cluster Management Guide/.
module Amazonka.Redshift.DeleteClusterSecurityGroup
  ( -- * Creating a Request
    DeleteClusterSecurityGroup (..),
    newDeleteClusterSecurityGroup,

    -- * Request Lenses
    deleteClusterSecurityGroup_clusterSecurityGroupName,

    -- * Destructuring the Response
    DeleteClusterSecurityGroupResponse (..),
    newDeleteClusterSecurityGroupResponse,
  )
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.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newDeleteClusterSecurityGroup' smart constructor.
data DeleteClusterSecurityGroup = DeleteClusterSecurityGroup'
  { -- | The name of the cluster security group to be deleted.
    DeleteClusterSecurityGroup -> Text
clusterSecurityGroupName :: Prelude.Text
  }
  deriving (DeleteClusterSecurityGroup -> DeleteClusterSecurityGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteClusterSecurityGroup -> DeleteClusterSecurityGroup -> Bool
$c/= :: DeleteClusterSecurityGroup -> DeleteClusterSecurityGroup -> Bool
== :: DeleteClusterSecurityGroup -> DeleteClusterSecurityGroup -> Bool
$c== :: DeleteClusterSecurityGroup -> DeleteClusterSecurityGroup -> Bool
Prelude.Eq, ReadPrec [DeleteClusterSecurityGroup]
ReadPrec DeleteClusterSecurityGroup
Int -> ReadS DeleteClusterSecurityGroup
ReadS [DeleteClusterSecurityGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteClusterSecurityGroup]
$creadListPrec :: ReadPrec [DeleteClusterSecurityGroup]
readPrec :: ReadPrec DeleteClusterSecurityGroup
$creadPrec :: ReadPrec DeleteClusterSecurityGroup
readList :: ReadS [DeleteClusterSecurityGroup]
$creadList :: ReadS [DeleteClusterSecurityGroup]
readsPrec :: Int -> ReadS DeleteClusterSecurityGroup
$creadsPrec :: Int -> ReadS DeleteClusterSecurityGroup
Prelude.Read, Int -> DeleteClusterSecurityGroup -> ShowS
[DeleteClusterSecurityGroup] -> ShowS
DeleteClusterSecurityGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteClusterSecurityGroup] -> ShowS
$cshowList :: [DeleteClusterSecurityGroup] -> ShowS
show :: DeleteClusterSecurityGroup -> String
$cshow :: DeleteClusterSecurityGroup -> String
showsPrec :: Int -> DeleteClusterSecurityGroup -> ShowS
$cshowsPrec :: Int -> DeleteClusterSecurityGroup -> ShowS
Prelude.Show, forall x.
Rep DeleteClusterSecurityGroup x -> DeleteClusterSecurityGroup
forall x.
DeleteClusterSecurityGroup -> Rep DeleteClusterSecurityGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteClusterSecurityGroup x -> DeleteClusterSecurityGroup
$cfrom :: forall x.
DeleteClusterSecurityGroup -> Rep DeleteClusterSecurityGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteClusterSecurityGroup' 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:
--
-- 'clusterSecurityGroupName', 'deleteClusterSecurityGroup_clusterSecurityGroupName' - The name of the cluster security group to be deleted.
newDeleteClusterSecurityGroup ::
  -- | 'clusterSecurityGroupName'
  Prelude.Text ->
  DeleteClusterSecurityGroup
newDeleteClusterSecurityGroup :: Text -> DeleteClusterSecurityGroup
newDeleteClusterSecurityGroup
  Text
pClusterSecurityGroupName_ =
    DeleteClusterSecurityGroup'
      { $sel:clusterSecurityGroupName:DeleteClusterSecurityGroup' :: Text
clusterSecurityGroupName =
          Text
pClusterSecurityGroupName_
      }

-- | The name of the cluster security group to be deleted.
deleteClusterSecurityGroup_clusterSecurityGroupName :: Lens.Lens' DeleteClusterSecurityGroup Prelude.Text
deleteClusterSecurityGroup_clusterSecurityGroupName :: Lens' DeleteClusterSecurityGroup Text
deleteClusterSecurityGroup_clusterSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteClusterSecurityGroup' {Text
clusterSecurityGroupName :: Text
$sel:clusterSecurityGroupName:DeleteClusterSecurityGroup' :: DeleteClusterSecurityGroup -> Text
clusterSecurityGroupName} -> Text
clusterSecurityGroupName) (\s :: DeleteClusterSecurityGroup
s@DeleteClusterSecurityGroup' {} Text
a -> DeleteClusterSecurityGroup
s {$sel:clusterSecurityGroupName:DeleteClusterSecurityGroup' :: Text
clusterSecurityGroupName = Text
a} :: DeleteClusterSecurityGroup)

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

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

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

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

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

instance Data.ToQuery DeleteClusterSecurityGroup where
  toQuery :: DeleteClusterSecurityGroup -> QueryString
toQuery DeleteClusterSecurityGroup' {Text
clusterSecurityGroupName :: Text
$sel:clusterSecurityGroupName:DeleteClusterSecurityGroup' :: DeleteClusterSecurityGroup -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteClusterSecurityGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"ClusterSecurityGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterSecurityGroupName
      ]

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

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

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