{-# 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.ElastiCache.ResetCacheParameterGroup
-- 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 cache parameter group to the engine or
-- system default value. You can reset specific parameters by submitting a
-- list of parameter names. To reset the entire cache parameter group,
-- specify the @ResetAllParameters@ and @CacheParameterGroupName@
-- parameters.
module Amazonka.ElastiCache.ResetCacheParameterGroup
  ( -- * Creating a Request
    ResetCacheParameterGroup (..),
    newResetCacheParameterGroup,

    -- * Request Lenses
    resetCacheParameterGroup_parameterNameValues,
    resetCacheParameterGroup_resetAllParameters,
    resetCacheParameterGroup_cacheParameterGroupName,

    -- * Destructuring the Response
    CacheParameterGroupNameMessage (..),
    newCacheParameterGroupNameMessage,

    -- * Response Lenses
    cacheParameterGroupNameMessage_cacheParameterGroupName,
  )
where

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

-- | Represents the input of a @ResetCacheParameterGroup@ operation.
--
-- /See:/ 'newResetCacheParameterGroup' smart constructor.
data ResetCacheParameterGroup = ResetCacheParameterGroup'
  { -- | An array of parameter names to reset to their default values. If
    -- @ResetAllParameters@ is @true@, do not use @ParameterNameValues@. If
    -- @ResetAllParameters@ is @false@, you must specify the name of at least
    -- one parameter to reset.
    ResetCacheParameterGroup -> Maybe [ParameterNameValue]
parameterNameValues :: Prelude.Maybe [ParameterNameValue],
    -- | If @true@, all parameters in the cache parameter group are reset to
    -- their default values. If @false@, only the parameters listed by
    -- @ParameterNameValues@ are reset to their default values.
    --
    -- Valid values: @true@ | @false@
    ResetCacheParameterGroup -> Maybe Bool
resetAllParameters :: Prelude.Maybe Prelude.Bool,
    -- | The name of the cache parameter group to reset.
    ResetCacheParameterGroup -> Text
cacheParameterGroupName :: Prelude.Text
  }
  deriving (ResetCacheParameterGroup -> ResetCacheParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetCacheParameterGroup -> ResetCacheParameterGroup -> Bool
$c/= :: ResetCacheParameterGroup -> ResetCacheParameterGroup -> Bool
== :: ResetCacheParameterGroup -> ResetCacheParameterGroup -> Bool
$c== :: ResetCacheParameterGroup -> ResetCacheParameterGroup -> Bool
Prelude.Eq, ReadPrec [ResetCacheParameterGroup]
ReadPrec ResetCacheParameterGroup
Int -> ReadS ResetCacheParameterGroup
ReadS [ResetCacheParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetCacheParameterGroup]
$creadListPrec :: ReadPrec [ResetCacheParameterGroup]
readPrec :: ReadPrec ResetCacheParameterGroup
$creadPrec :: ReadPrec ResetCacheParameterGroup
readList :: ReadS [ResetCacheParameterGroup]
$creadList :: ReadS [ResetCacheParameterGroup]
readsPrec :: Int -> ReadS ResetCacheParameterGroup
$creadsPrec :: Int -> ReadS ResetCacheParameterGroup
Prelude.Read, Int -> ResetCacheParameterGroup -> ShowS
[ResetCacheParameterGroup] -> ShowS
ResetCacheParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetCacheParameterGroup] -> ShowS
$cshowList :: [ResetCacheParameterGroup] -> ShowS
show :: ResetCacheParameterGroup -> String
$cshow :: ResetCacheParameterGroup -> String
showsPrec :: Int -> ResetCacheParameterGroup -> ShowS
$cshowsPrec :: Int -> ResetCacheParameterGroup -> ShowS
Prelude.Show, forall x.
Rep ResetCacheParameterGroup x -> ResetCacheParameterGroup
forall x.
ResetCacheParameterGroup -> Rep ResetCacheParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResetCacheParameterGroup x -> ResetCacheParameterGroup
$cfrom :: forall x.
ResetCacheParameterGroup -> Rep ResetCacheParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'ResetCacheParameterGroup' 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:
--
-- 'parameterNameValues', 'resetCacheParameterGroup_parameterNameValues' - An array of parameter names to reset to their default values. If
-- @ResetAllParameters@ is @true@, do not use @ParameterNameValues@. If
-- @ResetAllParameters@ is @false@, you must specify the name of at least
-- one parameter to reset.
--
-- 'resetAllParameters', 'resetCacheParameterGroup_resetAllParameters' - If @true@, all parameters in the cache parameter group are reset to
-- their default values. If @false@, only the parameters listed by
-- @ParameterNameValues@ are reset to their default values.
--
-- Valid values: @true@ | @false@
--
-- 'cacheParameterGroupName', 'resetCacheParameterGroup_cacheParameterGroupName' - The name of the cache parameter group to reset.
newResetCacheParameterGroup ::
  -- | 'cacheParameterGroupName'
  Prelude.Text ->
  ResetCacheParameterGroup
newResetCacheParameterGroup :: Text -> ResetCacheParameterGroup
newResetCacheParameterGroup Text
pCacheParameterGroupName_ =
  ResetCacheParameterGroup'
    { $sel:parameterNameValues:ResetCacheParameterGroup' :: Maybe [ParameterNameValue]
parameterNameValues =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resetAllParameters:ResetCacheParameterGroup' :: Maybe Bool
resetAllParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:cacheParameterGroupName:ResetCacheParameterGroup' :: Text
cacheParameterGroupName =
        Text
pCacheParameterGroupName_
    }

-- | An array of parameter names to reset to their default values. If
-- @ResetAllParameters@ is @true@, do not use @ParameterNameValues@. If
-- @ResetAllParameters@ is @false@, you must specify the name of at least
-- one parameter to reset.
resetCacheParameterGroup_parameterNameValues :: Lens.Lens' ResetCacheParameterGroup (Prelude.Maybe [ParameterNameValue])
resetCacheParameterGroup_parameterNameValues :: Lens' ResetCacheParameterGroup (Maybe [ParameterNameValue])
resetCacheParameterGroup_parameterNameValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetCacheParameterGroup' {Maybe [ParameterNameValue]
parameterNameValues :: Maybe [ParameterNameValue]
$sel:parameterNameValues:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Maybe [ParameterNameValue]
parameterNameValues} -> Maybe [ParameterNameValue]
parameterNameValues) (\s :: ResetCacheParameterGroup
s@ResetCacheParameterGroup' {} Maybe [ParameterNameValue]
a -> ResetCacheParameterGroup
s {$sel:parameterNameValues:ResetCacheParameterGroup' :: Maybe [ParameterNameValue]
parameterNameValues = Maybe [ParameterNameValue]
a} :: ResetCacheParameterGroup) 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

