{-# 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.MemoryDb.DeleteParameterGroup
-- 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 parameter group. You cannot delete a parameter
-- group if it is associated with any clusters. You cannot delete the
-- default parameter groups in your account.
module Amazonka.MemoryDb.DeleteParameterGroup
  ( -- * Creating a Request
    DeleteParameterGroup (..),
    newDeleteParameterGroup,

    -- * Request Lenses
    deleteParameterGroup_parameterGroupName,

    -- * Destructuring the Response
    DeleteParameterGroupResponse (..),
    newDeleteParameterGroupResponse,

    -- * Response Lenses
    deleteParameterGroupResponse_parameterGroup,
    deleteParameterGroupResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'DeleteParameterGroup' 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:
--
-- 'parameterGroupName', 'deleteParameterGroup_parameterGroupName' - The name of the parameter group to delete.
newDeleteParameterGroup ::
  -- | 'parameterGroupName'
  Prelude.Text ->
  DeleteParameterGroup
newDeleteParameterGroup :: Text -> DeleteParameterGroup
newDeleteParameterGroup Text
pParameterGroupName_ =
  DeleteParameterGroup'
    { $sel:parameterGroupName:DeleteParameterGroup' :: Text
parameterGroupName =
        Text
pParameterGroupName_
    }

-- | The name of the parameter group to delete.
deleteParameterGroup_parameterGroupName :: Lens.Lens' DeleteParameterGroup Prelude.Text
deleteParameterGroup_parameterGroupName :: Lens' DeleteParameterGroup Text
deleteParameterGroup_parameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteParameterGroup' {Text
parameterGroupName :: Text
$sel:parameterGroupName:DeleteParameterGroup' :: DeleteParameterGroup -> Text
parameterGroupName} -> Text
parameterGroupName) (\s :: DeleteParameterGroup
s@DeleteParameterGroup' {} Text
a -> DeleteParameterGroup
s {$sel:parameterGroupName:DeleteParameterGroup' :: Text
parameterGroupName = Text
a} :: DeleteParameterGroup)

instance Core.AWSRequest DeleteParameterGroup where
  type
    AWSResponse DeleteParameterGroup =
      DeleteParameterGroupResponse
  request :: (Service -> Service)
-> DeleteParameterGroup -> Request DeleteParameterGroup
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteParameterGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteParameterGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe ParameterGroup -> Int -> DeleteParameterGroupResponse
DeleteParameterGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ParameterGroup")
            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 DeleteParameterGroup where
  hashWithSalt :: Int -> DeleteParameterGroup -> Int
hashWithSalt Int
_salt DeleteParameterGroup' {Text
parameterGroupName :: Text
$sel:parameterGroupName:DeleteParameterGroup' :: DeleteParameterGroup -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
parameterGroupName

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

instance Data.ToHeaders DeleteParameterGroup where
  toHeaders :: DeleteParameterGroup -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AmazonMemoryDB.DeleteParameterGroup" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteParameterGroup where
  toJSON :: DeleteParameterGroup -> Value
toJSON DeleteParameterGroup' {Text
parameterGroupName :: Text
$sel:parameterGroupName:DeleteParameterGroup' :: DeleteParameterGroup -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ParameterGroupName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
parameterGroupName)
          ]
      )

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

instance Data.ToQuery DeleteParameterGroup where
  toQuery :: DeleteParameterGroup -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDeleteParameterGroupResponse' smart constructor.
data DeleteParameterGroupResponse = DeleteParameterGroupResponse'
  { -- | The parameter group that has been deleted.
    DeleteParameterGroupResponse -> Maybe ParameterGroup
parameterGroup :: Prelude.Maybe ParameterGroup,
    -- | The response's http status code.
    DeleteParameterGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteParameterGroupResponse
-> DeleteParameterGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteParameterGroupResponse
-> DeleteParameterGroupResponse -> Bool
$c/= :: DeleteParameterGroupResponse
-> DeleteParameterGroupResponse -> Bool
== :: DeleteParameterGroupResponse
-> DeleteParameterGroupResponse -> Bool
$c== :: DeleteParameterGroupResponse
-> DeleteParameterGroupResponse -> Bool
Prelude.Eq, ReadPrec [DeleteParameterGroupResponse]
ReadPrec DeleteParameterGroupResponse
Int -> ReadS DeleteParameterGroupResponse
ReadS [DeleteParameterGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteParameterGroupResponse]
$creadListPrec :: ReadPrec [DeleteParameterGroupResponse]
readPrec :: ReadPrec DeleteParameterGroupResponse
$creadPrec :: ReadPrec DeleteParameterGroupResponse
readList :: ReadS [DeleteParameterGroupResponse]
$creadList :: ReadS [DeleteParameterGroupResponse]
readsPrec :: Int -> ReadS DeleteParameterGroupResponse
$creadsPrec :: Int -> ReadS DeleteParameterGroupResponse
Prelude.Read, Int -> DeleteParameterGroupResponse -> ShowS
[DeleteParameterGroupResponse] -> ShowS
DeleteParameterGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteParameterGroupResponse] -> ShowS
$cshowList :: [DeleteParameterGroupResponse] -> ShowS
show :: DeleteParameterGroupResponse -> String
$cshow :: DeleteParameterGroupResponse -> String
showsPrec :: Int -> DeleteParameterGroupResponse -> ShowS
$cshowsPrec :: Int -> DeleteParameterGroupResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteParameterGroupResponse x -> DeleteParameterGroupResponse
forall x.
DeleteParameterGroupResponse -> Rep DeleteParameterGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteParameterGroupResponse x -> DeleteParameterGroupResponse
$cfrom :: forall x.
DeleteParameterGroupResponse -> Rep DeleteParameterGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteParameterGroupResponse' 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:
--
-- 'parameterGroup', 'deleteParameterGroupResponse_parameterGroup' - The parameter group that has been deleted.
--
-- 'httpStatus', 'deleteParameterGroupResponse_httpStatus' - The response's http status code.
newDeleteParameterGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteParameterGroupResponse
newDeleteParameterGroupResponse :: Int -> DeleteParameterGroupResponse
newDeleteParameterGroupResponse Int
pHttpStatus_ =
  DeleteParameterGroupResponse'
    { $sel:parameterGroup:DeleteParameterGroupResponse' :: Maybe ParameterGroup
parameterGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteParameterGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The parameter group that has been deleted.
deleteParameterGroupResponse_parameterGroup :: Lens.Lens' DeleteParameterGroupResponse (Prelude.Maybe ParameterGroup)
deleteParameterGroupResponse_parameterGroup :: Lens' DeleteParameterGroupResponse (Maybe ParameterGroup)
deleteParameterGroupResponse_parameterGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteParameterGroupResponse' {Maybe ParameterGroup
parameterGroup :: Maybe ParameterGroup
$sel:parameterGroup:DeleteParameterGroupResponse' :: DeleteParameterGroupResponse -> Maybe ParameterGroup
parameterGroup} -> Maybe ParameterGroup
parameterGroup) (\s :: DeleteParameterGroupResponse
s@DeleteParameterGroupResponse' {} Maybe ParameterGroup
a -> DeleteParameterGroupResponse
s {$sel:parameterGroup:DeleteParameterGroupResponse' :: Maybe ParameterGroup
parameterGroup = Maybe ParameterGroup
a} :: DeleteParameterGroupResponse)

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

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