{-# 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.Redshift.ResetClusterParameterGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets one or more parameters of the specified parameter group to their
-- default values and sets the source values of the parameters to
-- \"engine-default\". To reset the entire parameter group specify the
-- /ResetAllParameters/ parameter. For parameter changes to take effect you
-- must reboot any associated clusters.
module Amazonka.Redshift.ResetClusterParameterGroup
  ( -- * Creating a Request
    ResetClusterParameterGroup (..),
    newResetClusterParameterGroup,

    -- * Request Lenses
    resetClusterParameterGroup_parameters,
    resetClusterParameterGroup_resetAllParameters,
    resetClusterParameterGroup_parameterGroupName,

    -- * Destructuring the Response
    ClusterParameterGroupNameMessage (..),
    newClusterParameterGroupNameMessage,

    -- * Response Lenses
    clusterParameterGroupNameMessage_parameterGroupName,
    clusterParameterGroupNameMessage_parameterGroupStatus,
  )
where

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

-- |
--
-- /See:/ 'newResetClusterParameterGroup' smart constructor.
data ResetClusterParameterGroup = ResetClusterParameterGroup'
  { -- | An array of names of parameters to be reset. If /ResetAllParameters/
    -- option is not used, then at least one parameter name must be supplied.
    --
    -- Constraints: A maximum of 20 parameters can be reset in a single
    -- request.
    ResetClusterParameterGroup -> Maybe [Parameter]
parameters :: Prelude.Maybe [Parameter],
    -- | If @true@, all parameters in the specified parameter group will be reset
    -- to their default values.
    --
    -- Default: @true@
    ResetClusterParameterGroup -> Maybe Bool
resetAllParameters :: Prelude.Maybe Prelude.Bool,
    -- | The name of the cluster parameter group to be reset.
    ResetClusterParameterGroup -> Text
parameterGroupName :: Prelude.Text
  }
  deriving (ResetClusterParameterGroup -> ResetClusterParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResetClusterParameterGroup -> ResetClusterParameterGroup -> Bool
$c/= :: ResetClusterParameterGroup -> ResetClusterParameterGroup -> Bool
== :: ResetClusterParameterGroup -> ResetClusterParameterGroup -> Bool
$c== :: ResetClusterParameterGroup -> ResetClusterParameterGroup -> Bool
Prelude.Eq, ReadPrec [ResetClusterParameterGroup]
ReadPrec ResetClusterParameterGroup
Int -> ReadS ResetClusterParameterGroup
ReadS [ResetClusterParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResetClusterParameterGroup]
$creadListPrec :: ReadPrec [ResetClusterParameterGroup]
readPrec :: ReadPrec ResetClusterParameterGroup
$creadPrec :: ReadPrec ResetClusterParameterGroup
readList :: ReadS [ResetClusterParameterGroup]
$creadList :: ReadS [ResetClusterParameterGroup]
readsPrec :: Int -> ReadS ResetClusterParameterGroup
$creadsPrec :: Int -> ReadS ResetClusterParameterGroup
Prelude.Read, Int -> ResetClusterParameterGroup -> ShowS
[ResetClusterParameterGroup] -> ShowS
ResetClusterParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResetClusterParameterGroup] -> ShowS
$cshowList :: [ResetClusterParameterGroup] -> ShowS
show :: ResetClusterParameterGroup -> String
$cshow :: ResetClusterParameterGroup -> String
showsPrec :: Int -> ResetClusterParameterGroup -> ShowS
$cshowsPrec :: Int -> ResetClusterParameterGroup -> ShowS
Prelude.Show, forall x.
Rep ResetClusterParameterGroup x -> ResetClusterParameterGroup
forall x.
ResetClusterParameterGroup -> Rep ResetClusterParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ResetClusterParameterGroup x -> ResetClusterParameterGroup
$cfrom :: forall x.
ResetClusterParameterGroup -> Rep ResetClusterParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'ResetClusterParameterGroup' 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', 'resetClusterParameterGroup_parameters' - An array of names of parameters to be reset. If /ResetAllParameters/
-- option is not used, then at least one parameter name must be supplied.
--
-- Constraints: A maximum of 20 parameters can be reset in a single
-- request.
--
-- 'resetAllParameters', 'resetClusterParameterGroup_resetAllParameters' - If @true@, all parameters in the specified parameter group will be reset
-- to their default values.
--
-- Default: @true@
--
-- 'parameterGroupName', 'resetClusterParameterGroup_parameterGroupName' - The name of the cluster parameter group to be reset.
newResetClusterParameterGroup ::
  -- | 'parameterGroupName'
  Prelude.Text ->
  ResetClusterParameterGroup
newResetClusterParameterGroup :: Text -> ResetClusterParameterGroup
newResetClusterParameterGroup Text
pParameterGroupName_ =
  ResetClusterParameterGroup'
    { $sel:parameters:ResetClusterParameterGroup' :: Maybe [Parameter]
parameters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:resetAllParameters:ResetClusterParameterGroup' :: Maybe Bool
resetAllParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:parameterGroupName:ResetClusterParameterGroup' :: Text
parameterGroupName = Text
pParameterGroupName_
    }

-- | An array of names of parameters to be reset. If /ResetAllParameters/
-- option is not used, then at least one parameter name must be supplied.
--
-- Constraints: A maximum of 20 parameters can be reset in a single
-- request.
resetClusterParameterGroup_parameters :: Lens.Lens' ResetClusterParameterGroup (Prelude.Maybe [Parameter])
resetClusterParameterGroup_parameters :: Lens' ResetClusterParameterGroup (Maybe [Parameter])
resetClusterParameterGroup_parameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetClusterParameterGroup' {Maybe [Parameter]
parameters :: Maybe [Parameter]
$sel:parameters:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Maybe [Parameter]
parameters} -> Maybe [Parameter]
parameters) (\s :: ResetClusterParameterGroup
s@ResetClusterParameterGroup' {} Maybe [Parameter]
a -> ResetClusterParameterGroup
s {$sel:parameters:ResetClusterParameterGroup' :: Maybe [Parameter]
parameters = Maybe [Parameter]
a} :: ResetClusterParameterGroup) 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 specified parameter group will be reset
-- to their default values.
--
-- Default: @true@
resetClusterParameterGroup_resetAllParameters :: Lens.Lens' ResetClusterParameterGroup (Prelude.Maybe Prelude.Bool)
resetClusterParameterGroup_resetAllParameters :: Lens' ResetClusterParameterGroup (Maybe Bool)
resetClusterParameterGroup_resetAllParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ResetClusterParameterGroup' {Maybe Bool
resetAllParameters :: Maybe Bool
$sel:resetAllParameters:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Maybe Bool
resetAllParameters} -> Maybe Bool
resetAllParameters) (\s :: ResetClusterParameterGroup
s@ResetClusterParameterGroup' {} Maybe Bool
a -> ResetClusterParameterGroup
s {$sel:resetAllParameters:ResetClusterParameterGroup' :: Maybe Bool
resetAllParameters = Maybe Bool
a} :: ResetClusterParameterGroup)

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

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

