{-# 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.DeleteCluster
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a previously provisioned cluster without its final snapshot
-- being created. A successful response from the web service indicates that
-- the request was received correctly. Use DescribeClusters to monitor the
-- status of the deletion. The delete operation cannot be canceled or
-- reverted once submitted. For more information about managing clusters,
-- go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html Amazon Redshift Clusters>
-- in the /Amazon Redshift Cluster Management Guide/.
--
-- If you want to shut down the cluster and retain it for future use, set
-- /SkipFinalClusterSnapshot/ to @false@ and specify a name for
-- /FinalClusterSnapshotIdentifier/. You can later restore this snapshot to
-- resume using the cluster. If a final cluster snapshot is requested, the
-- status of the cluster will be \"final-snapshot\" while the snapshot is
-- being taken, then it\'s \"deleting\" once Amazon Redshift begins
-- deleting the cluster.
--
-- For more information about managing clusters, go to
-- <https://docs.aws.amazon.com/redshift/latest/mgmt/working-with-clusters.html Amazon Redshift Clusters>
-- in the /Amazon Redshift Cluster Management Guide/.
module Amazonka.Redshift.DeleteCluster
  ( -- * Creating a Request
    DeleteCluster (..),
    newDeleteCluster,

    -- * Request Lenses
    deleteCluster_finalClusterSnapshotIdentifier,
    deleteCluster_finalClusterSnapshotRetentionPeriod,
    deleteCluster_skipFinalClusterSnapshot,
    deleteCluster_clusterIdentifier,

    -- * Destructuring the Response
    DeleteClusterResponse (..),
    newDeleteClusterResponse,

    -- * Response Lenses
    deleteClusterResponse_cluster,
    deleteClusterResponse_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:/ 'newDeleteCluster' smart constructor.
data DeleteCluster = DeleteCluster'
  { -- | The identifier of the final snapshot that is to be created immediately
    -- before deleting the cluster. If this parameter is provided,
    -- /SkipFinalClusterSnapshot/ must be @false@.
    --
    -- Constraints:
    --
    -- -   Must be 1 to 255 alphanumeric characters.
    --
    -- -   First character must be a letter.
    --
    -- -   Cannot end with a hyphen or contain two consecutive hyphens.
    DeleteCluster -> Maybe Text
finalClusterSnapshotIdentifier :: Prelude.Maybe Prelude.Text,
    -- | 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.
    DeleteCluster -> Maybe Int
finalClusterSnapshotRetentionPeriod :: Prelude.Maybe Prelude.Int,
    -- | Determines whether a final snapshot of the cluster is created before
    -- Amazon Redshift deletes the cluster. If @true@, a final cluster snapshot
    -- is not created. If @false@, a final cluster snapshot is created before
    -- the cluster is deleted.
    --
    -- The /FinalClusterSnapshotIdentifier/ parameter must be specified if
    -- /SkipFinalClusterSnapshot/ is @false@.
    --
    -- Default: @false@
    DeleteCluster -> Maybe Bool
skipFinalClusterSnapshot :: Prelude.Maybe Prelude.Bool,
    -- | The identifier of the cluster to be deleted.
    --
    -- Constraints:
    --
    -- -   Must contain lowercase characters.
    --
    -- -   Must contain from 1 to 63 alphanumeric characters or hyphens.
    --
    -- -   First character must be a letter.
    --
    -- -   Cannot end with a hyphen or contain two consecutive hyphens.
    DeleteCluster -> Text
clusterIdentifier :: Prelude.Text
  }
  deriving (DeleteCluster -> DeleteCluster -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteCluster -> DeleteCluster -> Bool
$c/= :: DeleteCluster -> DeleteCluster -> Bool
== :: DeleteCluster -> DeleteCluster -> Bool
$c== :: DeleteCluster -> DeleteCluster -> Bool
Prelude.Eq, ReadPrec [DeleteCluster]
ReadPrec DeleteCluster
Int -> ReadS DeleteCluster
ReadS [DeleteCluster]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteCluster]
$creadListPrec :: ReadPrec [DeleteCluster]
readPrec :: ReadPrec DeleteCluster
$creadPrec :: ReadPrec DeleteCluster
readList :: ReadS [DeleteCluster]
$creadList :: ReadS [DeleteCluster]
readsPrec :: Int -> ReadS DeleteCluster
$creadsPrec :: Int -> ReadS DeleteCluster
Prelude.Read, Int -> DeleteCluster -> ShowS
[DeleteCluster] -> ShowS
DeleteCluster -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteCluster] -> ShowS
$cshowList :: [DeleteCluster] -> ShowS
show :: DeleteCluster -> String
$cshow :: DeleteCluster -> String
showsPrec :: Int -> DeleteCluster -> ShowS
$cshowsPrec :: Int -> DeleteCluster -> ShowS
Prelude.Show, forall x. Rep DeleteCluster x -> DeleteCluster
forall x. DeleteCluster -> Rep DeleteCluster x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteCluster x -> DeleteCluster
$cfrom :: forall x. DeleteCluster -> Rep DeleteCluster x
Prelude.Generic)

