{-# 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.DocumentDB.ResetDBClusterParameterGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies the parameters of a cluster parameter group to the default
-- value. To reset specific parameters, submit a list of the following:
-- @ParameterName@ and @ApplyMethod@. To reset the entire cluster parameter
-- group, specify the @DBClusterParameterGroupName@ and
-- @ResetAllParameters@ parameters.
--
-- When you reset the entire group, dynamic parameters are updated
-- immediately and static parameters are set to @pending-reboot@ to take
-- effect on the next DB instance reboot.
module Amazonka.DocumentDB.ResetDBClusterParameterGroup
  ( -- * Creating a Request
    ResetDBClusterParameterGroup (..),
    newResetDBClusterParameterGroup,

    -- * Request Lenses
    resetDBClusterParameterGroup_parameters,
    resetDBClusterParameterGroup_resetAllParameters,
    resetDBClusterParameterGroup_dbClusterParameterGroupName,

    -- * Destructuring the Response
    DBClusterParameterGroupNameMessage (..),
    newDBClusterParameterGroupNameMessage,

    -- * Response Lenses
    dbClusterParameterGroupNameMessage_dbClusterParameterGroupName,
  )
where

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

-- | Represents the input to ResetDBClusterParameterGroup.
--
-- /See:/ 'newResetDBClusterParameterGroup' smart constructor.
data ResetDBClusterParameterGroup = ResetDBClusterParameterGroup'
  { -- | A list of parameter names in the cluster parameter group to reset to the
    -- default values. You can\'t use this parameter if the
    -- @ResetAllParameters@ parameter is set to @true@.
    ResetDBClusterParameterGroup -> Maybe [Parameter]
parameters :: Prelude.Maybe [Parameter],
    -- | A value that is set to @true@ to reset all parameters in the cluster
    -- parameter group to their default values, and @false@ otherwise. You
    -- can\'t use this parameter if there is a list of parameter names
    -- specified for the @Parameters@ parameter.
    ResetDBClusterParameterGroup -> Maybe Bool
resetAllParameters :: Prelude.Maybe Prelude.Bool,
    -- | The name of the cluster parameter group to reset.
    ResetDBClusterParameterGroup -> Text
dbClusterParameterGroupName :: Prelude.Text
  }
  deriving (ResetDBClusterParameterGroup
-> ResetDBClusterParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetDBClusterParameterGroup
-> ResetDBClusterParameterGroup -> Bool
$c/= :: ResetDBClusterParameterGroup
-> ResetDBClusterParameterGroup -> Bool
== :: ResetDBClusterParameterGroup
-> ResetDBClusterParameterGroup -> Bool
$c== :: ResetDBClusterParameterGroup
-> ResetDBClusterParameterGroup -> Bool
Prelude.Eq, ReadPrec [ResetDBClusterParameterGroup]
ReadPrec ResetDBClusterParameterGroup
Int -> ReadS ResetDBClusterParameterGroup
ReadS [ResetDBClusterParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetDBClusterParameterGroup]
$creadListPrec :: ReadPrec [ResetDBClusterParameterGroup]
readPrec :: ReadPrec ResetDBClusterParameterGroup
$creadPrec :: ReadPrec ResetDBClusterParameterGroup
readList :: ReadS [ResetDBClusterParameterGroup]
$creadList :: ReadS [ResetDBClusterParameterGroup]
readsPrec :: Int -> ReadS ResetDBClusterParameterGroup
$creadsPrec :: Int -> ReadS ResetDBClusterParameterGroup
Prelude.Read, Int -> ResetDBClusterParameterGroup -> ShowS
[ResetDBClusterParameterGroup] -> ShowS
ResetDBClusterParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetDBClusterParameterGroup] -> ShowS
$cshowList :: [ResetDBClusterParameterGroup] -> ShowS
show :: ResetDBClusterParameterGroup -> String
$cshow :: ResetDBClusterParameterGroup -> String
showsPrec :: Int -> ResetDBClusterParameterGroup -> ShowS
$cshowsPrec :: Int -> ResetDBClusterParameterGroup -> ShowS
Prelude.Show, forall x.
Rep ResetDBClusterParameterGroup x -> ResetDBClusterParameterGroup
forall x.
ResetDBClusterParameterGroup -> Rep ResetDBClusterParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResetDBClusterParameterGroup x -> ResetDBClusterParameterGroup
$cfrom :: forall x.
ResetDBClusterParameterGroup -> Rep ResetDBClusterParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'ResetDBClusterParameterGroup' 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:
--
-- 'parameters', 'resetDBClusterParameterGroup_parameters' - A list of parameter names in the cluster parameter group to reset to the
-- default values. You can\'t use this parameter if the
-- @ResetAllParameters@ parameter is set to @true@.
--
-- 'resetAllParameters', 'resetDBClusterParameterGroup_resetAllParameters' - A value that is set to @true@ to reset all parameters in the cluster
-- parameter group to their default values, and @false@ otherwise. You
-- can\'t use this parameter if there is a list of parameter names
-- specified for the @Parameters@ parameter.
--
-- 'dbClusterParameterGroupName', 'resetDBClusterParameterGroup_dbClusterParameterGroupName' - The name of the cluster parameter group to reset.
newResetDBClusterParameterGroup ::
  -- | 'dbClusterParameterGroupName'
  Prelude.Text ->
  ResetDBClusterParameterGroup
newResetDBClusterParameterGroup :: Text -> ResetDBClusterParameterGroup
newResetDBClusterParameterGroup
  Text
pDBClusterParameterGroupName_ =
    ResetDBClusterParameterGroup'
      { $sel:parameters:ResetDBClusterParameterGroup' :: Maybe [Parameter]
parameters =
          forall a. Maybe a
Prelude.Nothing,
        $sel:resetAllParameters:ResetDBClusterParameterGroup' :: Maybe Bool
resetAllParameters = forall a. Maybe a
Prelude.Nothing,
        $sel:dbClusterParameterGroupName:ResetDBClusterParameterGroup' :: Text
dbClusterParameterGroupName =
          Text
pDBClusterParameterGroupName_
      }

-- | A list of parameter names in the cluster parameter group to reset to the
-- default values. You can\'t use this parameter if the
-- @ResetAllParameters@ parameter is set to @true@.
resetDBClusterParameterGroup_parameters :: Lens.Lens' ResetDBClusterParameterGroup (Prelude.Maybe [Parameter])
resetDBClusterParameterGroup_parameters :: Lens' ResetDBClusterParameterGroup (Maybe [Parameter])
resetDBClusterParameterGroup_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetDBClusterParameterGroup' {Maybe [Parameter]
parameters :: Maybe [Parameter]
$sel:parameters:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Maybe [Parameter]
parameters} -> Maybe [Parameter]
parameters) (\s :: ResetDBClusterParameterGroup
s@ResetDBClusterParameterGroup' {} Maybe [Parameter]
a -> ResetDBClusterParameterGroup
s {$sel:parameters:ResetDBClusterParameterGroup' :: Maybe [Parameter]
parameters = Maybe [Parameter]
a} :: ResetDBClusterParameterGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A value that is set to @true@ to reset all parameters in the cluster
-- parameter group to their default values, and @false@ otherwise. You
-- can\'t use this parameter if there is a list of parameter names
-- specified for the @Parameters@ parameter.
resetDBClusterParameterGroup_resetAllParameters :: Lens.Lens' ResetDBClusterParameterGroup (Prelude.Maybe Prelude.Bool)
resetDBClusterParameterGroup_resetAllParameters :: Lens' ResetDBClusterParameterGroup (Maybe Bool)
resetDBClusterParameterGroup_resetAllParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetDBClusterParameterGroup' {Maybe Bool
resetAllParameters :: Maybe Bool
$sel:resetAllParameters:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Maybe Bool
resetAllParameters} -> Maybe Bool
resetAllParameters) (\s :: ResetDBClusterParameterGroup
s@ResetDBClusterParameterGroup' {} Maybe Bool
a -> ResetDBClusterParameterGroup
s {$sel:resetAllParameters:ResetDBClusterParameterGroup' :: Maybe Bool
resetAllParameters = Maybe Bool
a} :: ResetDBClusterParameterGroup)

