{-# 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.EnableSnapshotCopy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables the automatic copy of snapshots from one region to another
-- region for a specified cluster.
module Amazonka.Redshift.EnableSnapshotCopy
  ( -- * Creating a Request
    EnableSnapshotCopy (..),
    newEnableSnapshotCopy,

    -- * Request Lenses
    enableSnapshotCopy_manualSnapshotRetentionPeriod,
    enableSnapshotCopy_retentionPeriod,
    enableSnapshotCopy_snapshotCopyGrantName,
    enableSnapshotCopy_clusterIdentifier,
    enableSnapshotCopy_destinationRegion,

    -- * Destructuring the Response
    EnableSnapshotCopyResponse (..),
    newEnableSnapshotCopyResponse,

    -- * Response Lenses
    enableSnapshotCopyResponse_cluster,
    enableSnapshotCopyResponse_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:/ 'newEnableSnapshotCopy' smart constructor.
data EnableSnapshotCopy = EnableSnapshotCopy'
  { -- | The number of days to retain newly copied snapshots in the destination
    -- Amazon Web Services Region after they are copied from the source Amazon
    -- Web Services Region. 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.
    EnableSnapshotCopy -> Maybe Int
manualSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The number of days to retain automated snapshots in the destination
    -- region after they are copied from the source region.
    --
    -- Default: 7.
    --
    -- Constraints: Must be at least 1 and no more than 35.
    EnableSnapshotCopy -> Maybe Int
retentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | The name of the snapshot copy grant to use when snapshots of an Amazon
    -- Web Services KMS-encrypted cluster are copied to the destination region.
    EnableSnapshotCopy -> Maybe Text
snapshotCopyGrantName :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the source cluster to copy snapshots from.
    --
    -- Constraints: Must be the valid name of an existing cluster that does not
    -- already have cross-region snapshot copy enabled.
    EnableSnapshotCopy -> Text
clusterIdentifier :: Prelude.Text,
    -- | The destination Amazon Web Services Region that you want to copy
    -- snapshots to.
    --
    -- Constraints: Must be the name of a valid Amazon Web Services Region. For
    -- more information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/rande.html#redshift_region Regions and Endpoints>
    -- in the Amazon Web Services General Reference.
    EnableSnapshotCopy -> Text
destinationRegion :: Prelude.Text
  }
  deriving (EnableSnapshotCopy -> EnableSnapshotCopy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableSnapshotCopy -> EnableSnapshotCopy -> Bool
$c/= :: EnableSnapshotCopy -> EnableSnapshotCopy -> Bool
== :: EnableSnapshotCopy -> EnableSnapshotCopy -> Bool
$c== :: EnableSnapshotCopy -> EnableSnapshotCopy -> Bool
Prelude.Eq, ReadPrec [EnableSnapshotCopy]
ReadPrec EnableSnapshotCopy
Int -> ReadS EnableSnapshotCopy
ReadS [EnableSnapshotCopy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableSnapshotCopy]
$creadListPrec :: ReadPrec [EnableSnapshotCopy]
readPrec :: ReadPrec EnableSnapshotCopy
$creadPrec :: ReadPrec EnableSnapshotCopy
readList :: ReadS [EnableSnapshotCopy]
$creadList :: ReadS [EnableSnapshotCopy]
readsPrec :: Int -> ReadS EnableSnapshotCopy
$creadsPrec :: Int -> ReadS EnableSnapshotCopy
Prelude.Read, Int -> EnableSnapshotCopy -> ShowS
[EnableSnapshotCopy] -> ShowS
EnableSnapshotCopy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableSnapshotCopy] -> ShowS
$cshowList :: [EnableSnapshotCopy] -> ShowS
show :: EnableSnapshotCopy -> String
$cshow :: EnableSnapshotCopy -> String
showsPrec :: Int -> EnableSnapshotCopy -> ShowS
$cshowsPrec :: Int -> EnableSnapshotCopy -> ShowS
Prelude.Show, forall x. Rep EnableSnapshotCopy x -> EnableSnapshotCopy
forall x. EnableSnapshotCopy -> Rep EnableSnapshotCopy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnableSnapshotCopy x -> EnableSnapshotCopy
$cfrom :: forall x. EnableSnapshotCopy -> Rep EnableSnapshotCopy x
Prelude.Generic)

-- |
-- Create a value of 'EnableSnapshotCopy' 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', 'enableSnapshotCopy_manualSnapshotRetentionPeriod' - The number of days to retain newly copied snapshots in the destination
-- Amazon Web Services Region after they are copied from the source Amazon
-- Web Services Region. 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.
--
-- 'retentionPeriod', 'enableSnapshotCopy_retentionPeriod' - The number of days to retain automated snapshots in the destination
-- region after they are copied from the source region.
--
-- Default: 7.
--
-- Constraints: Must be at least 1 and no more than 35.
--
-- 'snapshotCopyGrantName', 'enableSnapshotCopy_snapshotCopyGrantName' - The name of the snapshot copy grant to use when snapshots of an Amazon
-- Web Services KMS-encrypted cluster are copied to the destination region.
--
-- 'clusterIdentifier', 'enableSnapshotCopy_clusterIdentifier' - The unique identifier of the source cluster to copy snapshots from.
--
-- Constraints: Must be the valid name of an existing cluster that does not
-- already have cross-region snapshot copy enabled.
--
-- 'destinationRegion', 'enableSnapshotCopy_destinationRegion' - The destination Amazon Web Services Region that you want to copy
-- snapshots to.
--
-- Constraints: Must be the name of a valid Amazon Web Services Region. For
-- more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/rande.html#redshift_region Regions and Endpoints>
-- in the Amazon Web Services General Reference.
newEnableSnapshotCopy ::
  -- | 'clusterIdentifier'
  Prelude.Text ->
  -- | 'destinationRegion'
  Prelude.Text ->
  EnableSnapshotCopy
newEnableSnapshotCopy :: Text -> Text -> EnableSnapshotCopy
newEnableSnapshotCopy
  Text
pClusterIdentifier_
  Text
pDestinationRegion_ =
    EnableSnapshotCopy'
      { $sel:manualSnapshotRetentionPeriod:EnableSnapshotCopy' :: Maybe Int
manualSnapshotRetentionPeriod =
          forall a. Maybe a
Prelude.Nothing,
        $sel:retentionPeriod:EnableSnapshotCopy' :: Maybe Int
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
        $sel:snapshotCopyGrantName:EnableSnapshotCopy' :: Maybe Text
snapshotCopyGrantName = forall a. Maybe a
Prelude.Nothing,
        $sel:clusterIdentifier:EnableSnapshotCopy' :: Text
clusterIdentifier = Text
pClusterIdentifier_,
        $sel:destinationRegion:EnableSnapshotCopy' :: Text
destinationRegion = Text
pDestinationRegion_
      }

-- | The number of days to retain newly copied snapshots in the destination
-- Amazon Web Services Region after they are copied from the source Amazon
-- Web Services Region. 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.
enableSnapshotCopy_manualSnapshotRetentionPeriod :: Lens.Lens' EnableSnapshotCopy (Prelude.Maybe Prelude.Int)
enableSnapshotCopy_manualSnapshotRetentionPeriod :: Lens' EnableSnapshotCopy (Maybe Int)
enableSnapshotCopy_manualSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableSnapshotCopy' {Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:manualSnapshotRetentionPeriod:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Int
manualSnapshotRetentionPeriod} -> Maybe Int
manualSnapshotRetentionPeriod) (\s :: EnableSnapshotCopy
s@EnableSnapshotCopy' {} Maybe Int
a -> EnableSnapshotCopy
s {$sel:manualSnapshotRetentionPeriod:EnableSnapshotCopy' :: Maybe Int
manualSnapshotRetentionPeriod = Maybe Int
a} :: EnableSnapshotCopy)

