{-# 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.RDS.CopyDBClusterParameterGroup
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Copies the specified DB cluster parameter group.
module Amazonka.RDS.CopyDBClusterParameterGroup
  ( -- * Creating a Request
    CopyDBClusterParameterGroup (..),
    newCopyDBClusterParameterGroup,

    -- * Request Lenses
    copyDBClusterParameterGroup_tags,
    copyDBClusterParameterGroup_sourceDBClusterParameterGroupIdentifier,
    copyDBClusterParameterGroup_targetDBClusterParameterGroupIdentifier,
    copyDBClusterParameterGroup_targetDBClusterParameterGroupDescription,

    -- * Destructuring the Response
    CopyDBClusterParameterGroupResponse (..),
    newCopyDBClusterParameterGroupResponse,

    -- * Response Lenses
    copyDBClusterParameterGroupResponse_dbClusterParameterGroup,
    copyDBClusterParameterGroupResponse_httpStatus,
  )
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.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCopyDBClusterParameterGroup' smart constructor.
data CopyDBClusterParameterGroup = CopyDBClusterParameterGroup'
  { CopyDBClusterParameterGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The identifier or Amazon Resource Name (ARN) for the source DB cluster
    -- parameter group. For information about creating an ARN, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_Tagging.ARN.html#USER_Tagging.ARN.Constructing Constructing an ARN for Amazon RDS>
    -- in the /Amazon Aurora User Guide/.
    --
    -- Constraints:
    --
    -- -   Must specify a valid DB cluster parameter group.
    CopyDBClusterParameterGroup -> Text
sourceDBClusterParameterGroupIdentifier :: Prelude.Text,
    -- | The identifier for the copied DB cluster parameter group.
    --
    -- Constraints:
    --
    -- -   Can\'t be null, empty, or blank
    --
    -- -   Must contain from 1 to 255 letters, numbers, or hyphens
    --
    -- -   First character must be a letter
    --
    -- -   Can\'t end with a hyphen or contain two consecutive hyphens
    --
    -- Example: @my-cluster-param-group1@
    CopyDBClusterParameterGroup -> Text
targetDBClusterParameterGroupIdentifier :: Prelude.Text,
    -- | A description for the copied DB cluster parameter group.
    CopyDBClusterParameterGroup -> Text
targetDBClusterParameterGroupDescription :: Prelude.Text
  }
  deriving (CopyDBClusterParameterGroup -> CopyDBClusterParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyDBClusterParameterGroup -> CopyDBClusterParameterGroup -> Bool
$c/= :: CopyDBClusterParameterGroup -> CopyDBClusterParameterGroup -> Bool
== :: CopyDBClusterParameterGroup -> CopyDBClusterParameterGroup -> Bool
$c== :: CopyDBClusterParameterGroup -> CopyDBClusterParameterGroup -> Bool
Prelude.Eq, ReadPrec [CopyDBClusterParameterGroup]
ReadPrec CopyDBClusterParameterGroup
Int -> ReadS CopyDBClusterParameterGroup
ReadS [CopyDBClusterParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CopyDBClusterParameterGroup]
$creadListPrec :: ReadPrec [CopyDBClusterParameterGroup]
readPrec :: ReadPrec CopyDBClusterParameterGroup
$creadPrec :: ReadPrec CopyDBClusterParameterGroup
readList :: ReadS [CopyDBClusterParameterGroup]
$creadList :: ReadS [CopyDBClusterParameterGroup]
readsPrec :: Int -> ReadS CopyDBClusterParameterGroup
$creadsPrec :: Int -> ReadS CopyDBClusterParameterGroup
Prelude.Read, Int -> CopyDBClusterParameterGroup -> ShowS
[CopyDBClusterParameterGroup] -> ShowS
CopyDBClusterParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyDBClusterParameterGroup] -> ShowS
$cshowList :: [CopyDBClusterParameterGroup] -> ShowS
show :: CopyDBClusterParameterGroup -> String
$cshow :: CopyDBClusterParameterGroup -> String
showsPrec :: Int -> CopyDBClusterParameterGroup -> ShowS
$cshowsPrec :: Int -> CopyDBClusterParameterGroup -> ShowS
Prelude.Show, forall x.
Rep CopyDBClusterParameterGroup x -> CopyDBClusterParameterGroup
forall x.
CopyDBClusterParameterGroup -> Rep CopyDBClusterParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CopyDBClusterParameterGroup x -> CopyDBClusterParameterGroup
$cfrom :: forall x.
CopyDBClusterParameterGroup -> Rep CopyDBClusterParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'CopyDBClusterParameterGroup' 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:
--
-- 'tags', 'copyDBClusterParameterGroup_tags' - Undocumented member.
--
-- 'sourceDBClusterParameterGroupIdentifier', 'copyDBClusterParameterGroup_sourceDBClusterParameterGroupIdentifier' - The identifier or Amazon Resource Name (ARN) for the source DB cluster
-- parameter group. For information about creating an ARN, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_Tagging.ARN.html#USER_Tagging.ARN.Constructing Constructing an ARN for Amazon RDS>
-- in the /Amazon Aurora User Guide/.
--
-- Constraints:
--
-- -   Must specify a valid DB cluster parameter group.
--
-- 'targetDBClusterParameterGroupIdentifier', 'copyDBClusterParameterGroup_targetDBClusterParameterGroupIdentifier' - The identifier for the copied DB cluster parameter group.
--
-- Constraints:
--
-- -   Can\'t be null, empty, or blank
--
-- -   Must contain from 1 to 255 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- Example: @my-cluster-param-group1@
--
-- 'targetDBClusterParameterGroupDescription', 'copyDBClusterParameterGroup_targetDBClusterParameterGroupDescription' - A description for the copied DB cluster parameter group.
newCopyDBClusterParameterGroup ::
  -- | 'sourceDBClusterParameterGroupIdentifier'
  Prelude.Text ->
  -- | 'targetDBClusterParameterGroupIdentifier'
  Prelude.Text ->
  -- | 'targetDBClusterParameterGroupDescription'
  Prelude.Text ->
  CopyDBClusterParameterGroup
newCopyDBClusterParameterGroup :: Text -> Text -> Text -> CopyDBClusterParameterGroup
newCopyDBClusterParameterGroup
  Text
pSourceDBClusterParameterGroupIdentifier_
  Text
pTargetDBClusterParameterGroupIdentifier_
  Text
pTargetDBClusterParameterGroupDescription_ =
    CopyDBClusterParameterGroup'
      { $sel:tags:CopyDBClusterParameterGroup' :: Maybe [Tag]
tags =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sourceDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: Text
sourceDBClusterParameterGroupIdentifier =
          Text
pSourceDBClusterParameterGroupIdentifier_,
        $sel:targetDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: Text
targetDBClusterParameterGroupIdentifier =
          Text
pTargetDBClusterParameterGroupIdentifier_,
        $sel:targetDBClusterParameterGroupDescription:CopyDBClusterParameterGroup' :: Text
targetDBClusterParameterGroupDescription =
          Text
pTargetDBClusterParameterGroupDescription_
      }

-- | Undocumented member.
copyDBClusterParameterGroup_tags :: Lens.Lens' CopyDBClusterParameterGroup (Prelude.Maybe [Tag])
copyDBClusterParameterGroup_tags :: Lens' CopyDBClusterParameterGroup (Maybe [Tag])
copyDBClusterParameterGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBClusterParameterGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CopyDBClusterParameterGroup
s@CopyDBClusterParameterGroup' {} Maybe [Tag]
a -> CopyDBClusterParameterGroup
s {$sel:tags:CopyDBClusterParameterGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CopyDBClusterParameterGroup) 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 identifier or Amazon Resource Name (ARN) for the source DB cluster
-- parameter group. For information about creating an ARN, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/AuroraUserGuide/USER_Tagging.ARN.html#USER_Tagging.ARN.Constructing Constructing an ARN for Amazon RDS>
-- in the /Amazon Aurora User Guide/.
--
-- Constraints:
--
-- -   Must specify a valid DB cluster parameter group.
copyDBClusterParameterGroup_sourceDBClusterParameterGroupIdentifier :: Lens.Lens' CopyDBClusterParameterGroup Prelude.Text
copyDBClusterParameterGroup_sourceDBClusterParameterGroupIdentifier :: Lens' CopyDBClusterParameterGroup Text
copyDBClusterParameterGroup_sourceDBClusterParameterGroupIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBClusterParameterGroup' {Text
sourceDBClusterParameterGroupIdentifier :: Text
$sel:sourceDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
sourceDBClusterParameterGroupIdentifier} -> Text
sourceDBClusterParameterGroupIdentifier) (\s :: CopyDBClusterParameterGroup
s@CopyDBClusterParameterGroup' {} Text
a -> CopyDBClusterParameterGroup
s {$sel:sourceDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: Text
sourceDBClusterParameterGroupIdentifier = Text
a} :: CopyDBClusterParameterGroup)