-- |
-- Create a value of 'DeleteCluster' 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:
--
-- 'finalClusterSnapshotIdentifier', 'deleteCluster_finalClusterSnapshotIdentifier' - The identifier of the final snapshot that is to be created immediately
-- before deleting the cluster. If this parameter is provided,
-- /SkipFinalClusterSnapshot/ must be @false@.
--
-- Constraints:
--
-- -   Must be 1 to 255 alphanumeric characters.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
--
-- 'finalClusterSnapshotRetentionPeriod', 'deleteCluster_finalClusterSnapshotRetentionPeriod' - 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.
--
-- 'skipFinalClusterSnapshot', 'deleteCluster_skipFinalClusterSnapshot' - Determines whether a final snapshot of the cluster is created before
-- Amazon Redshift deletes the cluster. If @true@, a final cluster snapshot
-- is not created. If @false@, a final cluster snapshot is created before
-- the cluster is deleted.
--
-- The /FinalClusterSnapshotIdentifier/ parameter must be specified if
-- /SkipFinalClusterSnapshot/ is @false@.
--
-- Default: @false@
--
-- 'clusterIdentifier', 'deleteCluster_clusterIdentifier' - The identifier of the cluster to be deleted.
--
-- Constraints:
--
-- -   Must contain lowercase characters.
--
-- -   Must contain from 1 to 63 alphanumeric characters or hyphens.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
newDeleteCluster ::
  -- | 'clusterIdentifier'
  Prelude.Text ->
  DeleteCluster
newDeleteCluster :: Text -> DeleteCluster
newDeleteCluster Text
pClusterIdentifier_ =
  DeleteCluster'
    { $sel:finalClusterSnapshotIdentifier:DeleteCluster' :: Maybe Text
finalClusterSnapshotIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:finalClusterSnapshotRetentionPeriod:DeleteCluster' :: Maybe Int
finalClusterSnapshotRetentionPeriod =
        forall a. Maybe a
Prelude.Nothing,
      $sel:skipFinalClusterSnapshot:DeleteCluster' :: Maybe Bool
skipFinalClusterSnapshot = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterIdentifier:DeleteCluster' :: Text
clusterIdentifier = Text
pClusterIdentifier_
    }

-- | The identifier of the final snapshot that is to be created immediately
-- before deleting the cluster. If this parameter is provided,
-- /SkipFinalClusterSnapshot/ must be @false@.
--
-- Constraints:
--
-- -   Must be 1 to 255 alphanumeric characters.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
deleteCluster_finalClusterSnapshotIdentifier :: Lens.Lens' DeleteCluster (Prelude.Maybe Prelude.Text)
deleteCluster_finalClusterSnapshotIdentifier :: Lens' DeleteCluster (Maybe Text)
deleteCluster_finalClusterSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCluster' {Maybe Text
finalClusterSnapshotIdentifier :: Maybe Text
$sel:finalClusterSnapshotIdentifier:DeleteCluster' :: DeleteCluster -> Maybe Text
finalClusterSnapshotIdentifier} -> Maybe Text
finalClusterSnapshotIdentifier) (\s :: DeleteCluster
s@DeleteCluster' {} Maybe Text
a -> DeleteCluster
s {$sel:finalClusterSnapshotIdentifier:DeleteCluster' :: Maybe Text
finalClusterSnapshotIdentifier = Maybe Text
a} :: DeleteCluster)

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

-- | Determines whether a final snapshot of the cluster is created before
-- Amazon Redshift deletes the cluster. If @true@, a final cluster snapshot
-- is not created. If @false@, a final cluster snapshot is created before
-- the cluster is deleted.
--
-- The /FinalClusterSnapshotIdentifier/ parameter must be specified if
-- /SkipFinalClusterSnapshot/ is @false@.
--
-- Default: @false@
deleteCluster_skipFinalClusterSnapshot :: Lens.Lens' DeleteCluster (Prelude.Maybe Prelude.Bool)
deleteCluster_skipFinalClusterSnapshot :: Lens' DeleteCluster (Maybe Bool)
deleteCluster_skipFinalClusterSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCluster' {Maybe Bool
skipFinalClusterSnapshot :: Maybe Bool
$sel:skipFinalClusterSnapshot:DeleteCluster' :: DeleteCluster -> Maybe Bool
skipFinalClusterSnapshot} -> Maybe Bool
skipFinalClusterSnapshot) (\s :: DeleteCluster
s@DeleteCluster' {} Maybe Bool
a -> DeleteCluster
s {$sel:skipFinalClusterSnapshot:DeleteCluster' :: Maybe Bool
skipFinalClusterSnapshot = Maybe Bool
a} :: DeleteCluster)

