{-# 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.CopyDBSnapshot
-- 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 snapshot. The source DB snapshot must be in the
-- @available@ state.
--
-- You can copy a snapshot from one Amazon Web Services Region to another.
-- In that case, the Amazon Web Services Region where you call the
-- @CopyDBSnapshot@ operation is the destination Amazon Web Services Region
-- for the DB snapshot copy.
--
-- This command doesn\'t apply to RDS Custom.
--
-- For more information about copying snapshots, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_CopySnapshot.html#USER_CopyDBSnapshot Copying a DB Snapshot>
-- in the /Amazon RDS User Guide/.
module Amazonka.RDS.CopyDBSnapshot
  ( -- * Creating a Request
    CopyDBSnapshot (..),
    newCopyDBSnapshot,

    -- * Request Lenses
    copyDBSnapshot_copyOptionGroup,
    copyDBSnapshot_copyTags,
    copyDBSnapshot_destinationRegion,
    copyDBSnapshot_kmsKeyId,
    copyDBSnapshot_optionGroupName,
    copyDBSnapshot_preSignedUrl,
    copyDBSnapshot_tags,
    copyDBSnapshot_targetCustomAvailabilityZone,
    copyDBSnapshot_sourceDBSnapshotIdentifier,
    copyDBSnapshot_targetDBSnapshotIdentifier,

    -- * Destructuring the Response
    CopyDBSnapshotResponse (..),
    newCopyDBSnapshotResponse,

    -- * Response Lenses
    copyDBSnapshotResponse_dbSnapshot,
    copyDBSnapshotResponse_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:/ 'newCopyDBSnapshot' smart constructor.
data CopyDBSnapshot = CopyDBSnapshot'
  { -- | A value that indicates whether to copy the DB option group associated
    -- with the source DB snapshot to the target Amazon Web Services account
    -- and associate with the target DB snapshot. The associated option group
    -- can be copied only with cross-account snapshot copy calls.
    CopyDBSnapshot -> Maybe Bool
copyOptionGroup :: Prelude.Maybe Prelude.Bool,
    -- | A value that indicates whether to copy all tags from the source DB
    -- snapshot to the target DB snapshot. By default, tags aren\'t copied.
    CopyDBSnapshot -> Maybe Bool
copyTags :: Prelude.Maybe Prelude.Bool,
    -- | Pseudo-parameter used when populating the @PreSignedUrl@ of a
    -- cross-region @CopyDBSnapshot@ request. To replicate from region @SRC@ to
    -- region @DST@, send a request to region @DST@. In that request, pass a
    -- @PreSignedUrl@ for region @SRC@ with @DestinationRegion@ set to region
    -- @DST@.
    CopyDBSnapshot -> Maybe Text
destinationRegion :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Web Services KMS key identifier for an encrypted DB snapshot.
    -- The Amazon Web Services KMS key identifier is the key ARN, key ID, alias
    -- ARN, or alias name for the KMS key.
    --
    -- If you copy an encrypted DB snapshot from your Amazon Web Services
    -- account, you can specify a value for this parameter to encrypt the copy
    -- with a new KMS key. If you don\'t specify a value for this parameter,
    -- then the copy of the DB snapshot is encrypted with the same Amazon Web
    -- Services KMS key as the source DB snapshot.
    --
    -- If you copy an encrypted DB snapshot that is shared from another Amazon
    -- Web Services account, then you must specify a value for this parameter.
    --
    -- If you specify this parameter when you copy an unencrypted snapshot, the
    -- copy is encrypted.
    --
    -- If you copy an encrypted snapshot to a different Amazon Web Services
    -- Region, then you must specify an Amazon Web Services KMS key identifier
    -- for the destination Amazon Web Services Region. KMS keys are specific to
    -- the Amazon Web Services Region that they are created in, and you can\'t
    -- use KMS keys from one Amazon Web Services Region in another Amazon Web
    -- Services Region.
    CopyDBSnapshot -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The name of an option group to associate with the copy of the snapshot.
    --
    -- Specify this option if you are copying a snapshot from one Amazon Web
    -- Services Region to another, and your DB instance uses a nondefault
    -- option group. If your source DB instance uses Transparent Data
    -- Encryption for Oracle or Microsoft SQL Server, you must specify this
    -- option when copying across Amazon Web Services Regions. For more
    -- information, see
    -- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_CopySnapshot.html#USER_CopySnapshot.Options Option group considerations>
    -- in the /Amazon RDS User Guide/.
    CopyDBSnapshot -> Maybe Text
optionGroupName :: Prelude.Maybe Prelude.Text,
    -- | When you are copying a snapshot from one Amazon Web Services GovCloud
    -- (US) Region to another, the URL that contains a Signature Version 4
    -- signed request for the @CopyDBSnapshot@ API operation in the source
    -- Amazon Web Services Region that contains the source DB snapshot to copy.
    --
    -- This setting applies only to Amazon Web Services GovCloud (US) Regions.
    -- It\'s ignored in other Amazon Web Services Regions.
    --
    -- You must specify this parameter when you copy an encrypted DB snapshot
    -- from another Amazon Web Services Region by using the Amazon RDS API.
    -- Don\'t specify @PreSignedUrl@ when you are copying an encrypted DB
    -- snapshot in the same Amazon Web Services Region.
    --
    -- The presigned URL must be a valid request for the
    -- @CopyDBClusterSnapshot@ API operation that can run in the source Amazon
    -- Web Services Region that contains the encrypted DB cluster snapshot to
    -- copy. The presigned URL request must contain the following parameter
    -- values:
    --
    -- -   @DestinationRegion@ - The Amazon Web Services Region that the
    --     encrypted DB snapshot is copied to. This Amazon Web Services Region
    --     is the same one where the @CopyDBSnapshot@ operation is called that
    --     contains this presigned URL.
    --
    --     For example, if you copy an encrypted DB snapshot from the us-west-2
    --     Amazon Web Services Region to the us-east-1 Amazon Web Services
    --     Region, then you call the @CopyDBSnapshot@ operation in the
    --     us-east-1 Amazon Web Services Region and provide a presigned URL
    --     that contains a call to the @CopyDBSnapshot@ operation in the
    --     us-west-2 Amazon Web Services Region. For this example, the
    --     @DestinationRegion@ in the presigned URL must be set to the
    --     us-east-1 Amazon Web Services Region.
    --
    -- -   @KmsKeyId@ - The KMS key identifier for the KMS key to use to
    --     encrypt the copy of the DB snapshot in the destination Amazon Web
    --     Services Region. This is the same identifier for both the
    --     @CopyDBSnapshot@ operation that is called in the destination Amazon
    --     Web Services Region, and the operation contained in the presigned
    --     URL.
    --
    -- -   @SourceDBSnapshotIdentifier@ - The DB snapshot identifier for the
    --     encrypted snapshot to be copied. This identifier must be in the
    --     Amazon Resource Name (ARN) format for the source Amazon Web Services
    --     Region. For example, if you are copying an encrypted DB snapshot
    --     from the us-west-2 Amazon Web Services Region, then your
    --     @SourceDBSnapshotIdentifier@ looks like the following example:
    --     @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20161115@.
    --
    -- To learn how to generate a Signature Version 4 signed request, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html Authenticating Requests: Using Query Parameters (Amazon Web Services Signature Version 4)>
    -- and
    -- <https://docs.aws.amazon.com/general/latest/gr/signature-version-4.html Signature Version 4 Signing Process>.
    --
    -- If you are using an Amazon Web Services SDK tool or the CLI, you can
    -- specify @SourceRegion@ (or @--source-region@ for the CLI) instead of
    -- specifying @PreSignedUrl@ manually. Specifying @SourceRegion@
    -- autogenerates a presigned URL that is a valid request for the operation
    -- that can run in the source Amazon Web Services Region.
    CopyDBSnapshot -> Maybe Text
preSignedUrl :: Prelude.Maybe Prelude.Text,
    CopyDBSnapshot -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The external custom Availability Zone (CAZ) identifier for the target
    -- CAZ.
    --
    -- Example: @rds-caz-aiqhTgQv@.
    CopyDBSnapshot -> Maybe Text
targetCustomAvailabilityZone :: Prelude.Maybe Prelude.Text,
    -- | The identifier for the source DB snapshot.
    --
    -- If the source snapshot is in the same Amazon Web Services Region as the
    -- copy, specify a valid DB snapshot identifier. For example, you might
    -- specify @rds:mysql-instance1-snapshot-20130805@.
    --
    -- If the source snapshot is in a different Amazon Web Services Region than
    -- the copy, specify a valid DB snapshot ARN. For example, you might
    -- specify
    -- @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20130805@.
    --
    -- If you are copying from a shared manual DB snapshot, this parameter must
    -- be the Amazon Resource Name (ARN) of the shared DB snapshot.
    --
    -- If you are copying an encrypted snapshot this parameter must be in the
    -- ARN format for the source Amazon Web Services Region.
    --
    -- Constraints:
    --
    -- -   Must specify a valid system snapshot in the \"available\" state.
    --
    -- Example: @rds:mydb-2012-04-02-00-01@
    --
    -- Example:
    -- @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20130805@
    CopyDBSnapshot -> Text
sourceDBSnapshotIdentifier :: Prelude.Text,
    -- | The identifier for the copy of the snapshot.
    --
    -- 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-db-snapshot@
    CopyDBSnapshot -> Text
targetDBSnapshotIdentifier :: Prelude.Text
  }
  deriving (CopyDBSnapshot -> CopyDBSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyDBSnapshot -> CopyDBSnapshot -> Bool
$c/= :: CopyDBSnapshot -> CopyDBSnapshot -> Bool
== :: CopyDBSnapshot -> CopyDBSnapshot -> Bool
$c== :: CopyDBSnapshot -> CopyDBSnapshot -> Bool
Prelude.Eq, ReadPrec [CopyDBSnapshot]
ReadPrec CopyDBSnapshot
Int -> ReadS CopyDBSnapshot
ReadS [CopyDBSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CopyDBSnapshot]
$creadListPrec :: ReadPrec [CopyDBSnapshot]
readPrec :: ReadPrec CopyDBSnapshot
$creadPrec :: ReadPrec CopyDBSnapshot
readList :: ReadS [CopyDBSnapshot]
$creadList :: ReadS [CopyDBSnapshot]
readsPrec :: Int -> ReadS CopyDBSnapshot
$creadsPrec :: Int -> ReadS CopyDBSnapshot
Prelude.Read, Int -> CopyDBSnapshot -> ShowS
[CopyDBSnapshot] -> ShowS
CopyDBSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyDBSnapshot] -> ShowS
$cshowList :: [CopyDBSnapshot] -> ShowS
show :: CopyDBSnapshot -> String
$cshow :: CopyDBSnapshot -> String
showsPrec :: Int -> CopyDBSnapshot -> ShowS
$cshowsPrec :: Int -> CopyDBSnapshot -> ShowS
Prelude.Show, forall x. Rep CopyDBSnapshot x -> CopyDBSnapshot
forall x. CopyDBSnapshot -> Rep CopyDBSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyDBSnapshot x -> CopyDBSnapshot
$cfrom :: forall x. CopyDBSnapshot -> Rep CopyDBSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'CopyDBSnapshot' 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:
--
-- 'copyOptionGroup', 'copyDBSnapshot_copyOptionGroup' - A value that indicates whether to copy the DB option group associated
-- with the source DB snapshot to the target Amazon Web Services account
-- and associate with the target DB snapshot. The associated option group
-- can be copied only with cross-account snapshot copy calls.
--
-- 'copyTags', 'copyDBSnapshot_copyTags' - A value that indicates whether to copy all tags from the source DB
-- snapshot to the target DB snapshot. By default, tags aren\'t copied.
--
-- 'destinationRegion', 'copyDBSnapshot_destinationRegion' - Pseudo-parameter used when populating the @PreSignedUrl@ of a
-- cross-region @CopyDBSnapshot@ request. To replicate from region @SRC@ to
-- region @DST@, send a request to region @DST@. In that request, pass a
-- @PreSignedUrl@ for region @SRC@ with @DestinationRegion@ set to region
-- @DST@.
--
-- 'kmsKeyId', 'copyDBSnapshot_kmsKeyId' - The Amazon Web Services KMS key identifier for an encrypted DB snapshot.
-- The Amazon Web Services KMS key identifier is the key ARN, key ID, alias
-- ARN, or alias name for the KMS key.
--
-- If you copy an encrypted DB snapshot from your Amazon Web Services
-- account, you can specify a value for this parameter to encrypt the copy
-- with a new KMS key. If you don\'t specify a value for this parameter,
-- then the copy of the DB snapshot is encrypted with the same Amazon Web
-- Services KMS key as the source DB snapshot.
--
-- If you copy an encrypted DB snapshot that is shared from another Amazon
-- Web Services account, then you must specify a value for this parameter.
--
-- If you specify this parameter when you copy an unencrypted snapshot, the
-- copy is encrypted.
--
-- If you copy an encrypted snapshot to a different Amazon Web Services
-- Region, then you must specify an Amazon Web Services KMS key identifier
-- for the destination Amazon Web Services Region. KMS keys are specific to
-- the Amazon Web Services Region that they are created in, and you can\'t
-- use KMS keys from one Amazon Web Services Region in another Amazon Web
-- Services Region.
--
-- 'optionGroupName', 'copyDBSnapshot_optionGroupName' - The name of an option group to associate with the copy of the snapshot.
--
-- Specify this option if you are copying a snapshot from one Amazon Web
-- Services Region to another, and your DB instance uses a nondefault
-- option group. If your source DB instance uses Transparent Data
-- Encryption for Oracle or Microsoft SQL Server, you must specify this
-- option when copying across Amazon Web Services Regions. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_CopySnapshot.html#USER_CopySnapshot.Options Option group considerations>
-- in the /Amazon RDS User Guide/.
--
-- 'preSignedUrl', 'copyDBSnapshot_preSignedUrl' - When you are copying a snapshot from one Amazon Web Services GovCloud
-- (US) Region to another, the URL that contains a Signature Version 4
-- signed request for the @CopyDBSnapshot@ API operation in the source
-- Amazon Web Services Region that contains the source DB snapshot to copy.
--
-- This setting applies only to Amazon Web Services GovCloud (US) Regions.
-- It\'s ignored in other Amazon Web Services Regions.
--
-- You must specify this parameter when you copy an encrypted DB snapshot
-- from another Amazon Web Services Region by using the Amazon RDS API.
-- Don\'t specify @PreSignedUrl@ when you are copying an encrypted DB
-- snapshot in the same Amazon Web Services Region.
--
-- The presigned URL must be a valid request for the
-- @CopyDBClusterSnapshot@ API operation that can run in the source Amazon
-- Web Services Region that contains the encrypted DB cluster snapshot to
-- copy. The presigned URL request must contain the following parameter
-- values:
--
-- -   @DestinationRegion@ - The Amazon Web Services Region that the
--     encrypted DB snapshot is copied to. This Amazon Web Services Region
--     is the same one where the @CopyDBSnapshot@ operation is called that
--     contains this presigned URL.
--
--     For example, if you copy an encrypted DB snapshot from the us-west-2
--     Amazon Web Services Region to the us-east-1 Amazon Web Services
--     Region, then you call the @CopyDBSnapshot@ operation in the
--     us-east-1 Amazon Web Services Region and provide a presigned URL
--     that contains a call to the @CopyDBSnapshot@ operation in the
--     us-west-2 Amazon Web Services Region. For this example, the
--     @DestinationRegion@ in the presigned URL must be set to the
--     us-east-1 Amazon Web Services Region.
--
-- -   @KmsKeyId@ - The KMS key identifier for the KMS key to use to
--     encrypt the copy of the DB snapshot in the destination Amazon Web
--     Services Region. This is the same identifier for both the
--     @CopyDBSnapshot@ operation that is called in the destination Amazon
--     Web Services Region, and the operation contained in the presigned
--     URL.
--
-- -   @SourceDBSnapshotIdentifier@ - The DB snapshot identifier for the
--     encrypted snapshot to be copied. This identifier must be in the
--     Amazon Resource Name (ARN) format for the source Amazon Web Services
--     Region. For example, if you are copying an encrypted DB snapshot
--     from the us-west-2 Amazon Web Services Region, then your
--     @SourceDBSnapshotIdentifier@ looks like the following example:
--     @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20161115@.
--
-- To learn how to generate a Signature Version 4 signed request, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html Authenticating Requests: Using Query Parameters (Amazon Web Services Signature Version 4)>
-- and
-- <https://docs.aws.amazon.com/general/latest/gr/signature-version-4.html Signature Version 4 Signing Process>.
--
-- If you are using an Amazon Web Services SDK tool or the CLI, you can
-- specify @SourceRegion@ (or @--source-region@ for the CLI) instead of
-- specifying @PreSignedUrl@ manually. Specifying @SourceRegion@
-- autogenerates a presigned URL that is a valid request for the operation
-- that can run in the source Amazon Web Services Region.
--
-- 'tags', 'copyDBSnapshot_tags' - Undocumented member.
--
-- 'targetCustomAvailabilityZone', 'copyDBSnapshot_targetCustomAvailabilityZone' - The external custom Availability Zone (CAZ) identifier for the target
-- CAZ.
--
-- Example: @rds-caz-aiqhTgQv@.
--
-- 'sourceDBSnapshotIdentifier', 'copyDBSnapshot_sourceDBSnapshotIdentifier' - The identifier for the source DB snapshot.
--
-- If the source snapshot is in the same Amazon Web Services Region as the
-- copy, specify a valid DB snapshot identifier. For example, you might
-- specify @rds:mysql-instance1-snapshot-20130805@.
--
-- If the source snapshot is in a different Amazon Web Services Region than
-- the copy, specify a valid DB snapshot ARN. For example, you might
-- specify
-- @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20130805@.
--
-- If you are copying from a shared manual DB snapshot, this parameter must
-- be the Amazon Resource Name (ARN) of the shared DB snapshot.
--
-- If you are copying an encrypted snapshot this parameter must be in the
-- ARN format for the source Amazon Web Services Region.
--
-- Constraints:
--
-- -   Must specify a valid system snapshot in the \"available\" state.
--
-- Example: @rds:mydb-2012-04-02-00-01@
--
-- Example:
-- @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20130805@
--
-- 'targetDBSnapshotIdentifier', 'copyDBSnapshot_targetDBSnapshotIdentifier' - The identifier for the copy of the snapshot.
--
-- 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-db-snapshot@
newCopyDBSnapshot ::
  -- | 'sourceDBSnapshotIdentifier'
  Prelude.Text ->
  -- | 'targetDBSnapshotIdentifier'
  Prelude.Text ->
  CopyDBSnapshot
newCopyDBSnapshot :: Text -> Text -> CopyDBSnapshot
newCopyDBSnapshot
  Text
pSourceDBSnapshotIdentifier_
  Text
pTargetDBSnapshotIdentifier_ =
    CopyDBSnapshot'
      { $sel:copyOptionGroup:CopyDBSnapshot' :: Maybe Bool
copyOptionGroup = forall a. Maybe a
Prelude.Nothing,
        $sel:copyTags:CopyDBSnapshot' :: Maybe Bool
copyTags = forall a. Maybe a
Prelude.Nothing,
        $sel:destinationRegion:CopyDBSnapshot' :: Maybe Text
destinationRegion = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:CopyDBSnapshot' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:optionGroupName:CopyDBSnapshot' :: Maybe Text
optionGroupName = forall a. Maybe a
Prelude.Nothing,
        $sel:preSignedUrl:CopyDBSnapshot' :: Maybe Text
preSignedUrl = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CopyDBSnapshot' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:targetCustomAvailabilityZone:CopyDBSnapshot' :: Maybe Text
targetCustomAvailabilityZone = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceDBSnapshotIdentifier:CopyDBSnapshot' :: Text
sourceDBSnapshotIdentifier =
          Text
pSourceDBSnapshotIdentifier_,
        $sel:targetDBSnapshotIdentifier:CopyDBSnapshot' :: Text
targetDBSnapshotIdentifier =
          Text
pTargetDBSnapshotIdentifier_
      }

-- | A value that indicates whether to copy the DB option group associated
-- with the source DB snapshot to the target Amazon Web Services account
-- and associate with the target DB snapshot. The associated option group
-- can be copied only with cross-account snapshot copy calls.
copyDBSnapshot_copyOptionGroup :: Lens.Lens' CopyDBSnapshot (Prelude.Maybe Prelude.Bool)
copyDBSnapshot_copyOptionGroup :: Lens' CopyDBSnapshot (Maybe Bool)
copyDBSnapshot_copyOptionGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Maybe Bool
copyOptionGroup :: Maybe Bool
$sel:copyOptionGroup:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Bool
copyOptionGroup} -> Maybe Bool
copyOptionGroup) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Maybe Bool
a -> CopyDBSnapshot
s {$sel:copyOptionGroup:CopyDBSnapshot' :: Maybe Bool
copyOptionGroup = Maybe Bool
a} :: CopyDBSnapshot)