-- | The identifier for the copied DB cluster parameter group.
--
-- Constraints:
--
-- -   Can\'t be null, empty, or blank
--
-- -   Must contain from 1 to 255 letters, numbers, or hyphens
--
-- -   First character must be a letter
--
-- -   Can\'t end with a hyphen or contain two consecutive hyphens
--
-- Example: @my-cluster-param-group1@
copyDBClusterParameterGroup_targetDBClusterParameterGroupIdentifier :: Lens.Lens' CopyDBClusterParameterGroup Prelude.Text
copyDBClusterParameterGroup_targetDBClusterParameterGroupIdentifier :: Lens' CopyDBClusterParameterGroup Text
copyDBClusterParameterGroup_targetDBClusterParameterGroupIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBClusterParameterGroup' {Text
targetDBClusterParameterGroupIdentifier :: Text
$sel:targetDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
targetDBClusterParameterGroupIdentifier} -> Text
targetDBClusterParameterGroupIdentifier) (\s :: CopyDBClusterParameterGroup
s@CopyDBClusterParameterGroup' {} Text
a -> CopyDBClusterParameterGroup
s {$sel:targetDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: Text
targetDBClusterParameterGroupIdentifier = Text
a} :: CopyDBClusterParameterGroup)

-- | A description for the copied DB cluster parameter group.
copyDBClusterParameterGroup_targetDBClusterParameterGroupDescription :: Lens.Lens' CopyDBClusterParameterGroup Prelude.Text
copyDBClusterParameterGroup_targetDBClusterParameterGroupDescription :: Lens' CopyDBClusterParameterGroup Text
copyDBClusterParameterGroup_targetDBClusterParameterGroupDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBClusterParameterGroup' {Text
targetDBClusterParameterGroupDescription :: Text
$sel:targetDBClusterParameterGroupDescription:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
targetDBClusterParameterGroupDescription} -> Text
targetDBClusterParameterGroupDescription) (\s :: CopyDBClusterParameterGroup
s@CopyDBClusterParameterGroup' {} Text
a -> CopyDBClusterParameterGroup
s {$sel:targetDBClusterParameterGroupDescription:CopyDBClusterParameterGroup' :: Text
targetDBClusterParameterGroupDescription = Text
a} :: CopyDBClusterParameterGroup)

