{-# 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.CreateClusterSnapshot
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a manual snapshot of the specified cluster. The cluster must be
-- in the @available@ state.
--
-- 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.CreateClusterSnapshot
  ( -- * Creating a Request
    CreateClusterSnapshot (..),
    newCreateClusterSnapshot,

    -- * Request Lenses
    createClusterSnapshot_manualSnapshotRetentionPeriod,
    createClusterSnapshot_tags,
    createClusterSnapshot_snapshotIdentifier,
    createClusterSnapshot_clusterIdentifier,

    -- * Destructuring the Response
    CreateClusterSnapshotResponse (..),
    newCreateClusterSnapshotResponse,

    -- * Response Lenses
    createClusterSnapshotResponse_snapshot,
    createClusterSnapshotResponse_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:/ 'newCreateClusterSnapshot' smart constructor.
data CreateClusterSnapshot = CreateClusterSnapshot'
  { -- | 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.
    CreateClusterSnapshot -> Maybe Int
manualSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | A list of tag instances.
    CreateClusterSnapshot -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A unique identifier for the snapshot that you are requesting. This
    -- identifier must be unique for all snapshots within the Amazon Web
    -- Services account.
    --
    -- 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
    --
    -- Example: @my-snapshot-id@
    CreateClusterSnapshot -> Text
snapshotIdentifier :: Prelude.Text,
    -- | The cluster identifier for which you want a snapshot.
    CreateClusterSnapshot -> Text
clusterIdentifier :: Prelude.Text
  }
  deriving (CreateClusterSnapshot -> CreateClusterSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateClusterSnapshot -> CreateClusterSnapshot -> Bool
$c/= :: CreateClusterSnapshot -> CreateClusterSnapshot -> Bool
== :: CreateClusterSnapshot -> CreateClusterSnapshot -> Bool
$c== :: CreateClusterSnapshot -> CreateClusterSnapshot -> Bool
Prelude.Eq, ReadPrec [CreateClusterSnapshot]
ReadPrec CreateClusterSnapshot
Int -> ReadS CreateClusterSnapshot
ReadS [CreateClusterSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateClusterSnapshot]
$creadListPrec :: ReadPrec [CreateClusterSnapshot]
readPrec :: ReadPrec CreateClusterSnapshot
$creadPrec :: ReadPrec CreateClusterSnapshot
readList :: ReadS [CreateClusterSnapshot]
$creadList :: ReadS [CreateClusterSnapshot]
readsPrec :: Int -> ReadS CreateClusterSnapshot
$creadsPrec :: Int -> ReadS CreateClusterSnapshot
Prelude.Read, Int -> CreateClusterSnapshot -> ShowS
[CreateClusterSnapshot] -> ShowS
CreateClusterSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateClusterSnapshot] -> ShowS
$cshowList :: [CreateClusterSnapshot] -> ShowS
show :: CreateClusterSnapshot -> String
$cshow :: CreateClusterSnapshot -> String
showsPrec :: Int -> CreateClusterSnapshot -> ShowS
$cshowsPrec :: Int -> CreateClusterSnapshot -> ShowS
Prelude.Show, forall x. Rep CreateClusterSnapshot x -> CreateClusterSnapshot
forall x. CreateClusterSnapshot -> Rep CreateClusterSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateClusterSnapshot x -> CreateClusterSnapshot
$cfrom :: forall x. CreateClusterSnapshot -> Rep CreateClusterSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'CreateClusterSnapshot' 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', 'createClusterSnapshot_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.
--
-- 'tags', 'createClusterSnapshot_tags' - A list of tag instances.
--
-- 'snapshotIdentifier', 'createClusterSnapshot_snapshotIdentifier' - A unique identifier for the snapshot that you are requesting. This
-- identifier must be unique for all snapshots within the Amazon Web
-- Services account.
--
-- 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
--
-- Example: @my-snapshot-id@
--
-- 'clusterIdentifier', 'createClusterSnapshot_clusterIdentifier' - The cluster identifier for which you want a snapshot.
newCreateClusterSnapshot ::
  -- | 'snapshotIdentifier'
  Prelude.Text ->
  -- | 'clusterIdentifier'
  Prelude.Text ->
  CreateClusterSnapshot
newCreateClusterSnapshot :: Text -> Text -> CreateClusterSnapshot
newCreateClusterSnapshot
  Text
pSnapshotIdentifier_
  Text
pClusterIdentifier_ =
    CreateClusterSnapshot'
      { $sel:manualSnapshotRetentionPeriod:CreateClusterSnapshot' :: Maybe Int
manualSnapshotRetentionPeriod =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateClusterSnapshot' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:snapshotIdentifier:CreateClusterSnapshot' :: Text
snapshotIdentifier = Text
pSnapshotIdentifier_,
        $sel:clusterIdentifier:CreateClusterSnapshot' :: Text
clusterIdentifier = Text
pClusterIdentifier_
      }

-- | 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.
createClusterSnapshot_manualSnapshotRetentionPeriod :: Lens.Lens' CreateClusterSnapshot (Prelude.Maybe Prelude.Int)
createClusterSnapshot_manualSnapshotRetentionPeriod :: Lens' CreateClusterSnapshot (Maybe Int)
createClusterSnapshot_manualSnapshotRetentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterSnapshot' {Maybe Int
manualSnapshotRetentionPeriod :: Maybe Int
$sel:manualSnapshotRetentionPeriod:CreateClusterSnapshot' :: CreateClusterSnapshot -> Maybe Int
manualSnapshotRetentionPeriod} -> Maybe Int
manualSnapshotRetentionPeriod) (\s :: CreateClusterSnapshot
s@CreateClusterSnapshot' {} Maybe Int
a -> CreateClusterSnapshot
s {$sel:manualSnapshotRetentionPeriod:CreateClusterSnapshot' :: Maybe Int
manualSnapshotRetentionPeriod = Maybe Int
a} :: CreateClusterSnapshot)

