{-# 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.UpdateParameterGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the parameters of a parameter group. You can modify up to 20
-- parameters in a single request by submitting a list parameter name and
-- value pairs.
module Amazonka.MemoryDb.UpdateParameterGroup
  ( -- * Creating a Request
    UpdateParameterGroup (..),
    newUpdateParameterGroup,

    -- * Request Lenses
    updateParameterGroup_parameterGroupName,
    updateParameterGroup_parameterNameValues,

    -- * Destructuring the Response
    UpdateParameterGroupResponse (..),
    newUpdateParameterGroupResponse,

    -- * Response Lenses
    updateParameterGroupResponse_parameterGroup,
    updateParameterGroupResponse_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:/ 'newUpdateParameterGroup' smart constructor.
data UpdateParameterGroup = UpdateParameterGroup'
  { -- | The name of the parameter group to update.
    UpdateParameterGroup -> Text
parameterGroupName :: 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 updated per request.
    UpdateParameterGroup -> [ParameterNameValue]
parameterNameValues :: [ParameterNameValue]
  }
  deriving (UpdateParameterGroup -> UpdateParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateParameterGroup -> UpdateParameterGroup -> Bool
$c/= :: UpdateParameterGroup -> UpdateParameterGroup -> Bool
== :: UpdateParameterGroup -> UpdateParameterGroup -> Bool
$c== :: UpdateParameterGroup -> UpdateParameterGroup -> Bool
Prelude.Eq, ReadPrec [UpdateParameterGroup]
ReadPrec UpdateParameterGroup
Int -> ReadS UpdateParameterGroup
ReadS [UpdateParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateParameterGroup]
$creadListPrec :: ReadPrec [UpdateParameterGroup]
readPrec :: ReadPrec UpdateParameterGroup
$creadPrec :: ReadPrec UpdateParameterGroup
readList :: ReadS [UpdateParameterGroup]
$creadList :: ReadS [UpdateParameterGroup]
readsPrec :: Int -> ReadS UpdateParameterGroup
$creadsPrec :: Int -> ReadS UpdateParameterGroup
Prelude.Read, Int -> UpdateParameterGroup -> ShowS
[UpdateParameterGroup] -> ShowS
UpdateParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateParameterGroup] -> ShowS
$cshowList :: [UpdateParameterGroup] -> ShowS
show :: UpdateParameterGroup -> String
$cshow :: UpdateParameterGroup -> String
showsPrec :: Int -> UpdateParameterGroup -> ShowS
$cshowsPrec :: Int -> UpdateParameterGroup -> ShowS
Prelude.Show, forall x. Rep UpdateParameterGroup x -> UpdateParameterGroup
forall x. UpdateParameterGroup -> Rep UpdateParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateParameterGroup x -> UpdateParameterGroup
$cfrom :: forall x. UpdateParameterGroup -> Rep UpdateParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'UpdateParameterGroup' 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', 'updateParameterGroup_parameterGroupName' - The name of the parameter group to update.
--
-- 'parameterNameValues', 'updateParameterGroup_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 updated per request.
newUpdateParameterGroup ::
  -- | 'parameterGroupName'
  Prelude.Text ->
  UpdateParameterGroup
newUpdateParameterGroup :: Text -> UpdateParameterGroup
newUpdateParameterGroup Text
pParameterGroupName_ =
  UpdateParameterGroup'
    { $sel:parameterGroupName:UpdateParameterGroup' :: Text
parameterGroupName =
        Text
pParameterGroupName_,
      $sel:parameterNameValues:UpdateParameterGroup' :: [ParameterNameValue]
parameterNameValues = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | 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 updated per request.
updateParameterGroup_parameterNameValues :: Lens.Lens' UpdateParameterGroup [ParameterNameValue]
updateParameterGroup_parameterNameValues :: Lens' UpdateParameterGroup [ParameterNameValue]
updateParameterGroup_parameterNameValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateParameterGroup' {[ParameterNameValue]
parameterNameValues :: [ParameterNameValue]
$sel:parameterNameValues:UpdateParameterGroup' :: UpdateParameterGroup -> [ParameterNameValue]
parameterNameValues} -> [ParameterNameValue]
parameterNameValues) (\s :: UpdateParameterGroup
s@UpdateParameterGroup' {} [ParameterNameValue]
a -> UpdateParameterGroup
s {$sel:parameterNameValues:UpdateParameterGroup' :: [ParameterNameValue]
parameterNameValues = [ParameterNameValue]
a} :: UpdateParameterGroup) 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 UpdateParameterGroup where
  type
    AWSResponse UpdateParameterGroup =
      UpdateParameterGroupResponse
  request :: (Service -> Service)
-> UpdateParameterGroup -> Request UpdateParameterGroup
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 UpdateParameterGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateParameterGroup)))
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 -> UpdateParameterGroupResponse
UpdateParameterGroupResponse'
            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 UpdateParameterGroup where
  hashWithSalt :: Int -> UpdateParameterGroup -> Int