-- | The name of the cluster parameter group to reset.
resetDBClusterParameterGroup_dbClusterParameterGroupName :: Lens.Lens' ResetDBClusterParameterGroup Prelude.Text
resetDBClusterParameterGroup_dbClusterParameterGroupName :: Lens' ResetDBClusterParameterGroup Text
resetDBClusterParameterGroup_dbClusterParameterGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetDBClusterParameterGroup' {Text
dbClusterParameterGroupName :: Text
$sel:dbClusterParameterGroupName:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Text
dbClusterParameterGroupName} -> Text
dbClusterParameterGroupName) (\s :: ResetDBClusterParameterGroup
s@ResetDBClusterParameterGroup' {} Text
a -> ResetDBClusterParameterGroup
s {$sel:dbClusterParameterGroupName:ResetDBClusterParameterGroup' :: Text
dbClusterParameterGroupName = Text
a} :: ResetDBClusterParameterGroup)

instance Core.AWSRequest ResetDBClusterParameterGroup where
  type
    AWSResponse ResetDBClusterParameterGroup =
      DBClusterParameterGroupNameMessage
  request :: (Service -> Service)
-> ResetDBClusterParameterGroup
-> Request ResetDBClusterParameterGroup
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 ResetDBClusterParameterGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ResetDBClusterParameterGroup)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ResetDBClusterParameterGroupResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance
  Prelude.Hashable
    ResetDBClusterParameterGroup
  where
  hashWithSalt :: Int -> ResetDBClusterParameterGroup -> Int