instance Core.AWSRequest CopyDBClusterParameterGroup where
  type
    AWSResponse CopyDBClusterParameterGroup =
      CopyDBClusterParameterGroupResponse
  request :: (Service -> Service)
-> CopyDBClusterParameterGroup
-> Request CopyDBClusterParameterGroup
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 CopyDBClusterParameterGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CopyDBClusterParameterGroup)))
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
"CopyDBClusterParameterGroupResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBClusterParameterGroup
-> Int -> CopyDBClusterParameterGroupResponse
CopyDBClusterParameterGroupResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"DBClusterParameterGroup")
            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 CopyDBClusterParameterGroup where
  hashWithSalt :: Int -> CopyDBClusterParameterGroup -> Int
hashWithSalt Int
_salt CopyDBClusterParameterGroup' {Maybe [Tag]
Text
targetDBClusterParameterGroupDescription :: Text
targetDBClusterParameterGroupIdentifier :: Text
sourceDBClusterParameterGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetDBClusterParameterGroupDescription:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:targetDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:sourceDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:tags:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Maybe [Tag]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceDBClusterParameterGroupIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetDBClusterParameterGroupIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetDBClusterParameterGroupDescription

instance Prelude.NFData CopyDBClusterParameterGroup where
  rnf :: CopyDBClusterParameterGroup -> ()