-- | The number of days to retain automated snapshots in the destination
-- region after they are copied from the source region.
--
-- Default: 7.
--
-- Constraints: Must be at least 1 and no more than 35.
enableSnapshotCopy_retentionPeriod :: Lens.Lens' EnableSnapshotCopy (Prelude.Maybe Prelude.Int)
enableSnapshotCopy_retentionPeriod :: Lens' EnableSnapshotCopy (Maybe Int)
enableSnapshotCopy_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableSnapshotCopy' {Maybe Int
retentionPeriod :: Maybe Int
$sel:retentionPeriod:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Int
retentionPeriod} -> Maybe Int
retentionPeriod) (\s :: EnableSnapshotCopy
s@EnableSnapshotCopy' {} Maybe Int
a -> EnableSnapshotCopy
s {$sel:retentionPeriod:EnableSnapshotCopy' :: Maybe Int
retentionPeriod = Maybe Int
a} :: EnableSnapshotCopy)

-- | The name of the snapshot copy grant to use when snapshots of an Amazon
-- Web Services KMS-encrypted cluster are copied to the destination region.
enableSnapshotCopy_snapshotCopyGrantName :: Lens.Lens' EnableSnapshotCopy (Prelude.Maybe Prelude.Text)
enableSnapshotCopy_snapshotCopyGrantName :: Lens' EnableSnapshotCopy (Maybe Text)
enableSnapshotCopy_snapshotCopyGrantName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableSnapshotCopy' {Maybe Text
snapshotCopyGrantName :: Maybe Text
$sel:snapshotCopyGrantName:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Text
snapshotCopyGrantName} -> Maybe Text
snapshotCopyGrantName) (\s :: EnableSnapshotCopy
s@EnableSnapshotCopy' {} Maybe Text
a -> EnableSnapshotCopy
s {$sel:snapshotCopyGrantName:EnableSnapshotCopy' :: Maybe Text
snapshotCopyGrantName = Maybe Text
a} :: EnableSnapshotCopy)