-- | A list of tag instances.
createClusterSnapshot_tags :: Lens.Lens' CreateClusterSnapshot (Prelude.Maybe [Tag])
createClusterSnapshot_tags :: Lens' CreateClusterSnapshot (Maybe [Tag])
createClusterSnapshot_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterSnapshot' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateClusterSnapshot' :: CreateClusterSnapshot -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateClusterSnapshot
s@CreateClusterSnapshot' {} Maybe [Tag]
a -> CreateClusterSnapshot
s {$sel:tags:CreateClusterSnapshot' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateClusterSnapshot) 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

-- | A unique identifier for the snapshot that you are requesting. This
-- identifier must be unique for all snapshots within the Amazon Web
-- Services account.
--
-- 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
--
-- Example: @my-snapshot-id@
createClusterSnapshot_snapshotIdentifier :: Lens.Lens' CreateClusterSnapshot Prelude.Text
createClusterSnapshot_snapshotIdentifier :: Lens' CreateClusterSnapshot Text
createClusterSnapshot_snapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterSnapshot' {Text
snapshotIdentifier :: Text
$sel:snapshotIdentifier:CreateClusterSnapshot' :: CreateClusterSnapshot -> Text
snapshotIdentifier} -> Text
snapshotIdentifier) (\s :: CreateClusterSnapshot
s@CreateClusterSnapshot' {} Text
a -> CreateClusterSnapshot
s {$sel:snapshotIdentifier:CreateClusterSnapshot' :: Text
snapshotIdentifier = Text
a} :: CreateClusterSnapshot)

-- | The cluster identifier for which you want a snapshot.
createClusterSnapshot_clusterIdentifier :: Lens.Lens' CreateClusterSnapshot Prelude.Text
createClusterSnapshot_clusterIdentifier :: Lens' CreateClusterSnapshot Text
createClusterSnapshot_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateClusterSnapshot' {Text
clusterIdentifier :: Text
$sel:clusterIdentifier:CreateClusterSnapshot' :: CreateClusterSnapshot -> Text
clusterIdentifier} -> Text
clusterIdentifier) (\s :: CreateClusterSnapshot
s@CreateClusterSnapshot' {} Text
a -> CreateClusterSnapshot
s {$sel:clusterIdentifier:CreateClusterSnapshot' :: Text
clusterIdentifier = Text
a} :: CreateClusterSnapshot)