-- | A value that indicates whether to copy all tags from the source DB
-- snapshot to the target DB snapshot. By default, tags aren\'t copied.
copyDBSnapshot_copyTags :: Lens.Lens' CopyDBSnapshot (Prelude.Maybe Prelude.Bool)
copyDBSnapshot_copyTags :: Lens' CopyDBSnapshot (Maybe Bool)
copyDBSnapshot_copyTags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Maybe Bool
copyTags :: Maybe Bool
$sel:copyTags:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Bool
copyTags} -> Maybe Bool
copyTags) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Maybe Bool
a -> CopyDBSnapshot
s {$sel:copyTags:CopyDBSnapshot' :: Maybe Bool
copyTags = Maybe Bool
a} :: CopyDBSnapshot)

-- | Pseudo-parameter used when populating the @PreSignedUrl@ of a
-- cross-region @CopyDBSnapshot@ request. To replicate from region @SRC@ to
-- region @DST@, send a request to region @DST@. In that request, pass a
-- @PreSignedUrl@ for region @SRC@ with @DestinationRegion@ set to region
-- @DST@.
copyDBSnapshot_destinationRegion :: Lens.Lens' CopyDBSnapshot (Prelude.Maybe Prelude.Text)
copyDBSnapshot_destinationRegion :: Lens' CopyDBSnapshot (Maybe Text)
copyDBSnapshot_destinationRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Maybe Text
destinationRegion :: Maybe Text
$sel:destinationRegion:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
destinationRegion} -> Maybe Text
destinationRegion) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Maybe Text
a -> CopyDBSnapshot
s {$sel:destinationRegion:CopyDBSnapshot' :: Maybe Text
destinationRegion = Maybe Text
a} :: CopyDBSnapshot)