-- | If @true@, all parameters in the cache parameter group are reset to
-- their default values. If @false@, only the parameters listed by
-- @ParameterNameValues@ are reset to their default values.
--
-- Valid values: @true@ | @false@
resetCacheParameterGroup_resetAllParameters :: Lens.Lens' ResetCacheParameterGroup (Prelude.Maybe Prelude.Bool)
resetCacheParameterGroup_resetAllParameters :: Lens' ResetCacheParameterGroup (Maybe Bool)
resetCacheParameterGroup_resetAllParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetCacheParameterGroup' {Maybe Bool
resetAllParameters :: Maybe Bool
$sel:resetAllParameters:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Maybe Bool
resetAllParameters} -> Maybe Bool
resetAllParameters) (\s :: ResetCacheParameterGroup
s@ResetCacheParameterGroup' {} Maybe Bool
a -> ResetCacheParameterGroup
s {$sel:resetAllParameters:ResetCacheParameterGroup' :: Maybe Bool
resetAllParameters = Maybe Bool
a} :: ResetCacheParameterGroup)

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

instance Core.AWSRequest ResetCacheParameterGroup where
  type
    AWSResponse ResetCacheParameterGroup =
      CacheParameterGroupNameMessage
  request :: (Service -> Service)
-> ResetCacheParameterGroup -> Request ResetCacheParameterGroup
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 ResetCacheParameterGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ResetCacheParameterGroup)))
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
"ResetCacheParameterGroupResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable ResetCacheParameterGroup where
  hashWithSalt :: Int -> ResetCacheParameterGroup -> Int
hashWithSalt Int
_salt ResetCacheParameterGroup' {Maybe Bool
Maybe [ParameterNameValue]
Text
cacheParameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameterNameValues :: Maybe [ParameterNameValue]
$sel:cacheParameterGroupName:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Text
$sel:resetAllParameters:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Maybe Bool
$sel:parameterNameValues:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Maybe [ParameterNameValue]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ParameterNameValue]
parameterNameValues
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
resetAllParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
cacheParameterGroupName

instance Prelude.NFData ResetCacheParameterGroup where
  rnf :: ResetCacheParameterGroup -> ()
rnf ResetCacheParameterGroup' {Maybe Bool
Maybe [ParameterNameValue]
Text
cacheParameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameterNameValues :: Maybe [ParameterNameValue]
$sel:cacheParameterGroupName:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Text
$sel:resetAllParameters:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Maybe Bool
$sel:parameterNameValues:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Maybe [ParameterNameValue]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ParameterNameValue]
parameterNameValues
      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
cacheParameterGroupName

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

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

instance Data.ToQuery ResetCacheParameterGroup where
  toQuery :: ResetCacheParameterGroup -> QueryString
toQuery ResetCacheParameterGroup' {Maybe Bool
Maybe [ParameterNameValue]
Text
cacheParameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameterNameValues :: Maybe [ParameterNameValue]
$sel:cacheParameterGroupName:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Text
$sel:resetAllParameters:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Maybe Bool
$sel:parameterNameValues:ResetCacheParameterGroup' :: ResetCacheParameterGroup -> Maybe [ParameterNameValue]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ResetCacheParameterGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"ParameterNameValues"
          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
"ParameterNameValue"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [ParameterNameValue]
parameterNameValues
            ),
        ByteString
"ResetAllParameters" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
resetAllParameters,
        ByteString
"CacheParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cacheParameterGroupName
      ]