{-# 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.DeleteDBParameterGroup
-- 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 specified DB parameter group. The DB parameter group to be
-- deleted can\'t be associated with any DB instances.
module Amazonka.RDS.DeleteDBParameterGroup
  ( -- * Creating a Request
    DeleteDBParameterGroup (..),
    newDeleteDBParameterGroup,

    -- * Request Lenses
    deleteDBParameterGroup_dbParameterGroupName,

    -- * Destructuring the Response
    DeleteDBParameterGroupResponse (..),
    newDeleteDBParameterGroupResponse,
  )
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:/ 'newDeleteDBParameterGroup' smart constructor.
data DeleteDBParameterGroup = DeleteDBParameterGroup'
  { -- | The name of the DB parameter group.
    --
    -- Constraints:
    --
    -- -   Must be the name of an existing DB parameter group
    --
    -- -   You can\'t delete a default DB parameter group
    --
    -- -   Can\'t be associated with any DB instances
    DeleteDBParameterGroup -> Text
dbParameterGroupName :: Prelude.Text
  }
  deriving (DeleteDBParameterGroup -> DeleteDBParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDBParameterGroup -> DeleteDBParameterGroup -> Bool
$c/= :: DeleteDBParameterGroup -> DeleteDBParameterGroup -> Bool
== :: DeleteDBParameterGroup -> DeleteDBParameterGroup -> Bool
$c== :: DeleteDBParameterGroup -> DeleteDBParameterGroup -> Bool
Prelude.Eq, ReadPrec [DeleteDBParameterGroup]
ReadPrec DeleteDBParameterGroup
Int -> ReadS DeleteDBParameterGroup
ReadS [DeleteDBParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDBParameterGroup]
$creadListPrec :: ReadPrec [DeleteDBParameterGroup]
readPrec :: ReadPrec DeleteDBParameterGroup
$creadPrec :: ReadPrec DeleteDBParameterGroup
readList :: ReadS [DeleteDBParameterGroup]
$creadList :: ReadS [DeleteDBParameterGroup]
readsPrec :: Int -> ReadS DeleteDBParameterGroup
$creadsPrec :: Int -> ReadS DeleteDBParameterGroup
Prelude.Read, Int -> DeleteDBParameterGroup -> ShowS
[DeleteDBParameterGroup] -> ShowS
DeleteDBParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDBParameterGroup] -> ShowS
$cshowList :: [DeleteDBParameterGroup] -> ShowS
show :: DeleteDBParameterGroup -> String
$cshow :: DeleteDBParameterGroup -> String
showsPrec :: Int -> DeleteDBParameterGroup -> ShowS
$cshowsPrec :: Int -> DeleteDBParameterGroup -> ShowS
Prelude.Show, forall x. Rep DeleteDBParameterGroup x -> DeleteDBParameterGroup
forall x. DeleteDBParameterGroup -> Rep DeleteDBParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteDBParameterGroup x -> DeleteDBParameterGroup
$cfrom :: forall x. DeleteDBParameterGroup -> Rep DeleteDBParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDBParameterGroup' 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:
--
-- 'dbParameterGroupName', 'deleteDBParameterGroup_dbParameterGroupName' - The name of the DB parameter group.
--
-- Constraints:
--
-- -   Must be the name of an existing DB parameter group
--
-- -   You can\'t delete a default DB parameter group
--
-- -   Can\'t be associated with any DB instances
newDeleteDBParameterGroup ::
  -- | 'dbParameterGroupName'
  Prelude.Text ->
  DeleteDBParameterGroup
newDeleteDBParameterGroup :: Text -> DeleteDBParameterGroup
newDeleteDBParameterGroup Text
pDBParameterGroupName_ =
  DeleteDBParameterGroup'
    { $sel:dbParameterGroupName:DeleteDBParameterGroup' :: Text
dbParameterGroupName =
        Text
pDBParameterGroupName_
    }

-- | The name of the DB parameter group.
--
-- Constraints:
--
-- -   Must be the name of an existing DB parameter group
--
-- -   You can\'t delete a default DB parameter group
--
-- -   Can\'t be associated with any DB instances
deleteDBParameterGroup_dbParameterGroupName :: Lens.Lens' DeleteDBParameterGroup Prelude.Text
deleteDBParameterGroup_dbParameterGroupName :: Lens' DeleteDBParameterGroup Text
deleteDBParameterGroup_dbParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDBParameterGroup' {Text
dbParameterGroupName :: Text
$sel:dbParameterGroupName:DeleteDBParameterGroup' :: DeleteDBParameterGroup -> Text
dbParameterGroupName} -> Text
dbParameterGroupName) (\s :: DeleteDBParameterGroup
s@DeleteDBParameterGroup' {} Text
a -> DeleteDBParameterGroup
s {$sel:dbParameterGroupName:DeleteDBParameterGroup' :: Text
dbParameterGroupName = Text
a} :: DeleteDBParameterGroup)

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

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

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

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

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

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

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

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

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