-- | The Amazon Web Services KMS key identifier for an encrypted DB snapshot.
-- The Amazon Web Services KMS key identifier is the key ARN, key ID, alias
-- ARN, or alias name for the KMS key.
--
-- If you copy an encrypted DB snapshot from your Amazon Web Services
-- account, you can specify a value for this parameter to encrypt the copy
-- with a new KMS key. If you don\'t specify a value for this parameter,
-- then the copy of the DB snapshot is encrypted with the same Amazon Web
-- Services KMS key as the source DB snapshot.
--
-- If you copy an encrypted DB snapshot that is shared from another Amazon
-- Web Services account, then you must specify a value for this parameter.
--
-- If you specify this parameter when you copy an unencrypted snapshot, the
-- copy is encrypted.
--
-- If you copy an encrypted snapshot to a different Amazon Web Services
-- Region, then you must specify an Amazon Web Services KMS key identifier
-- for the destination Amazon Web Services Region. KMS keys are specific to
-- the Amazon Web Services Region that they are created in, and you can\'t
-- use KMS keys from one Amazon Web Services Region in another Amazon Web
-- Services Region.
copyDBSnapshot_kmsKeyId :: Lens.Lens' CopyDBSnapshot (Prelude.Maybe Prelude.Text)
copyDBSnapshot_kmsKeyId :: Lens' CopyDBSnapshot (Maybe Text)
copyDBSnapshot_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Maybe Text
a -> CopyDBSnapshot
s {$sel:kmsKeyId:CopyDBSnapshot' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CopyDBSnapshot)

-- | The name of an option group to associate with the copy of the snapshot.
--
-- Specify this option if you are copying a snapshot from one Amazon Web
-- Services Region to another, and your DB instance uses a nondefault
-- option group. If your source DB instance uses Transparent Data
-- Encryption for Oracle or Microsoft SQL Server, you must specify this
-- option when copying across Amazon Web Services Regions. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonRDS/latest/UserGuide/USER_CopySnapshot.html#USER_CopySnapshot.Options Option group considerations>
-- in the /Amazon RDS User Guide/.
copyDBSnapshot_optionGroupName :: Lens.Lens' CopyDBSnapshot (Prelude.Maybe Prelude.Text)
copyDBSnapshot_optionGroupName :: Lens' CopyDBSnapshot (Maybe Text)
copyDBSnapshot_optionGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Maybe Text
optionGroupName :: Maybe Text
$sel:optionGroupName:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
optionGroupName} -> Maybe Text
optionGroupName) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Maybe Text
a -> CopyDBSnapshot
s {$sel:optionGroupName:CopyDBSnapshot' :: Maybe Text
optionGroupName = Maybe Text
a} :: CopyDBSnapshot)