rnf CopyDBClusterParameterGroup' {Maybe [Tag]
Text
targetDBClusterParameterGroupDescription :: Text
targetDBClusterParameterGroupIdentifier :: Text
sourceDBClusterParameterGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetDBClusterParameterGroupDescription:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:targetDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:sourceDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:tags:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Maybe [Tag]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceDBClusterParameterGroupIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetDBClusterParameterGroupIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetDBClusterParameterGroupDescription

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

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

instance Data.ToQuery CopyDBClusterParameterGroup where
  toQuery :: CopyDBClusterParameterGroup -> QueryString
toQuery CopyDBClusterParameterGroup' {Maybe [Tag]
Text
targetDBClusterParameterGroupDescription :: Text
targetDBClusterParameterGroupIdentifier :: Text
sourceDBClusterParameterGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetDBClusterParameterGroupDescription:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:targetDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:sourceDBClusterParameterGroupIdentifier:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Text
$sel:tags:CopyDBClusterParameterGroup' :: CopyDBClusterParameterGroup -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"CopyDBClusterParameterGroup" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Tags"
          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
"Tag" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags),
        ByteString
"SourceDBClusterParameterGroupIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceDBClusterParameterGroupIdentifier,
        ByteString
"TargetDBClusterParameterGroupIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetDBClusterParameterGroupIdentifier,
        ByteString
"TargetDBClusterParameterGroupDescription"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetDBClusterParameterGroupDescription
      ]

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

-- |
-- Create a value of 'CopyDBClusterParameterGroupResponse' 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:
--
-- 'dbClusterParameterGroup', 'copyDBClusterParameterGroupResponse_dbClusterParameterGroup' - Undocumented member.
--
-- 'httpStatus', 'copyDBClusterParameterGroupResponse_httpStatus' - The response's http status code.
newCopyDBClusterParameterGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CopyDBClusterParameterGroupResponse
newCopyDBClusterParameterGroupResponse :: Int -> CopyDBClusterParameterGroupResponse
newCopyDBClusterParameterGroupResponse Int
pHttpStatus_ =
  CopyDBClusterParameterGroupResponse'
    { $sel:dbClusterParameterGroup:CopyDBClusterParameterGroupResponse' :: Maybe DBClusterParameterGroup
dbClusterParameterGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CopyDBClusterParameterGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
copyDBClusterParameterGroupResponse_dbClusterParameterGroup :: Lens.Lens' CopyDBClusterParameterGroupResponse (Prelude.Maybe DBClusterParameterGroup)
copyDBClusterParameterGroupResponse_dbClusterParameterGroup :: Lens'
  CopyDBClusterParameterGroupResponse (Maybe DBClusterParameterGroup)
copyDBClusterParameterGroupResponse_dbClusterParameterGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBClusterParameterGroupResponse' {Maybe DBClusterParameterGroup
dbClusterParameterGroup :: Maybe DBClusterParameterGroup
$sel:dbClusterParameterGroup:CopyDBClusterParameterGroupResponse' :: CopyDBClusterParameterGroupResponse
-> Maybe DBClusterParameterGroup
dbClusterParameterGroup} -> Maybe DBClusterParameterGroup
dbClusterParameterGroup) (\s :: CopyDBClusterParameterGroupResponse
s@CopyDBClusterParameterGroupResponse' {} Maybe DBClusterParameterGroup
a -> CopyDBClusterParameterGroupResponse
s {$sel:dbClusterParameterGroup:CopyDBClusterParameterGroupResponse' :: Maybe DBClusterParameterGroup
dbClusterParameterGroup = Maybe DBClusterParameterGroup
a} :: CopyDBClusterParameterGroupResponse)

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

instance
  Prelude.NFData
    CopyDBClusterParameterGroupResponse
  where
  rnf :: CopyDBClusterParameterGroupResponse -> ()
rnf CopyDBClusterParameterGroupResponse' {Int
Maybe DBClusterParameterGroup
httpStatus :: Int
dbClusterParameterGroup :: Maybe DBClusterParameterGroup
$sel:httpStatus:CopyDBClusterParameterGroupResponse' :: CopyDBClusterParameterGroupResponse -> Int
$sel:dbClusterParameterGroup:CopyDBClusterParameterGroupResponse' :: CopyDBClusterParameterGroupResponse
-> Maybe DBClusterParameterGroup
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DBClusterParameterGroup
dbClusterParameterGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus