{-# 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.ModifyCacheParameterGroup
-- 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. You can modify up to
-- 20 parameters in a single request by submitting a list parameter name
-- and value pairs.
module Amazonka.ElastiCache.ModifyCacheParameterGroup
  ( -- * Creating a Request
    ModifyCacheParameterGroup (..),
    newModifyCacheParameterGroup,

    -- * Request Lenses
    modifyCacheParameterGroup_cacheParameterGroupName,
    modifyCacheParameterGroup_parameterNameValues,

    -- * 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 @ModifyCacheParameterGroup@ operation.
--
-- /See:/ 'newModifyCacheParameterGroup' smart constructor.
data ModifyCacheParameterGroup = ModifyCacheParameterGroup'
  { -- | The name of the cache parameter group to modify.
    ModifyCacheParameterGroup -> Text
cacheParameterGroupName :: Prelude.Text,
    -- | An array of parameter names and values for the parameter update. You
    -- must supply at least one parameter name and value; subsequent arguments
    -- are optional. A maximum of 20 parameters may be modified per request.
    ModifyCacheParameterGroup -> [ParameterNameValue]
parameterNameValues :: [ParameterNameValue]
  }
  deriving (ModifyCacheParameterGroup -> ModifyCacheParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifyCacheParameterGroup -> ModifyCacheParameterGroup -> Bool
$c/= :: ModifyCacheParameterGroup -> ModifyCacheParameterGroup -> Bool
== :: ModifyCacheParameterGroup -> ModifyCacheParameterGroup -> Bool
$c== :: ModifyCacheParameterGroup -> ModifyCacheParameterGroup -> Bool
Prelude.Eq, ReadPrec [ModifyCacheParameterGroup]
ReadPrec ModifyCacheParameterGroup
Int -> ReadS ModifyCacheParameterGroup
ReadS [ModifyCacheParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifyCacheParameterGroup]
$creadListPrec :: ReadPrec [ModifyCacheParameterGroup]
readPrec :: ReadPrec ModifyCacheParameterGroup
$creadPrec :: ReadPrec ModifyCacheParameterGroup
readList :: ReadS [ModifyCacheParameterGroup]
$creadList :: ReadS [ModifyCacheParameterGroup]
readsPrec :: Int -> ReadS ModifyCacheParameterGroup
$creadsPrec :: Int -> ReadS ModifyCacheParameterGroup
Prelude.Read, Int -> ModifyCacheParameterGroup -> ShowS
[ModifyCacheParameterGroup] -> ShowS
ModifyCacheParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifyCacheParameterGroup] -> ShowS
$cshowList :: [ModifyCacheParameterGroup] -> ShowS
show :: ModifyCacheParameterGroup -> String
$cshow :: ModifyCacheParameterGroup -> String
showsPrec :: Int -> ModifyCacheParameterGroup -> ShowS
$cshowsPrec :: Int -> ModifyCacheParameterGroup -> ShowS
Prelude.Show, forall x.
Rep ModifyCacheParameterGroup x -> ModifyCacheParameterGroup
forall x.
ModifyCacheParameterGroup -> Rep ModifyCacheParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifyCacheParameterGroup x -> ModifyCacheParameterGroup
$cfrom :: forall x.
ModifyCacheParameterGroup -> Rep ModifyCacheParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'ModifyCacheParameterGroup' 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:
--
-- 'cacheParameterGroupName', 'modifyCacheParameterGroup_cacheParameterGroupName' - The name of the cache parameter group to modify.
--
-- 'parameterNameValues', 'modifyCacheParameterGroup_parameterNameValues' - An array of parameter names and values for the parameter update. You
-- must supply at least one parameter name and value; subsequent arguments
-- are optional. A maximum of 20 parameters may be modified per request.
newModifyCacheParameterGroup ::
  -- | 'cacheParameterGroupName'
  Prelude.Text ->
  ModifyCacheParameterGroup
newModifyCacheParameterGroup :: Text -> ModifyCacheParameterGroup
newModifyCacheParameterGroup
  Text
pCacheParameterGroupName_ =
    ModifyCacheParameterGroup'
      { $sel:cacheParameterGroupName:ModifyCacheParameterGroup' :: Text
cacheParameterGroupName =
          Text
pCacheParameterGroupName_,
        $sel:parameterNameValues:ModifyCacheParameterGroup' :: [ParameterNameValue]
parameterNameValues = forall a. Monoid a => a
Prelude.mempty
      }

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

-- | An array of parameter names and values for the parameter update. You
-- must supply at least one parameter name and value; subsequent arguments
-- are optional. A maximum of 20 parameters may be modified per request.
modifyCacheParameterGroup_parameterNameValues :: Lens.Lens' ModifyCacheParameterGroup [ParameterNameValue]
modifyCacheParameterGroup_parameterNameValues :: Lens' ModifyCacheParameterGroup [ParameterNameValue]
modifyCacheParameterGroup_parameterNameValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifyCacheParameterGroup' {[ParameterNameValue]
parameterNameValues :: [ParameterNameValue]
$sel:parameterNameValues:ModifyCacheParameterGroup' :: ModifyCacheParameterGroup -> [ParameterNameValue]
parameterNameValues} -> [ParameterNameValue]
parameterNameValues) (\s :: ModifyCacheParameterGroup
s@ModifyCacheParameterGroup' {} [ParameterNameValue]
a -> ModifyCacheParameterGroup
s {$sel:parameterNameValues:ModifyCacheParameterGroup' :: [ParameterNameValue]
parameterNameValues = [ParameterNameValue]
a} :: ModifyCacheParameterGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

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

instance Prelude.NFData ModifyCacheParameterGroup where
  rnf :: ModifyCacheParameterGroup -> ()
rnf ModifyCacheParameterGroup' {[ParameterNameValue]
Text
parameterNameValues :: [ParameterNameValue]
cacheParameterGroupName :: Text
$sel:parameterNameValues:ModifyCacheParameterGroup' :: ModifyCacheParameterGroup -> [ParameterNameValue]
$sel:cacheParameterGroupName:ModifyCacheParameterGroup' :: ModifyCacheParameterGroup -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
cacheParameterGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [ParameterNameValue]
parameterNameValues

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

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

instance Data.ToQuery ModifyCacheParameterGroup where
  toQuery :: ModifyCacheParameterGroup -> QueryString
toQuery ModifyCacheParameterGroup' {[ParameterNameValue]
Text
parameterNameValues :: [ParameterNameValue]
cacheParameterGroupName :: Text
$sel:parameterNameValues:ModifyCacheParameterGroup' :: ModifyCacheParameterGroup -> [ParameterNameValue]
$sel:cacheParameterGroupName:ModifyCacheParameterGroup' :: ModifyCacheParameterGroup -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifyCacheParameterGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"CacheParameterGroupName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
cacheParameterGroupName,
        ByteString
"ParameterNameValues"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList
            ByteString
"ParameterNameValue"
            [ParameterNameValue]
parameterNameValues
      ]