instance Core.AWSRequest CreateClusterSnapshot where
  type
    AWSResponse CreateClusterSnapshot =
      CreateClusterSnapshotResponse
  request :: (Service -> Service)
-> CreateClusterSnapshot -> Request CreateClusterSnapshot
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 CreateClusterSnapshot
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateClusterSnapshot)))
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
"CreateClusterSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Snapshot -> Int -> CreateClusterSnapshotResponse
CreateClusterSnapshotResponse'
            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 CreateClusterSnapshot where
  hashWithSalt :: Int -> CreateClusterSnapshot -> Int
hashWithSalt Int
_salt CreateClusterSnapshot' {Maybe Int
Maybe [Tag]
Text
clusterIdentifier :: Text
snapshotIdentifier :: Text
tags :: Maybe [Tag]
manualSnapshotRetentionPeriod :: Maybe Int
$sel:clusterIdentifier:CreateClusterSnapshot' :: CreateClusterSnapshot -> Text
$sel:snapshotIdentifier:CreateClusterSnapshot' :: CreateClusterSnapshot -> Text
$sel:tags:CreateClusterSnapshot' :: CreateClusterSnapshot -> Maybe [Tag]
$sel:manualSnapshotRetentionPeriod:CreateClusterSnapshot' :: CreateClusterSnapshot -> 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 [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier

instance Prelude.NFData CreateClusterSnapshot where
  rnf :: CreateClusterSnapshot -> ()
rnf CreateClusterSnapshot' {Maybe Int
Maybe [Tag]
Text
clusterIdentifier :: Text
snapshotIdentifier :: Text
tags :: Maybe [Tag]
manualSnapshotRetentionPeriod :: Maybe Int
$sel:clusterIdentifier:CreateClusterSnapshot' :: CreateClusterSnapshot -> Text
$sel:snapshotIdentifier:CreateClusterSnapshot' :: CreateClusterSnapshot -> Text
$sel:tags:CreateClusterSnapshot' :: CreateClusterSnapshot -> Maybe [Tag]
$sel:manualSnapshotRetentionPeriod:CreateClusterSnapshot' :: CreateClusterSnapshot -> 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 [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterIdentifier

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

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

instance Data.ToQuery CreateClusterSnapshot where
  toQuery :: CreateClusterSnapshot -> QueryString
toQuery CreateClusterSnapshot' {Maybe Int
Maybe [Tag]
Text
clusterIdentifier :: Text
snapshotIdentifier :: Text
tags :: Maybe [Tag]
manualSnapshotRetentionPeriod :: Maybe Int
$sel:clusterIdentifier:CreateClusterSnapshot' :: CreateClusterSnapshot -> Text
$sel:snapshotIdentifier:CreateClusterSnapshot' :: CreateClusterSnapshot -> Text
$sel:tags:CreateClusterSnapshot' :: CreateClusterSnapshot -> Maybe [Tag]
$sel:manualSnapshotRetentionPeriod:CreateClusterSnapshot' :: CreateClusterSnapshot -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateClusterSnapshot" :: 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
"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
"SnapshotIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
snapshotIdentifier,
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterIdentifier
      ]

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

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

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

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

instance Prelude.NFData CreateClusterSnapshotResponse where
  rnf :: CreateClusterSnapshotResponse -> ()
rnf CreateClusterSnapshotResponse' {Int
Maybe Snapshot
httpStatus :: Int
snapshot :: Maybe Snapshot
$sel:httpStatus:CreateClusterSnapshotResponse' :: CreateClusterSnapshotResponse -> Int
$sel:snapshot:CreateClusterSnapshotResponse' :: CreateClusterSnapshotResponse -> 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