{-# 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.Neptune.CopyDBParameterGroup
-- 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 parameter group.
module Amazonka.Neptune.CopyDBParameterGroup
  ( -- * Creating a Request
    CopyDBParameterGroup (..),
    newCopyDBParameterGroup,

    -- * Request Lenses
    copyDBParameterGroup_tags,
    copyDBParameterGroup_sourceDBParameterGroupIdentifier,
    copyDBParameterGroup_targetDBParameterGroupIdentifier,
    copyDBParameterGroup_targetDBParameterGroupDescription,

    -- * Destructuring the Response
    CopyDBParameterGroupResponse (..),
    newCopyDBParameterGroupResponse,

    -- * Response Lenses
    copyDBParameterGroupResponse_dbParameterGroup,
    copyDBParameterGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCopyDBParameterGroup' smart constructor.
data CopyDBParameterGroup = CopyDBParameterGroup'
  { -- | The tags to be assigned to the copied DB parameter group.
    CopyDBParameterGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The identifier or ARN for the source DB parameter group. For information
    -- about creating an ARN, see
    -- <https://docs.aws.amazon.com/neptune/latest/UserGuide/tagging.ARN.html#tagging.ARN.Constructing Constructing an Amazon Resource Name (ARN)>.
    --
    -- Constraints:
    --
    -- -   Must specify a valid DB parameter group.
    --
    -- -   Must specify a valid DB parameter group identifier, for example
    --     @my-db-param-group@, or a valid ARN.
    CopyDBParameterGroup -> Text
sourceDBParameterGroupIdentifier :: Prelude.Text,
    -- | The identifier for the copied DB parameter group.
    --
    -- Constraints:
    --
    -- -   Cannot be null, empty, or blank.
    --
    -- -   Must contain from 1 to 255 letters, numbers, or hyphens.
    --
    -- -   First character must be a letter.
    --
    -- -   Cannot end with a hyphen or contain two consecutive hyphens.
    --
    -- Example: @my-db-parameter-group@
    CopyDBParameterGroup -> Text
targetDBParameterGroupIdentifier :: Prelude.Text,
    -- | A description for the copied DB parameter group.
    CopyDBParameterGroup -> Text
targetDBParameterGroupDescription :: Prelude.Text
  }
  deriving (CopyDBParameterGroup -> CopyDBParameterGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyDBParameterGroup -> CopyDBParameterGroup -> Bool
$c/= :: CopyDBParameterGroup -> CopyDBParameterGroup -> Bool
== :: CopyDBParameterGroup -> CopyDBParameterGroup -> Bool
$c== :: CopyDBParameterGroup -> CopyDBParameterGroup -> Bool
Prelude.Eq, ReadPrec [CopyDBParameterGroup]
ReadPrec CopyDBParameterGroup
Int -> ReadS CopyDBParameterGroup
ReadS [CopyDBParameterGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CopyDBParameterGroup]
$creadListPrec :: ReadPrec [CopyDBParameterGroup]
readPrec :: ReadPrec CopyDBParameterGroup
$creadPrec :: ReadPrec CopyDBParameterGroup
readList :: ReadS [CopyDBParameterGroup]
$creadList :: ReadS [CopyDBParameterGroup]
readsPrec :: Int -> ReadS CopyDBParameterGroup
$creadsPrec :: Int -> ReadS CopyDBParameterGroup
Prelude.Read, Int -> CopyDBParameterGroup -> ShowS
[CopyDBParameterGroup] -> ShowS
CopyDBParameterGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyDBParameterGroup] -> ShowS
$cshowList :: [CopyDBParameterGroup] -> ShowS
show :: CopyDBParameterGroup -> String
$cshow :: CopyDBParameterGroup -> String
showsPrec :: Int -> CopyDBParameterGroup -> ShowS
$cshowsPrec :: Int -> CopyDBParameterGroup -> ShowS
Prelude.Show, forall x. Rep CopyDBParameterGroup x -> CopyDBParameterGroup
forall x. CopyDBParameterGroup -> Rep CopyDBParameterGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyDBParameterGroup x -> CopyDBParameterGroup
$cfrom :: forall x. CopyDBParameterGroup -> Rep CopyDBParameterGroup x
Prelude.Generic)

-- |
-- Create a value of 'CopyDBParameterGroup' 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', 'copyDBParameterGroup_tags' - The tags to be assigned to the copied DB parameter group.
--
-- 'sourceDBParameterGroupIdentifier', 'copyDBParameterGroup_sourceDBParameterGroupIdentifier' - The identifier or ARN for the source DB parameter group. For information
-- about creating an ARN, see
-- <https://docs.aws.amazon.com/neptune/latest/UserGuide/tagging.ARN.html#tagging.ARN.Constructing Constructing an Amazon Resource Name (ARN)>.
--
-- Constraints:
--
-- -   Must specify a valid DB parameter group.
--
-- -   Must specify a valid DB parameter group identifier, for example
--     @my-db-param-group@, or a valid ARN.
--
-- 'targetDBParameterGroupIdentifier', 'copyDBParameterGroup_targetDBParameterGroupIdentifier' - The identifier for the copied DB parameter group.
--
-- Constraints:
--
-- -   Cannot be null, empty, or blank.
--
-- -   Must contain from 1 to 255 letters, numbers, or hyphens.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
--
-- Example: @my-db-parameter-group@
--
-- 'targetDBParameterGroupDescription', 'copyDBParameterGroup_targetDBParameterGroupDescription' - A description for the copied DB parameter group.
newCopyDBParameterGroup ::
  -- | 'sourceDBParameterGroupIdentifier'
  Prelude.Text ->
  -- | 'targetDBParameterGroupIdentifier'
  Prelude.Text ->
  -- | 'targetDBParameterGroupDescription'
  Prelude.Text ->
  CopyDBParameterGroup
newCopyDBParameterGroup :: Text -> Text -> Text -> CopyDBParameterGroup
newCopyDBParameterGroup
  Text
pSourceDBParameterGroupIdentifier_
  Text
pTargetDBParameterGroupIdentifier_
  Text
pTargetDBParameterGroupDescription_ =
    CopyDBParameterGroup'
      { $sel:tags:CopyDBParameterGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceDBParameterGroupIdentifier:CopyDBParameterGroup' :: Text
sourceDBParameterGroupIdentifier =
          Text
pSourceDBParameterGroupIdentifier_,
        $sel:targetDBParameterGroupIdentifier:CopyDBParameterGroup' :: Text
targetDBParameterGroupIdentifier =
          Text
pTargetDBParameterGroupIdentifier_,
        $sel:targetDBParameterGroupDescription:CopyDBParameterGroup' :: Text
targetDBParameterGroupDescription =
          Text
pTargetDBParameterGroupDescription_
      }

-- | The tags to be assigned to the copied DB parameter group.
copyDBParameterGroup_tags :: Lens.Lens' CopyDBParameterGroup (Prelude.Maybe [Tag])
copyDBParameterGroup_tags :: Lens' CopyDBParameterGroup (Maybe [Tag])
copyDBParameterGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBParameterGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CopyDBParameterGroup' :: CopyDBParameterGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CopyDBParameterGroup
s@CopyDBParameterGroup' {} Maybe [Tag]
a -> CopyDBParameterGroup
s {$sel:tags:CopyDBParameterGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CopyDBParameterGroup) 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 ARN for the source DB parameter group. For information
-- about creating an ARN, see
-- <https://docs.aws.amazon.com/neptune/latest/UserGuide/tagging.ARN.html#tagging.ARN.Constructing Constructing an Amazon Resource Name (ARN)>.
--
-- Constraints:
--
-- -   Must specify a valid DB parameter group.
--
-- -   Must specify a valid DB parameter group identifier, for example
--     @my-db-param-group@, or a valid ARN.
copyDBParameterGroup_sourceDBParameterGroupIdentifier :: Lens.Lens' CopyDBParameterGroup Prelude.Text
copyDBParameterGroup_sourceDBParameterGroupIdentifier :: Lens' CopyDBParameterGroup Text
copyDBParameterGroup_sourceDBParameterGroupIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBParameterGroup' {Text
sourceDBParameterGroupIdentifier :: Text
$sel:sourceDBParameterGroupIdentifier:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
sourceDBParameterGroupIdentifier} -> Text
sourceDBParameterGroupIdentifier) (\s :: CopyDBParameterGroup
s@CopyDBParameterGroup' {} Text
a -> CopyDBParameterGroup
s {$sel:sourceDBParameterGroupIdentifier:CopyDBParameterGroup' :: Text
sourceDBParameterGroupIdentifier = Text
a} :: CopyDBParameterGroup)

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

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

