{-# 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.ResetParameterGroup
-- 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 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 parameter group, specify the
-- AllParameters and ParameterGroupName parameters.
module Amazonka.MemoryDb.ResetParameterGroup
  ( -- * Creating a Request
    ResetParameterGroup (..),
    newResetParameterGroup,

    -- * Request Lenses
    resetParameterGroup_allParameters,
    resetParameterGroup_parameterNames,
    resetParameterGroup_parameterGroupName,

    -- * Destructuring the Response
    ResetParameterGroupResponse (..),
    newResetParameterGroupResponse,

    -- * Response Lenses
    resetParameterGroupResponse_parameterGroup,
    resetParameterGroupResponse_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:/ 'newResetParameterGroup' smart constructor.
data ResetParameterGroup = ResetParameterGroup'
  { -- | If true, all parameters in the parameter group are reset to their
    -- default values. If false, only the parameters listed by ParameterNames
    -- are reset to their default values.
    ResetParameterGroup -> Maybe Bool
allParameters :: Prelude.Maybe Prelude.Bool,
    -- | An array of parameter names to reset to their default values. If
    -- AllParameters is true, do not use ParameterNames. If AllParameters is
    -- false, you must specify the name of at least one parameter to reset.
    ResetParameterGroup -> Maybe [Text]
parameterNames :: Prelude.Maybe [Prelude.Text],
    -- | The name of the parameter group to reset.
    ResetParameterGroup -> Text
parameterGroupName :: Prelude.Text
  }
  deriving (ResetParameterGroup -> ResetParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetParameterGroup -> ResetParameterGroup -> Bool
$c/= :: ResetParameterGroup -> ResetParameterGroup -> Bool
== :: ResetParameterGroup -> ResetParameterGroup -> Bool
$c== :: ResetParameterGroup -> ResetParameterGroup -> Bool
Prelude.Eq, ReadPrec [ResetParameterGroup]
ReadPrec ResetParameterGroup
Int -> ReadS ResetParameterGroup
ReadS [ResetParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetParameterGroup]
$creadListPrec :: ReadPrec [ResetParameterGroup]
readPrec :: ReadPrec ResetParameterGroup
$creadPrec :: ReadPrec ResetParameterGroup
readList :: ReadS [ResetParameterGroup]
$creadList :: ReadS [ResetParameterGroup]
readsPrec :: Int -> ReadS ResetParameterGroup
$creadsPrec :: Int -> ReadS ResetParameterGroup
Prelude.Read, Int -> ResetParameterGroup -> ShowS
[ResetParameterGroup] -> ShowS
ResetParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetParameterGroup] -> ShowS
$cshowList :: [ResetParameterGroup] -> ShowS
show :: ResetParameterGroup -> String
$cshow :: ResetParameterGroup -> String
showsPrec :: Int -> ResetParameterGroup -> ShowS
$cshowsPrec :: Int -> ResetParameterGroup -> ShowS
Prelude.Show, forall x. Rep ResetParameterGroup x -> ResetParameterGroup
forall x. ResetParameterGroup -> Rep ResetParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResetParameterGroup x -> ResetParameterGroup
$cfrom :: forall x. ResetParameterGroup -> Rep ResetParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'ResetParameterGroup' 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:
--
-- 'allParameters', 'resetParameterGroup_allParameters' - If true, all parameters in the parameter group are reset to their
-- default values. If false, only the parameters listed by ParameterNames
-- are reset to their default values.
--
-- 'parameterNames', 'resetParameterGroup_parameterNames' - An array of parameter names to reset to their default values. If
-- AllParameters is true, do not use ParameterNames. If AllParameters is
-- false, you must specify the name of at least one parameter to reset.
--
-- 'parameterGroupName', 'resetParameterGroup_parameterGroupName' - The name of the parameter group to reset.
newResetParameterGroup ::
  -- | 'parameterGroupName'
  Prelude.Text ->
  ResetParameterGroup
newResetParameterGroup :: Text -> ResetParameterGroup
newResetParameterGroup Text
pParameterGroupName_ =
  ResetParameterGroup'
    { $sel:allParameters:ResetParameterGroup' :: Maybe Bool
allParameters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:parameterNames:ResetParameterGroup' :: Maybe [Text]
parameterNames = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterGroupName:ResetParameterGroup' :: Text
parameterGroupName = Text
pParameterGroupName_
    }

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

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

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

instance Core.AWSRequest ResetParameterGroup where
  type
    AWSResponse ResetParameterGroup =
      ResetParameterGroupResponse
  request :: (Service -> Service)
-> ResetParameterGroup -> Request ResetParameterGroup
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 ResetParameterGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ResetParameterGroup)))
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 -> ResetParameterGroupResponse
ResetParameterGroupResponse'
            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 ResetParameterGroup where
  hashWithSalt :: Int -> ResetParameterGroup -> Int
hashWithSalt Int
_salt ResetParameterGroup' {Maybe Bool
Maybe [Text]
Text
parameterGroupName :: Text
parameterNames :: Maybe [Text]
allParameters :: Maybe Bool
$sel:parameterGroupName:ResetParameterGroup' :: ResetParameterGroup -> Text
$sel:parameterNames:ResetParameterGroup' :: ResetParameterGroup -> Maybe [Text]
$sel:allParameters:ResetParameterGroup' :: ResetParameterGroup -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
allParameters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
parameterNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
parameterGroupName

instance Prelude.NFData ResetParameterGroup where
  rnf :: ResetParameterGroup -> ()
rnf ResetParameterGroup' {Maybe Bool
Maybe [Text]
Text
parameterGroupName :: Text
parameterNames :: Maybe [Text]
allParameters :: Maybe Bool
$sel:parameterGroupName:ResetParameterGroup' :: ResetParameterGroup -> Text
$sel:parameterNames:ResetParameterGroup' :: ResetParameterGroup -> Maybe [Text]
$sel:allParameters:ResetParameterGroup' :: ResetParameterGroup -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
allParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
parameterNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
parameterGroupName

instance Data.ToHeaders ResetParameterGroup where
  toHeaders :: ResetParameterGroup -> 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.ResetParameterGroup" ::
                          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 ResetParameterGroup where
  toJSON :: ResetParameterGroup -> Value
toJSON ResetParameterGroup' {Maybe Bool
Maybe [Text]
Text
parameterGroupName :: Text
parameterNames :: Maybe [Text]
allParameters :: Maybe Bool
$sel:parameterGroupName:ResetParameterGroup' :: ResetParameterGroup -> Text
$sel:parameterNames:ResetParameterGroup' :: ResetParameterGroup -> Maybe [Text]
$sel:allParameters:ResetParameterGroup' :: ResetParameterGroup -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AllParameters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
allParameters,
            (Key
"ParameterNames" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
parameterNames,
            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 ResetParameterGroup where
  toPath :: ResetParameterGroup -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'ResetParameterGroupResponse' 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', 'resetParameterGroupResponse_parameterGroup' - The parameter group being reset.
--
-- 'httpStatus', 'resetParameterGroupResponse_httpStatus' - The response's http status code.
newResetParameterGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ResetParameterGroupResponse
newResetParameterGroupResponse :: Int -> ResetParameterGroupResponse
newResetParameterGroupResponse Int
pHttpStatus_ =
  ResetParameterGroupResponse'
    { $sel:parameterGroup:ResetParameterGroupResponse' :: Maybe ParameterGroup
parameterGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ResetParameterGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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