-- | The unique identifier of the source cluster to copy snapshots from.
--
-- Constraints: Must be the valid name of an existing cluster that does not
-- already have cross-region snapshot copy enabled.
enableSnapshotCopy_clusterIdentifier :: Lens.Lens' EnableSnapshotCopy Prelude.Text
enableSnapshotCopy_clusterIdentifier :: Lens' EnableSnapshotCopy Text
enableSnapshotCopy_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableSnapshotCopy' {Text
clusterIdentifier :: Text
$sel:clusterIdentifier:EnableSnapshotCopy' :: EnableSnapshotCopy -> Text
clusterIdentifier} -> Text
clusterIdentifier) (\s :: EnableSnapshotCopy
s@EnableSnapshotCopy' {} Text
a -> EnableSnapshotCopy
s {$sel:clusterIdentifier:EnableSnapshotCopy' :: Text
clusterIdentifier = Text
a} :: EnableSnapshotCopy)

-- | The destination Amazon Web Services Region that you want to copy
-- snapshots to.
--
-- Constraints: Must be the name of a valid Amazon Web Services Region. For
-- more information, see
-- <https://docs.aws.amazon.com/general/latest/gr/rande.html#redshift_region Regions and Endpoints>
-- in the Amazon Web Services General Reference.
enableSnapshotCopy_destinationRegion :: Lens.Lens' EnableSnapshotCopy Prelude.Text
enableSnapshotCopy_destinationRegion :: Lens' EnableSnapshotCopy Text
enableSnapshotCopy_destinationRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableSnapshotCopy' {Text
destinationRegion :: Text
$sel:destinationRegion:EnableSnapshotCopy' :: EnableSnapshotCopy -> Text
destinationRegion} -> Text
destinationRegion) (\s :: EnableSnapshotCopy
s@EnableSnapshotCopy' {} Text
a -> EnableSnapshotCopy
s {$sel:destinationRegion:EnableSnapshotCopy' :: Text
destinationRegion = Text
a} :: EnableSnapshotCopy)

instance Core.AWSRequest EnableSnapshotCopy where
  type
    AWSResponse EnableSnapshotCopy =
      EnableSnapshotCopyResponse
  request :: (Service -> Service)
-> EnableSnapshotCopy -> Request EnableSnapshotCopy
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 EnableSnapshotCopy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse EnableSnapshotCopy)))
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
"EnableSnapshotCopyResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Cluster -> Int -> EnableSnapshotCopyResponse
EnableSnapshotCopyResponse'
            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
"Cluster")
            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 EnableSnapshotCopy where
  hashWithSalt :: Int -> EnableSnapshotCopy -> Int