hashWithSalt Int
_salt UpdateParameterGroup' {[ParameterNameValue]
Text
parameterNameValues :: [ParameterNameValue]
parameterGroupName :: Text
$sel:parameterNameValues:UpdateParameterGroup' :: UpdateParameterGroup -> [ParameterNameValue]
$sel:parameterGroupName:UpdateParameterGroup' :: UpdateParameterGroup -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
parameterGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [ParameterNameValue]
parameterNameValues

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

instance Data.ToHeaders UpdateParameterGroup where
  toHeaders :: UpdateParameterGroup -> 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.UpdateParameterGroup" ::
                          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 UpdateParameterGroup where
  toJSON :: UpdateParameterGroup -> Value
toJSON UpdateParameterGroup' {[ParameterNameValue]
Text
parameterNameValues :: [ParameterNameValue]
parameterGroupName :: Text
$sel:parameterNameValues:UpdateParameterGroup' :: UpdateParameterGroup -> [ParameterNameValue]
$sel:parameterGroupName:UpdateParameterGroup' :: UpdateParameterGroup -> 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),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ParameterNameValues" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [ParameterNameValue]
parameterNameValues)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateParameterGroupResponse' 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', 'updateParameterGroupResponse_parameterGroup' - The updated parameter group
--
-- 'httpStatus', 'updateParameterGroupResponse_httpStatus' - The response's http status code.
newUpdateParameterGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateParameterGroupResponse
newUpdateParameterGroupResponse :: Int -> UpdateParameterGroupResponse
newUpdateParameterGroupResponse Int
pHttpStatus_ =
  UpdateParameterGroupResponse'
    { $sel:parameterGroup:UpdateParameterGroupResponse' :: Maybe ParameterGroup
parameterGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateParameterGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The updated parameter group
updateParameterGroupResponse_parameterGroup :: Lens.Lens' UpdateParameterGroupResponse (Prelude.Maybe ParameterGroup)
updateParameterGroupResponse_parameterGroup :: Lens' UpdateParameterGroupResponse (Maybe ParameterGroup)
updateParameterGroupResponse_parameterGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateParameterGroupResponse' {Maybe ParameterGroup
parameterGroup :: Maybe ParameterGroup
$sel:parameterGroup:UpdateParameterGroupResponse' :: UpdateParameterGroupResponse -> Maybe ParameterGroup
parameterGroup} -> Maybe ParameterGroup
parameterGroup) (\s :: UpdateParameterGroupResponse
s@UpdateParameterGroupResponse' {} Maybe ParameterGroup
a -> UpdateParameterGroupResponse
s {$sel:parameterGroup:UpdateParameterGroupResponse' :: Maybe ParameterGroup
parameterGroup = Maybe ParameterGroup
a} :: UpdateParameterGroupResponse)

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

instance Prelude.NFData UpdateParameterGroupResponse where
  rnf :: UpdateParameterGroupResponse -> ()
rnf UpdateParameterGroupResponse' {Int
Maybe ParameterGroup
httpStatus :: Int
parameterGroup :: Maybe ParameterGroup
$sel:httpStatus:UpdateParameterGroupResponse' :: UpdateParameterGroupResponse -> Int
$sel:parameterGroup:UpdateParameterGroupResponse' :: UpdateParameterGroupResponse -> 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