hashWithSalt Int
_salt ResetDBClusterParameterGroup' {Maybe Bool
Maybe [Parameter]
Text
dbClusterParameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameters :: Maybe [Parameter]
$sel:dbClusterParameterGroupName:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Text
$sel:resetAllParameters:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Maybe Bool
$sel:parameters:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Maybe [Parameter]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Parameter]
parameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
resetAllParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbClusterParameterGroupName

instance Prelude.NFData ResetDBClusterParameterGroup where
  rnf :: ResetDBClusterParameterGroup -> ()
rnf ResetDBClusterParameterGroup' {Maybe Bool
Maybe [Parameter]
Text
dbClusterParameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameters :: Maybe [Parameter]
$sel:dbClusterParameterGroupName:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Text
$sel:resetAllParameters:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Maybe Bool
$sel:parameters:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Maybe [Parameter]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Parameter]
parameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
resetAllParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbClusterParameterGroupName

instance Data.ToHeaders ResetDBClusterParameterGroup where
  toHeaders :: ResetDBClusterParameterGroup -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ResetDBClusterParameterGroup where
  toQuery :: ResetDBClusterParameterGroup -> QueryString
toQuery ResetDBClusterParameterGroup' {Maybe Bool
Maybe [Parameter]
Text
dbClusterParameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameters :: Maybe [Parameter]
$sel:dbClusterParameterGroupName:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Text
$sel:resetAllParameters:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Maybe Bool
$sel:parameters:ResetDBClusterParameterGroup' :: ResetDBClusterParameterGroup -> Maybe [Parameter]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"ResetDBClusterParameterGroup" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Parameters"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Parameter"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Parameter]
parameters
            ),
        ByteString
"ResetAllParameters" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
resetAllParameters,
        ByteString
"DBClusterParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbClusterParameterGroupName
      ]