hashWithSalt Int
_salt EnableSnapshotCopy' {Maybe Int
Maybe Text
Text
destinationRegion :: Text
clusterIdentifier :: Text
snapshotCopyGrantName :: Maybe Text
retentionPeriod :: Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:destinationRegion:EnableSnapshotCopy' :: EnableSnapshotCopy -> Text
$sel:clusterIdentifier:EnableSnapshotCopy' :: EnableSnapshotCopy -> Text
$sel:snapshotCopyGrantName:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Text
$sel:retentionPeriod:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Int
$sel:manualSnapshotRetentionPeriod:EnableSnapshotCopy' :: EnableSnapshotCopy -> 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 Int
retentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
snapshotCopyGrantName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
destinationRegion

instance Prelude.NFData EnableSnapshotCopy where
  rnf :: EnableSnapshotCopy -> ()
rnf EnableSnapshotCopy' {Maybe Int
Maybe Text
Text
destinationRegion :: Text
clusterIdentifier :: Text
snapshotCopyGrantName :: Maybe Text
retentionPeriod :: Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:destinationRegion:EnableSnapshotCopy' :: EnableSnapshotCopy -> Text
$sel:clusterIdentifier:EnableSnapshotCopy' :: EnableSnapshotCopy -> Text
$sel:snapshotCopyGrantName:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Text
$sel:retentionPeriod:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Int
$sel:manualSnapshotRetentionPeriod:EnableSnapshotCopy' :: EnableSnapshotCopy -> 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 Int
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotCopyGrantName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
destinationRegion

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

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

instance Data.ToQuery EnableSnapshotCopy where
  toQuery :: EnableSnapshotCopy -> QueryString
toQuery EnableSnapshotCopy' {Maybe Int
Maybe Text
Text
destinationRegion :: Text
clusterIdentifier :: Text
snapshotCopyGrantName :: Maybe Text
retentionPeriod :: Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:destinationRegion:EnableSnapshotCopy' :: EnableSnapshotCopy -> Text
$sel:clusterIdentifier:EnableSnapshotCopy' :: EnableSnapshotCopy -> Text
$sel:snapshotCopyGrantName:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Text
$sel:retentionPeriod:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Int
$sel:manualSnapshotRetentionPeriod:EnableSnapshotCopy' :: EnableSnapshotCopy -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"EnableSnapshotCopy" :: 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
"RetentionPeriod" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
retentionPeriod,
        ByteString
"SnapshotCopyGrantName"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
snapshotCopyGrantName,
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterIdentifier,
        ByteString
"DestinationRegion" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
destinationRegion
      ]

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

-- |
-- Create a value of 'EnableSnapshotCopyResponse' 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:
--
-- 'cluster', 'enableSnapshotCopyResponse_cluster' - Undocumented member.
--
-- 'httpStatus', 'enableSnapshotCopyResponse_httpStatus' - The response's http status code.
newEnableSnapshotCopyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  EnableSnapshotCopyResponse
newEnableSnapshotCopyResponse :: Int -> EnableSnapshotCopyResponse
newEnableSnapshotCopyResponse Int
pHttpStatus_ =
  EnableSnapshotCopyResponse'
    { $sel:cluster:EnableSnapshotCopyResponse' :: Maybe Cluster
cluster =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:EnableSnapshotCopyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
enableSnapshotCopyResponse_cluster :: Lens.Lens' EnableSnapshotCopyResponse (Prelude.Maybe Cluster)
enableSnapshotCopyResponse_cluster :: Lens' EnableSnapshotCopyResponse (Maybe Cluster)
enableSnapshotCopyResponse_cluster = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableSnapshotCopyResponse' {Maybe Cluster
cluster :: Maybe Cluster
$sel:cluster:EnableSnapshotCopyResponse' :: EnableSnapshotCopyResponse -> Maybe Cluster
cluster} -> Maybe Cluster
cluster) (\s :: EnableSnapshotCopyResponse
s@EnableSnapshotCopyResponse' {} Maybe Cluster
a -> EnableSnapshotCopyResponse
s {$sel:cluster:EnableSnapshotCopyResponse' :: Maybe Cluster
cluster = Maybe Cluster
a} :: EnableSnapshotCopyResponse)

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

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