-- | When you are copying a snapshot from one Amazon Web Services GovCloud
-- (US) Region to another, the URL that contains a Signature Version 4
-- signed request for the @CopyDBSnapshot@ API operation in the source
-- Amazon Web Services Region that contains the source DB snapshot to copy.
--
-- This setting applies only to Amazon Web Services GovCloud (US) Regions.
-- It\'s ignored in other Amazon Web Services Regions.
--
-- You must specify this parameter when you copy an encrypted DB snapshot
-- from another Amazon Web Services Region by using the Amazon RDS API.
-- Don\'t specify @PreSignedUrl@ when you are copying an encrypted DB
-- snapshot in the same Amazon Web Services Region.
--
-- The presigned URL must be a valid request for the
-- @CopyDBClusterSnapshot@ API operation that can run in the source Amazon
-- Web Services Region that contains the encrypted DB cluster snapshot to
-- copy. The presigned URL request must contain the following parameter
-- values:
--
-- -   @DestinationRegion@ - The Amazon Web Services Region that the
--     encrypted DB snapshot is copied to. This Amazon Web Services Region
--     is the same one where the @CopyDBSnapshot@ operation is called that
--     contains this presigned URL.
--
--     For example, if you copy an encrypted DB snapshot from the us-west-2
--     Amazon Web Services Region to the us-east-1 Amazon Web Services
--     Region, then you call the @CopyDBSnapshot@ operation in the
--     us-east-1 Amazon Web Services Region and provide a presigned URL
--     that contains a call to the @CopyDBSnapshot@ operation in the
--     us-west-2 Amazon Web Services Region. For this example, the
--     @DestinationRegion@ in the presigned URL must be set to the
--     us-east-1 Amazon Web Services Region.
--
-- -   @KmsKeyId@ - The KMS key identifier for the KMS key to use to
--     encrypt the copy of the DB snapshot in the destination Amazon Web
--     Services Region. This is the same identifier for both the
--     @CopyDBSnapshot@ operation that is called in the destination Amazon
--     Web Services Region, and the operation contained in the presigned
--     URL.
--
-- -   @SourceDBSnapshotIdentifier@ - The DB snapshot identifier for the
--     encrypted snapshot to be copied. This identifier must be in the
--     Amazon Resource Name (ARN) format for the source Amazon Web Services
--     Region. For example, if you are copying an encrypted DB snapshot
--     from the us-west-2 Amazon Web Services Region, then your
--     @SourceDBSnapshotIdentifier@ looks like the following example:
--     @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20161115@.
--
-- To learn how to generate a Signature Version 4 signed request, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/sigv4-query-string-auth.html Authenticating Requests: Using Query Parameters (Amazon Web Services Signature Version 4)>
-- and
-- <https://docs.aws.amazon.com/general/latest/gr/signature-version-4.html Signature Version 4 Signing Process>.
--
-- If you are using an Amazon Web Services SDK tool or the CLI, you can
-- specify @SourceRegion@ (or @--source-region@ for the CLI) instead of
-- specifying @PreSignedUrl@ manually. Specifying @SourceRegion@
-- autogenerates a presigned URL that is a valid request for the operation
-- that can run in the source Amazon Web Services Region.
copyDBSnapshot_preSignedUrl :: Lens.Lens' CopyDBSnapshot (Prelude.Maybe Prelude.Text)
copyDBSnapshot_preSignedUrl :: Lens' CopyDBSnapshot (Maybe Text)
copyDBSnapshot_preSignedUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Maybe Text
preSignedUrl :: Maybe Text
$sel:preSignedUrl:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
preSignedUrl} -> Maybe Text
preSignedUrl) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Maybe Text
a -> CopyDBSnapshot
s {$sel:preSignedUrl:CopyDBSnapshot' :: Maybe Text
preSignedUrl = Maybe Text
a} :: CopyDBSnapshot)