-- | The identifier of the cluster to be deleted.
--
-- Constraints:
--
-- -   Must contain lowercase characters.
--
-- -   Must contain from 1 to 63 alphanumeric characters or hyphens.
--
-- -   First character must be a letter.
--
-- -   Cannot end with a hyphen or contain two consecutive hyphens.
deleteCluster_clusterIdentifier :: Lens.Lens' DeleteCluster Prelude.Text
deleteCluster_clusterIdentifier :: Lens' DeleteCluster Text
deleteCluster_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCluster' {Text
clusterIdentifier :: Text
$sel:clusterIdentifier:DeleteCluster' :: DeleteCluster -> Text
clusterIdentifier} -> Text
clusterIdentifier) (\s :: DeleteCluster
s@DeleteCluster' {} Text
a -> DeleteCluster
s {$sel:clusterIdentifier:DeleteCluster' :: Text
clusterIdentifier = Text
a} :: DeleteCluster)

instance Core.AWSRequest DeleteCluster where
  type
    AWSResponse DeleteCluster =
      DeleteClusterResponse
  request :: (Service -> Service) -> DeleteCluster -> Request DeleteCluster
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 DeleteCluster
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteCluster)))
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
"DeleteClusterResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Cluster -> Int -> DeleteClusterResponse
DeleteClusterResponse'
            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 DeleteCluster where
  hashWithSalt :: Int -> DeleteCluster -> Int
hashWithSalt Int
_salt DeleteCluster' {Maybe Bool
Maybe Int
Maybe Text
Text
clusterIdentifier :: Text
skipFinalClusterSnapshot :: Maybe Bool
finalClusterSnapshotRetentionPeriod :: Maybe Int
finalClusterSnapshotIdentifier :: Maybe Text
$sel:clusterIdentifier:DeleteCluster' :: DeleteCluster -> Text
$sel:skipFinalClusterSnapshot:DeleteCluster' :: DeleteCluster -> Maybe Bool
$sel:finalClusterSnapshotRetentionPeriod:DeleteCluster' :: DeleteCluster -> Maybe Int
$sel:finalClusterSnapshotIdentifier:DeleteCluster' :: DeleteCluster -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
finalClusterSnapshotIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
finalClusterSnapshotRetentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
skipFinalClusterSnapshot
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier

instance Prelude.NFData DeleteCluster where
  rnf :: DeleteCluster -> ()
rnf DeleteCluster' {Maybe Bool
Maybe Int
Maybe Text
Text
clusterIdentifier :: Text
skipFinalClusterSnapshot :: Maybe Bool
finalClusterSnapshotRetentionPeriod :: Maybe Int
finalClusterSnapshotIdentifier :: Maybe Text
$sel:clusterIdentifier:DeleteCluster' :: DeleteCluster -> Text
$sel:skipFinalClusterSnapshot:DeleteCluster' :: DeleteCluster -> Maybe Bool
$sel:finalClusterSnapshotRetentionPeriod:DeleteCluster' :: DeleteCluster -> Maybe Int
$sel:finalClusterSnapshotIdentifier:DeleteCluster' :: DeleteCluster -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
finalClusterSnapshotIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
finalClusterSnapshotRetentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
skipFinalClusterSnapshot
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterIdentifier

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

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

instance Data.ToQuery DeleteCluster where
  toQuery :: DeleteCluster -> QueryString
toQuery DeleteCluster' {Maybe Bool
Maybe Int
Maybe Text
Text
clusterIdentifier :: Text
skipFinalClusterSnapshot :: Maybe Bool
finalClusterSnapshotRetentionPeriod :: Maybe Int
finalClusterSnapshotIdentifier :: Maybe Text
$sel:clusterIdentifier:DeleteCluster' :: DeleteCluster -> Text
$sel:skipFinalClusterSnapshot:DeleteCluster' :: DeleteCluster -> Maybe Bool
$sel:finalClusterSnapshotRetentionPeriod:DeleteCluster' :: DeleteCluster -> Maybe Int
$sel:finalClusterSnapshotIdentifier:DeleteCluster' :: DeleteCluster -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteCluster" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"FinalClusterSnapshotIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
finalClusterSnapshotIdentifier,
        ByteString
"FinalClusterSnapshotRetentionPeriod"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
finalClusterSnapshotRetentionPeriod,
        ByteString
"SkipFinalClusterSnapshot"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
skipFinalClusterSnapshot,
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterIdentifier
      ]

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

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

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

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

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