{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Redshift.CopyClusterSnapshot
-- 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 automated cluster snapshot to a new manual cluster
-- snapshot. The source must be an automated snapshot and it must be in the
-- available state.
--
-- When you delete a cluster, Amazon Redshift deletes any automated
-- snapshots of the cluster. Also, when the retention period of the
-- snapshot expires, Amazon Redshift automatically deletes it. If you want
-- to keep an automated snapshot for a longer period, you can make a manual
-- copy of the snapshot. Manual snapshots are retained until you delete
-- them.
--
-- For more information about working with snapshots, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-snapshots.html Amazon Redshift Snapshots>
-- in the /Amazon Redshift Cluster Management Guide/.
module Amazonka.Redshift.CopyClusterSnapshot
  ( -- * Creating a Request
    CopyClusterSnapshot (..),
    newCopyClusterSnapshot,

    -- * Request Lenses
    copyClusterSnapshot_manualSnapshotRetentionPeriod,
    copyClusterSnapshot_sourceSnapshotClusterIdentifier,
    copyClusterSnapshot_sourceSnapshotIdentifier,
    copyClusterSnapshot_targetSnapshotIdentifier,

    -- * Destructuring the Response
    CopyClusterSnapshotResponse (..),
    newCopyClusterSnapshotResponse,

    -- * Response Lenses
    copyClusterSnapshotResponse_snapshot,
    copyClusterSnapshotResponse_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.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newCopyClusterSnapshot' smart constructor.
data CopyClusterSnapshot = CopyClusterSnapshot'
  { -- | The number of days that a manual snapshot is retained. If the value is
    -- -1, the manual snapshot is retained indefinitely.
    --
    -- The value must be either -1 or an integer between 1 and 3,653.
    --
    -- The default value is -1.
    CopyClusterSnapshot -> Maybe Int
manualSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The identifier of the cluster the source snapshot was created from. This
    -- parameter is required if your IAM user has a policy containing a
    -- snapshot resource element that specifies anything other than * for the
    -- cluster name.
    --
    -- Constraints:
    --
    -- -   Must be the identifier for a valid cluster.
    CopyClusterSnapshot -> Maybe Text
sourceSnapshotClusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The identifier for the source snapshot.
    --
    -- Constraints:
    --
    -- -   Must be the identifier for a valid automated snapshot whose state is
    --     @available@.
    CopyClusterSnapshot -> Text
sourceSnapshotIdentifier :: Prelude.Text,
    -- | The identifier given to the new manual snapshot.
    --
    -- Constraints:
    --
    -- -   Cannot be null, empty, or blank.
    --
    -- -   Must contain from 1 to 255 alphanumeric characters or hyphens.
    --
    -- -   First character must be a letter.
    --
    -- -   Cannot end with a hyphen or contain two consecutive hyphens.
    --
    -- -   Must be unique for the Amazon Web Services account that is making
    --     the request.
    CopyClusterSnapshot -> Text
targetSnapshotIdentifier :: Prelude.Text
  }
  deriving (CopyClusterSnapshot -> CopyClusterSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyClusterSnapshot -> CopyClusterSnapshot -> Bool
$c/= :: CopyClusterSnapshot -> CopyClusterSnapshot -> Bool
== :: CopyClusterSnapshot -> CopyClusterSnapshot -> Bool
$c== :: CopyClusterSnapshot -> CopyClusterSnapshot -> Bool
Prelude.Eq, ReadPrec [CopyClusterSnapshot]
ReadPrec CopyClusterSnapshot
Int -> ReadS CopyClusterSnapshot
ReadS [CopyClusterSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CopyClusterSnapshot]
$creadListPrec :: ReadPrec [CopyClusterSnapshot]
readPrec :: ReadPrec CopyClusterSnapshot
$creadPrec :: ReadPrec CopyClusterSnapshot
readList :: ReadS [CopyClusterSnapshot]
$creadList :: ReadS [CopyClusterSnapshot]
readsPrec :: Int -> ReadS CopyClusterSnapshot
$creadsPrec :: Int -> ReadS CopyClusterSnapshot
Prelude.Read, Int -> CopyClusterSnapshot -> ShowS
[CopyClusterSnapshot] -> ShowS
CopyClusterSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CopyClusterSnapshot] -> ShowS
$cshowList :: [CopyClusterSnapshot] -> ShowS
show :: CopyClusterSnapshot -> String
$cshow :: CopyClusterSnapshot -> String
showsPrec :: Int -> CopyClusterSnapshot -> ShowS
$cshowsPrec :: Int -> CopyClusterSnapshot -> ShowS
Prelude.Show, forall x. Rep CopyClusterSnapshot x -> CopyClusterSnapshot
forall x. CopyClusterSnapshot -> Rep CopyClusterSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CopyClusterSnapshot x -> CopyClusterSnapshot
$cfrom :: forall x. CopyClusterSnapshot -> Rep CopyClusterSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'CopyClusterSnapshot' 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:
--
-- 'manualSnapshotRetentionPeriod', 'copyClusterSnapshot_manualSnapshotRetentionPeriod' - The number of days that a manual snapshot is retained. If the value is
-- -1, the manual snapshot is retained indefinitely.
--
-- The value must be either -1 or an integer between 1 and 3,653.
--
-- The default value is -1.
--
-- 'sourceSnapshotClusterIdentifier', 'copyClusterSnapshot_sourceSnapshotClusterIdentifier' - The identifier of the cluster the source snapshot was created from. This
-- parameter is required if your IAM user has a policy containing a
-- snapshot resource element that specifies anything other than * for the
-- cluster name.
--
-- Constraints:
--
-- -   Must be the identifier for a valid cluster.
--
-- 'sourceSnapshotIdentifier', 'copyClusterSnapshot_sourceSnapshotIdentifier' - The identifier for the source snapshot.
--
-- Constraints:
--
-- -   Must be the identifier for a valid automated snapshot whose state is
--     @available@.
--
-- 'targetSnapshotIdentifier', 'copyClusterSnapshot_targetSnapshotIdentifier' - The identifier given to the new manual snapshot.
--
-- Constraints:
--
-- -   Cannot be null, empty, or blank.
--
-- -   Must contain from 1 to 255 alphanumeric characters or hyphens.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
--
-- -   Must be unique for the Amazon Web Services account that is making
--     the request.
newCopyClusterSnapshot ::
  -- | 'sourceSnapshotIdentifier'
  Prelude.Text ->
  -- | 'targetSnapshotIdentifier'
  Prelude.Text ->
  CopyClusterSnapshot
newCopyClusterSnapshot :: Text -> Text -> CopyClusterSnapshot
newCopyClusterSnapshot
  Text
pSourceSnapshotIdentifier_
  Text
pTargetSnapshotIdentifier_ =
    CopyClusterSnapshot'
      { $sel:manualSnapshotRetentionPeriod:CopyClusterSnapshot' :: Maybe Int
manualSnapshotRetentionPeriod =
          forall a. Maybe a
Prelude.Nothing,
        $sel:sourceSnapshotClusterIdentifier:CopyClusterSnapshot' :: Maybe Text
sourceSnapshotClusterIdentifier = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceSnapshotIdentifier:CopyClusterSnapshot' :: Text
sourceSnapshotIdentifier =
          Text
pSourceSnapshotIdentifier_,
        $sel:targetSnapshotIdentifier:CopyClusterSnapshot' :: Text
targetSnapshotIdentifier =
          Text
pTargetSnapshotIdentifier_
      }

-- | The number of days that a manual snapshot is retained. If the value is
-- -1, the manual snapshot is retained indefinitely.
--
-- The value must be either -1 or an integer between 1 and 3,653.
--
-- The default value is -1.
copyClusterSnapshot_manualSnapshotRetentionPeriod :: Lens.Lens' CopyClusterSnapshot (Prelude.Maybe Prelude.Int)
copyClusterSnapshot_manualSnapshotRetentionPeriod :: Lens' CopyClusterSnapshot (Maybe Int)
copyClusterSnapshot_manualSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyClusterSnapshot' {Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:manualSnapshotRetentionPeriod:CopyClusterSnapshot' :: CopyClusterSnapshot -> Maybe Int
manualSnapshotRetentionPeriod} -> Maybe Int
manualSnapshotRetentionPeriod) (\s :: CopyClusterSnapshot
s@CopyClusterSnapshot' {} Maybe Int
a -> CopyClusterSnapshot
s {$sel:manualSnapshotRetentionPeriod:CopyClusterSnapshot' :: Maybe Int
manualSnapshotRetentionPeriod = Maybe Int
a} :: CopyClusterSnapshot)