instance Core.AWSRequest CopyDBParameterGroup where
  type
    AWSResponse CopyDBParameterGroup =
      CopyDBParameterGroupResponse
  request :: (Service -> Service)
-> CopyDBParameterGroup -> Request CopyDBParameterGroup
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 CopyDBParameterGroup
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CopyDBParameterGroup)))
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
"CopyDBParameterGroupResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBParameterGroup -> Int -> CopyDBParameterGroupResponse
CopyDBParameterGroupResponse'
            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
"DBParameterGroup")
            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 CopyDBParameterGroup where
  hashWithSalt :: Int -> CopyDBParameterGroup -> Int
hashWithSalt Int
_salt CopyDBParameterGroup' {Maybe [Tag]
Text
targetDBParameterGroupDescription :: Text
targetDBParameterGroupIdentifier :: Text
sourceDBParameterGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetDBParameterGroupDescription:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:targetDBParameterGroupIdentifier:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:sourceDBParameterGroupIdentifier:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:tags:CopyDBParameterGroup' :: CopyDBParameterGroup -> 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
sourceDBParameterGroupIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetDBParameterGroupIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetDBParameterGroupDescription

instance Prelude.NFData CopyDBParameterGroup where
  rnf :: CopyDBParameterGroup -> ()
rnf CopyDBParameterGroup' {Maybe [Tag]
Text
targetDBParameterGroupDescription :: Text
targetDBParameterGroupIdentifier :: Text
sourceDBParameterGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetDBParameterGroupDescription:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:targetDBParameterGroupIdentifier:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:sourceDBParameterGroupIdentifier:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:tags:CopyDBParameterGroup' :: CopyDBParameterGroup -> 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
sourceDBParameterGroupIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetDBParameterGroupIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetDBParameterGroupDescription

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

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