-- | Undocumented member.
copyDBSnapshot_tags :: Lens.Lens' CopyDBSnapshot (Prelude.Maybe [Tag])
copyDBSnapshot_tags :: Lens' CopyDBSnapshot (Maybe [Tag])
copyDBSnapshot_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Maybe [Tag]
a -> CopyDBSnapshot
s {$sel:tags:CopyDBSnapshot' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CopyDBSnapshot) 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 external custom Availability Zone (CAZ) identifier for the target
-- CAZ.
--
-- Example: @rds-caz-aiqhTgQv@.
copyDBSnapshot_targetCustomAvailabilityZone :: Lens.Lens' CopyDBSnapshot (Prelude.Maybe Prelude.Text)
copyDBSnapshot_targetCustomAvailabilityZone :: Lens' CopyDBSnapshot (Maybe Text)
copyDBSnapshot_targetCustomAvailabilityZone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Maybe Text
targetCustomAvailabilityZone :: Maybe Text
$sel:targetCustomAvailabilityZone:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
targetCustomAvailabilityZone} -> Maybe Text
targetCustomAvailabilityZone) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Maybe Text
a -> CopyDBSnapshot
s {$sel:targetCustomAvailabilityZone:CopyDBSnapshot' :: Maybe Text
targetCustomAvailabilityZone = Maybe Text
a} :: CopyDBSnapshot)