-- | The identifier of the cluster the source snapshot was created from. This
-- parameter is required if your IAM user has a policy containing a
-- snapshot resource element that specifies anything other than * for the
-- cluster name.
--
-- Constraints:
--
-- -   Must be the identifier for a valid cluster.
copyClusterSnapshot_sourceSnapshotClusterIdentifier :: Lens.Lens' CopyClusterSnapshot (Prelude.Maybe Prelude.Text)
copyClusterSnapshot_sourceSnapshotClusterIdentifier :: Lens' CopyClusterSnapshot (Maybe Text)
copyClusterSnapshot_sourceSnapshotClusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyClusterSnapshot' {Maybe Text
sourceSnapshotClusterIdentifier :: Maybe Text
$sel:sourceSnapshotClusterIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Maybe Text
sourceSnapshotClusterIdentifier} -> Maybe Text
sourceSnapshotClusterIdentifier) (\s :: CopyClusterSnapshot
s@CopyClusterSnapshot' {} Maybe Text
a -> CopyClusterSnapshot
s {$sel:sourceSnapshotClusterIdentifier:CopyClusterSnapshot' :: Maybe Text
sourceSnapshotClusterIdentifier = Maybe Text
a} :: CopyClusterSnapshot)

-- | The identifier for the source snapshot.
--
-- Constraints:
--
-- -   Must be the identifier for a valid automated snapshot whose state is
--     @available@.
copyClusterSnapshot_sourceSnapshotIdentifier :: Lens.Lens' CopyClusterSnapshot Prelude.Text
copyClusterSnapshot_sourceSnapshotIdentifier :: Lens' CopyClusterSnapshot Text
copyClusterSnapshot_sourceSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyClusterSnapshot' {Text
sourceSnapshotIdentifier :: Text
$sel:sourceSnapshotIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Text
sourceSnapshotIdentifier} -> Text
sourceSnapshotIdentifier) (\s :: CopyClusterSnapshot
s@CopyClusterSnapshot' {} Text
a -> CopyClusterSnapshot
s {$sel:sourceSnapshotIdentifier:CopyClusterSnapshot' :: Text
sourceSnapshotIdentifier = Text
a} :: CopyClusterSnapshot)