instance Data.ToQuery CopyDBParameterGroup where
  toQuery :: CopyDBParameterGroup -> QueryString
toQuery CopyDBParameterGroup' {Maybe [Tag]
Text
targetDBParameterGroupDescription :: Text
targetDBParameterGroupIdentifier :: Text
sourceDBParameterGroupIdentifier :: Text
tags :: Maybe [Tag]
$sel:targetDBParameterGroupDescription:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:targetDBParameterGroupIdentifier:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:sourceDBParameterGroupIdentifier:CopyDBParameterGroup' :: CopyDBParameterGroup -> Text
$sel:tags:CopyDBParameterGroup' :: CopyDBParameterGroup -> Maybe [Tag]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CopyDBParameterGroup" :: 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
"SourceDBParameterGroupIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceDBParameterGroupIdentifier,
        ByteString
"TargetDBParameterGroupIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetDBParameterGroupIdentifier,
        ByteString
"TargetDBParameterGroupDescription"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetDBParameterGroupDescription
      ]

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

-- |
-- Create a value of 'CopyDBParameterGroupResponse' 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:
--
-- 'dbParameterGroup', 'copyDBParameterGroupResponse_dbParameterGroup' - Undocumented member.
--
-- 'httpStatus', 'copyDBParameterGroupResponse_httpStatus' - The response's http status code.
newCopyDBParameterGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CopyDBParameterGroupResponse
newCopyDBParameterGroupResponse :: Int -> CopyDBParameterGroupResponse
newCopyDBParameterGroupResponse Int
pHttpStatus_ =
  CopyDBParameterGroupResponse'
    { $sel:dbParameterGroup:CopyDBParameterGroupResponse' :: Maybe DBParameterGroup
dbParameterGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CopyDBParameterGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
copyDBParameterGroupResponse_dbParameterGroup :: Lens.Lens' CopyDBParameterGroupResponse (Prelude.Maybe DBParameterGroup)
copyDBParameterGroupResponse_dbParameterGroup :: Lens' CopyDBParameterGroupResponse (Maybe DBParameterGroup)
copyDBParameterGroupResponse_dbParameterGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBParameterGroupResponse' {Maybe DBParameterGroup
dbParameterGroup :: Maybe DBParameterGroup
$sel:dbParameterGroup:CopyDBParameterGroupResponse' :: CopyDBParameterGroupResponse -> Maybe DBParameterGroup
dbParameterGroup} -> Maybe DBParameterGroup
dbParameterGroup) (\s :: CopyDBParameterGroupResponse
s@CopyDBParameterGroupResponse' {} Maybe DBParameterGroup
a -> CopyDBParameterGroupResponse
s {$sel:dbParameterGroup:CopyDBParameterGroupResponse' :: Maybe DBParameterGroup
dbParameterGroup = Maybe DBParameterGroup
a} :: CopyDBParameterGroupResponse)

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

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