-- | The identifier for the source DB snapshot.
--
-- If the source snapshot is in the same Amazon Web Services Region as the
-- copy, specify a valid DB snapshot identifier. For example, you might
-- specify @rds:mysql-instance1-snapshot-20130805@.
--
-- If the source snapshot is in a different Amazon Web Services Region than
-- the copy, specify a valid DB snapshot ARN. For example, you might
-- specify
-- @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20130805@.
--
-- If you are copying from a shared manual DB snapshot, this parameter must
-- be the Amazon Resource Name (ARN) of the shared DB snapshot.
--
-- If you are copying an encrypted snapshot this parameter must be in the
-- ARN format for the source Amazon Web Services Region.
--
-- Constraints:
--
-- -   Must specify a valid system snapshot in the \"available\" state.
--
-- Example: @rds:mydb-2012-04-02-00-01@
--
-- Example:
-- @arn:aws:rds:us-west-2:123456789012:snapshot:mysql-instance1-snapshot-20130805@
copyDBSnapshot_sourceDBSnapshotIdentifier :: Lens.Lens' CopyDBSnapshot Prelude.Text
copyDBSnapshot_sourceDBSnapshotIdentifier :: Lens' CopyDBSnapshot Text
copyDBSnapshot_sourceDBSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Text
sourceDBSnapshotIdentifier :: Text
$sel:sourceDBSnapshotIdentifier:CopyDBSnapshot' :: CopyDBSnapshot -> Text
sourceDBSnapshotIdentifier} -> Text
sourceDBSnapshotIdentifier) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Text
a -> CopyDBSnapshot
s {$sel:sourceDBSnapshotIdentifier:CopyDBSnapshot' :: Text
sourceDBSnapshotIdentifier = Text
a} :: CopyDBSnapshot)