instance Prelude.Hashable ResetClusterParameterGroup where
  hashWithSalt :: Int -> ResetClusterParameterGroup -> Int
hashWithSalt Int
_salt ResetClusterParameterGroup' {Maybe Bool
Maybe [Parameter]
Text
parameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameters :: Maybe [Parameter]
$sel:parameterGroupName:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Text
$sel:resetAllParameters:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Maybe Bool
$sel:parameters:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> 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
parameterGroupName

instance Prelude.NFData ResetClusterParameterGroup where
  rnf :: ResetClusterParameterGroup -> ()
rnf ResetClusterParameterGroup' {Maybe Bool
Maybe [Parameter]
Text
parameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameters :: Maybe [Parameter]
$sel:parameterGroupName:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Text
$sel:resetAllParameters:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Maybe Bool
$sel:parameters:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> 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
parameterGroupName

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

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

instance Data.ToQuery ResetClusterParameterGroup where
  toQuery :: ResetClusterParameterGroup -> QueryString
toQuery ResetClusterParameterGroup' {Maybe Bool
Maybe [Parameter]
Text
parameterGroupName :: Text
resetAllParameters :: Maybe Bool
parameters :: Maybe [Parameter]
$sel:parameterGroupName:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Text
$sel:resetAllParameters:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Maybe Bool
$sel:parameters:ResetClusterParameterGroup' :: ResetClusterParameterGroup -> Maybe [Parameter]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ResetClusterParameterGroup" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: 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
"ParameterGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
parameterGroupName
      ]