-- | The identifier given to the new manual snapshot.
--
-- Constraints:
--
-- -   Cannot be null, empty, or blank.
--
-- -   Must contain from 1 to 255 alphanumeric characters or hyphens.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
--
-- -   Must be unique for the Amazon Web Services account that is making
--     the request.
copyClusterSnapshot_targetSnapshotIdentifier :: Lens.Lens' CopyClusterSnapshot Prelude.Text
copyClusterSnapshot_targetSnapshotIdentifier :: Lens' CopyClusterSnapshot Text
copyClusterSnapshot_targetSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyClusterSnapshot' {Text
targetSnapshotIdentifier :: Text
$sel:targetSnapshotIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Text
targetSnapshotIdentifier} -> Text
targetSnapshotIdentifier) (\s :: CopyClusterSnapshot
s@CopyClusterSnapshot' {} Text
a -> CopyClusterSnapshot
s {$sel:targetSnapshotIdentifier:CopyClusterSnapshot' :: Text
targetSnapshotIdentifier = Text
a} :: CopyClusterSnapshot)

instance Core.AWSRequest CopyClusterSnapshot where
  type
    AWSResponse CopyClusterSnapshot =
      CopyClusterSnapshotResponse
  request :: (Service -> Service)
-> CopyClusterSnapshot -> Request CopyClusterSnapshot
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 CopyClusterSnapshot
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CopyClusterSnapshot)))
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
"CopyClusterSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Snapshot -> Int -> CopyClusterSnapshotResponse
CopyClusterSnapshotResponse'
            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
"Snapshot")
            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 CopyClusterSnapshot where
  hashWithSalt :: Int -> CopyClusterSnapshot -> Int