-- | The identifier for the copy of the snapshot.
--
-- 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-db-snapshot@
copyDBSnapshot_targetDBSnapshotIdentifier :: Lens.Lens' CopyDBSnapshot Prelude.Text
copyDBSnapshot_targetDBSnapshotIdentifier :: Lens' CopyDBSnapshot Text
copyDBSnapshot_targetDBSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshot' {Text
targetDBSnapshotIdentifier :: Text
$sel:targetDBSnapshotIdentifier:CopyDBSnapshot' :: CopyDBSnapshot -> Text
targetDBSnapshotIdentifier} -> Text
targetDBSnapshotIdentifier) (\s :: CopyDBSnapshot
s@CopyDBSnapshot' {} Text
a -> CopyDBSnapshot
s {$sel:targetDBSnapshotIdentifier:CopyDBSnapshot' :: Text
targetDBSnapshotIdentifier = Text
a} :: CopyDBSnapshot)

instance Core.AWSRequest CopyDBSnapshot where
  type
    AWSResponse CopyDBSnapshot =
      CopyDBSnapshotResponse
  request :: (Service -> Service) -> CopyDBSnapshot -> Request CopyDBSnapshot
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 CopyDBSnapshot
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CopyDBSnapshot)))
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
"CopyDBSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBSnapshot -> Int -> CopyDBSnapshotResponse
CopyDBSnapshotResponse'
            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
"DBSnapshot")
            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 CopyDBSnapshot where
  hashWithSalt :: Int -> CopyDBSnapshot -> Int
hashWithSalt Int
_salt CopyDBSnapshot' {Maybe Bool
Maybe [Tag]
Maybe Text
Text
targetDBSnapshotIdentifier :: Text
sourceDBSnapshotIdentifier :: Text
targetCustomAvailabilityZone :: Maybe Text
tags :: Maybe [Tag]
preSignedUrl :: Maybe Text
optionGroupName :: Maybe Text
kmsKeyId :: Maybe Text
destinationRegion :: Maybe Text
copyTags :: Maybe Bool
copyOptionGroup :: Maybe Bool
$sel:targetDBSnapshotIdentifier:CopyDBSnapshot' :: CopyDBSnapshot -> Text
$sel:sourceDBSnapshotIdentifier:CopyDBSnapshot' :: CopyDBSnapshot -> Text
$sel:targetCustomAvailabilityZone:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:tags:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe [Tag]
$sel:preSignedUrl:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:optionGroupName:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:kmsKeyId:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:destinationRegion:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:copyTags:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Bool
$sel:copyOptionGroup:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyOptionGroup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
copyTags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destinationRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
optionGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preSignedUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetCustomAvailabilityZone
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceDBSnapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetDBSnapshotIdentifier

instance Prelude.NFData CopyDBSnapshot where
  rnf :: CopyDBSnapshot -> ()
rnf CopyDBSnapshot' {Maybe Bool
Maybe [Tag]
Maybe Text
Text
targetDBSnapshotIdentifier :: Text
sourceDBSnapshotIdentifier :: Text
targetCustomAvailabilityZone :: Maybe Text
tags :: Maybe [Tag]
preSignedUrl :: Maybe Text
optionGroupName :: Maybe Text
kmsKeyId :: Maybe Text
destinationRegion :: Maybe Text
copyTags :: Maybe Bool
copyOptionGroup :: Maybe Bool
$sel:targetDBSnapshotIdentifier:CopyDBSnapshot' :: CopyDBSnapshot -> Text
$sel:sourceDBSnapshotIdentifier:CopyDBSnapshot' :: CopyDBSnapshot -> Text
$sel:targetCustomAvailabilityZone:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:tags:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe [Tag]
$sel:preSignedUrl:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:optionGroupName:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:kmsKeyId:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:destinationRegion:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:copyTags:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Bool
$sel:copyOptionGroup:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyOptionGroup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
copyTags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
destinationRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
optionGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preSignedUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Maybe Text
targetCustomAvailabilityZone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceDBSnapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetDBSnapshotIdentifier

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

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

instance Data.ToQuery CopyDBSnapshot where
  toQuery :: CopyDBSnapshot -> QueryString
toQuery CopyDBSnapshot' {Maybe Bool
Maybe [Tag]
Maybe Text
Text
targetDBSnapshotIdentifier :: Text
sourceDBSnapshotIdentifier :: Text
targetCustomAvailabilityZone :: Maybe Text
tags :: Maybe [Tag]
preSignedUrl :: Maybe Text
optionGroupName :: Maybe Text
kmsKeyId :: Maybe Text
destinationRegion :: Maybe Text
copyTags :: Maybe Bool
copyOptionGroup :: Maybe Bool
$sel:targetDBSnapshotIdentifier:CopyDBSnapshot' :: CopyDBSnapshot -> Text
$sel:sourceDBSnapshotIdentifier:CopyDBSnapshot' :: CopyDBSnapshot -> Text
$sel:targetCustomAvailabilityZone:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:tags:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe [Tag]
$sel:preSignedUrl:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:optionGroupName:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:kmsKeyId:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:destinationRegion:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Text
$sel:copyTags:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Bool
$sel:copyOptionGroup:CopyDBSnapshot' :: CopyDBSnapshot -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CopyDBSnapshot" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"CopyOptionGroup" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
copyOptionGroup,
        ByteString
"CopyTags" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
copyTags,
        ByteString
"DestinationRegion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
destinationRegion,
        ByteString
"KmsKeyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
kmsKeyId,
        ByteString
"OptionGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
optionGroupName,
        ByteString
"PreSignedUrl" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
preSignedUrl,
        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
"TargetCustomAvailabilityZone"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
targetCustomAvailabilityZone,
        ByteString
"SourceDBSnapshotIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceDBSnapshotIdentifier,
        ByteString
"TargetDBSnapshotIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetDBSnapshotIdentifier
      ]

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

-- |
-- Create a value of 'CopyDBSnapshotResponse' 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:
--
-- 'dbSnapshot', 'copyDBSnapshotResponse_dbSnapshot' - Undocumented member.
--
-- 'httpStatus', 'copyDBSnapshotResponse_httpStatus' - The response's http status code.
newCopyDBSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CopyDBSnapshotResponse
newCopyDBSnapshotResponse :: Int -> CopyDBSnapshotResponse
newCopyDBSnapshotResponse Int
pHttpStatus_ =
  CopyDBSnapshotResponse'
    { $sel:dbSnapshot:CopyDBSnapshotResponse' :: Maybe DBSnapshot
dbSnapshot =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CopyDBSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
copyDBSnapshotResponse_dbSnapshot :: Lens.Lens' CopyDBSnapshotResponse (Prelude.Maybe DBSnapshot)
copyDBSnapshotResponse_dbSnapshot :: Lens' CopyDBSnapshotResponse (Maybe DBSnapshot)
copyDBSnapshotResponse_dbSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyDBSnapshotResponse' {Maybe DBSnapshot
dbSnapshot :: Maybe DBSnapshot
$sel:dbSnapshot:CopyDBSnapshotResponse' :: CopyDBSnapshotResponse -> Maybe DBSnapshot
dbSnapshot} -> Maybe DBSnapshot
dbSnapshot) (\s :: CopyDBSnapshotResponse
s@CopyDBSnapshotResponse' {} Maybe DBSnapshot
a -> CopyDBSnapshotResponse
s {$sel:dbSnapshot:CopyDBSnapshotResponse' :: Maybe DBSnapshot
dbSnapshot = Maybe DBSnapshot
a} :: CopyDBSnapshotResponse)

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

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