hashWithSalt Int
_salt CopyClusterSnapshot' {Maybe Int
Maybe Text
Text
targetSnapshotIdentifier :: Text
sourceSnapshotIdentifier :: Text
sourceSnapshotClusterIdentifier :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
$sel:targetSnapshotIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Text
$sel:sourceSnapshotIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Text
$sel:sourceSnapshotClusterIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Maybe Text
$sel:manualSnapshotRetentionPeriod:CopyClusterSnapshot' :: CopyClusterSnapshot -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
manualSnapshotRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceSnapshotClusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sourceSnapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
targetSnapshotIdentifier

instance Prelude.NFData CopyClusterSnapshot where
  rnf :: CopyClusterSnapshot -> ()
rnf CopyClusterSnapshot' {Maybe Int
Maybe Text
Text
targetSnapshotIdentifier :: Text
sourceSnapshotIdentifier :: Text
sourceSnapshotClusterIdentifier :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
$sel:targetSnapshotIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Text
$sel:sourceSnapshotIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Text
$sel:sourceSnapshotClusterIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Maybe Text
$sel:manualSnapshotRetentionPeriod:CopyClusterSnapshot' :: CopyClusterSnapshot -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
manualSnapshotRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceSnapshotClusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sourceSnapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
targetSnapshotIdentifier

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

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

instance Data.ToQuery CopyClusterSnapshot where
  toQuery :: CopyClusterSnapshot -> QueryString
toQuery CopyClusterSnapshot' {Maybe Int
Maybe Text
Text
targetSnapshotIdentifier :: Text
sourceSnapshotIdentifier :: Text
sourceSnapshotClusterIdentifier :: Maybe Text
manualSnapshotRetentionPeriod :: Maybe Int
$sel:targetSnapshotIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Text
$sel:sourceSnapshotIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Text
$sel:sourceSnapshotClusterIdentifier:CopyClusterSnapshot' :: CopyClusterSnapshot -> Maybe Text
$sel:manualSnapshotRetentionPeriod:CopyClusterSnapshot' :: CopyClusterSnapshot -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CopyClusterSnapshot" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"ManualSnapshotRetentionPeriod"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
manualSnapshotRetentionPeriod,
        ByteString
"SourceSnapshotClusterIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
sourceSnapshotClusterIdentifier,
        ByteString
"SourceSnapshotIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
sourceSnapshotIdentifier,
        ByteString
"TargetSnapshotIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
targetSnapshotIdentifier
      ]

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

-- |
-- Create a value of 'CopyClusterSnapshotResponse' 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:
--
-- 'snapshot', 'copyClusterSnapshotResponse_snapshot' - Undocumented member.
--
-- 'httpStatus', 'copyClusterSnapshotResponse_httpStatus' - The response's http status code.
newCopyClusterSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CopyClusterSnapshotResponse
newCopyClusterSnapshotResponse :: Int -> CopyClusterSnapshotResponse
newCopyClusterSnapshotResponse Int
pHttpStatus_ =
  CopyClusterSnapshotResponse'
    { $sel:snapshot:CopyClusterSnapshotResponse' :: Maybe Snapshot
snapshot =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CopyClusterSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
copyClusterSnapshotResponse_snapshot :: Lens.Lens' CopyClusterSnapshotResponse (Prelude.Maybe Snapshot)
copyClusterSnapshotResponse_snapshot :: Lens' CopyClusterSnapshotResponse (Maybe Snapshot)
copyClusterSnapshotResponse_snapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CopyClusterSnapshotResponse' {Maybe Snapshot
snapshot :: Maybe Snapshot
$sel:snapshot:CopyClusterSnapshotResponse' :: CopyClusterSnapshotResponse -> Maybe Snapshot
snapshot} -> Maybe Snapshot
snapshot) (\s :: CopyClusterSnapshotResponse
s@CopyClusterSnapshotResponse' {} Maybe Snapshot
a -> CopyClusterSnapshotResponse
s {$sel:snapshot:CopyClusterSnapshotResponse' :: Maybe Snapshot
snapshot = Maybe Snapshot
a} :: CopyClusterSnapshotResponse)

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

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