{-# 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.Neptune.DeleteDBClusterSnapshot
-- 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 DB cluster snapshot. If the snapshot is being copied, the copy
-- operation is terminated.
--
-- The DB cluster snapshot must be in the @available@ state to be deleted.
module Amazonka.Neptune.DeleteDBClusterSnapshot
  ( -- * Creating a Request
    DeleteDBClusterSnapshot (..),
    newDeleteDBClusterSnapshot,

    -- * Request Lenses
    deleteDBClusterSnapshot_dbClusterSnapshotIdentifier,

    -- * Destructuring the Response
    DeleteDBClusterSnapshotResponse (..),
    newDeleteDBClusterSnapshotResponse,

    -- * Response Lenses
    deleteDBClusterSnapshotResponse_dbClusterSnapshot,
    deleteDBClusterSnapshotResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Neptune.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeleteDBClusterSnapshot' smart constructor.
data DeleteDBClusterSnapshot = DeleteDBClusterSnapshot'
  { -- | The identifier of the DB cluster snapshot to delete.
    --
    -- Constraints: Must be the name of an existing DB cluster snapshot in the
    -- @available@ state.
    DeleteDBClusterSnapshot -> Text
dbClusterSnapshotIdentifier :: Prelude.Text
  }
  deriving (DeleteDBClusterSnapshot -> DeleteDBClusterSnapshot -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteDBClusterSnapshot -> DeleteDBClusterSnapshot -> Bool
$c/= :: DeleteDBClusterSnapshot -> DeleteDBClusterSnapshot -> Bool
== :: DeleteDBClusterSnapshot -> DeleteDBClusterSnapshot -> Bool
$c== :: DeleteDBClusterSnapshot -> DeleteDBClusterSnapshot -> Bool
Prelude.Eq, ReadPrec [DeleteDBClusterSnapshot]
ReadPrec DeleteDBClusterSnapshot
Int -> ReadS DeleteDBClusterSnapshot
ReadS [DeleteDBClusterSnapshot]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteDBClusterSnapshot]
$creadListPrec :: ReadPrec [DeleteDBClusterSnapshot]
readPrec :: ReadPrec DeleteDBClusterSnapshot
$creadPrec :: ReadPrec DeleteDBClusterSnapshot
readList :: ReadS [DeleteDBClusterSnapshot]
$creadList :: ReadS [DeleteDBClusterSnapshot]
readsPrec :: Int -> ReadS DeleteDBClusterSnapshot
$creadsPrec :: Int -> ReadS DeleteDBClusterSnapshot
Prelude.Read, Int -> DeleteDBClusterSnapshot -> ShowS
[DeleteDBClusterSnapshot] -> ShowS
DeleteDBClusterSnapshot -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteDBClusterSnapshot] -> ShowS
$cshowList :: [DeleteDBClusterSnapshot] -> ShowS
show :: DeleteDBClusterSnapshot -> String
$cshow :: DeleteDBClusterSnapshot -> String
showsPrec :: Int -> DeleteDBClusterSnapshot -> ShowS
$cshowsPrec :: Int -> DeleteDBClusterSnapshot -> ShowS
Prelude.Show, forall x. Rep DeleteDBClusterSnapshot x -> DeleteDBClusterSnapshot
forall x. DeleteDBClusterSnapshot -> Rep DeleteDBClusterSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteDBClusterSnapshot x -> DeleteDBClusterSnapshot
$cfrom :: forall x. DeleteDBClusterSnapshot -> Rep DeleteDBClusterSnapshot x
Prelude.Generic)

-- |
-- Create a value of 'DeleteDBClusterSnapshot' 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:
--
-- 'dbClusterSnapshotIdentifier', 'deleteDBClusterSnapshot_dbClusterSnapshotIdentifier' - The identifier of the DB cluster snapshot to delete.
--
-- Constraints: Must be the name of an existing DB cluster snapshot in the
-- @available@ state.
newDeleteDBClusterSnapshot ::
  -- | 'dbClusterSnapshotIdentifier'
  Prelude.Text ->
  DeleteDBClusterSnapshot
newDeleteDBClusterSnapshot :: Text -> DeleteDBClusterSnapshot
newDeleteDBClusterSnapshot
  Text
pDBClusterSnapshotIdentifier_ =
    DeleteDBClusterSnapshot'
      { $sel:dbClusterSnapshotIdentifier:DeleteDBClusterSnapshot' :: Text
dbClusterSnapshotIdentifier =
          Text
pDBClusterSnapshotIdentifier_
      }

-- | The identifier of the DB cluster snapshot to delete.
--
-- Constraints: Must be the name of an existing DB cluster snapshot in the
-- @available@ state.
deleteDBClusterSnapshot_dbClusterSnapshotIdentifier :: Lens.Lens' DeleteDBClusterSnapshot Prelude.Text
deleteDBClusterSnapshot_dbClusterSnapshotIdentifier :: Lens' DeleteDBClusterSnapshot Text
deleteDBClusterSnapshot_dbClusterSnapshotIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDBClusterSnapshot' {Text
dbClusterSnapshotIdentifier :: Text
$sel:dbClusterSnapshotIdentifier:DeleteDBClusterSnapshot' :: DeleteDBClusterSnapshot -> Text
dbClusterSnapshotIdentifier} -> Text
dbClusterSnapshotIdentifier) (\s :: DeleteDBClusterSnapshot
s@DeleteDBClusterSnapshot' {} Text
a -> DeleteDBClusterSnapshot
s {$sel:dbClusterSnapshotIdentifier:DeleteDBClusterSnapshot' :: Text
dbClusterSnapshotIdentifier = Text
a} :: DeleteDBClusterSnapshot)

instance Core.AWSRequest DeleteDBClusterSnapshot where
  type
    AWSResponse DeleteDBClusterSnapshot =
      DeleteDBClusterSnapshotResponse
  request :: (Service -> Service)
-> DeleteDBClusterSnapshot -> Request DeleteDBClusterSnapshot
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 DeleteDBClusterSnapshot
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteDBClusterSnapshot)))
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
"DeleteDBClusterSnapshotResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe DBClusterSnapshot -> Int -> DeleteDBClusterSnapshotResponse
DeleteDBClusterSnapshotResponse'
            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
"DBClusterSnapshot")
            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 DeleteDBClusterSnapshot where
  hashWithSalt :: Int -> DeleteDBClusterSnapshot -> Int
hashWithSalt Int
_salt DeleteDBClusterSnapshot' {Text
dbClusterSnapshotIdentifier :: Text
$sel:dbClusterSnapshotIdentifier:DeleteDBClusterSnapshot' :: DeleteDBClusterSnapshot -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbClusterSnapshotIdentifier

instance Prelude.NFData DeleteDBClusterSnapshot where
  rnf :: DeleteDBClusterSnapshot -> ()
rnf DeleteDBClusterSnapshot' {Text
dbClusterSnapshotIdentifier :: Text
$sel:dbClusterSnapshotIdentifier:DeleteDBClusterSnapshot' :: DeleteDBClusterSnapshot -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
dbClusterSnapshotIdentifier

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

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

instance Data.ToQuery DeleteDBClusterSnapshot where
  toQuery :: DeleteDBClusterSnapshot -> QueryString
toQuery DeleteDBClusterSnapshot' {Text
dbClusterSnapshotIdentifier :: Text
$sel:dbClusterSnapshotIdentifier:DeleteDBClusterSnapshot' :: DeleteDBClusterSnapshot -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteDBClusterSnapshot" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"DBClusterSnapshotIdentifier"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbClusterSnapshotIdentifier
      ]

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

-- |
-- Create a value of 'DeleteDBClusterSnapshotResponse' 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:
--
-- 'dbClusterSnapshot', 'deleteDBClusterSnapshotResponse_dbClusterSnapshot' - Undocumented member.
--
-- 'httpStatus', 'deleteDBClusterSnapshotResponse_httpStatus' - The response's http status code.
newDeleteDBClusterSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteDBClusterSnapshotResponse
newDeleteDBClusterSnapshotResponse :: Int -> DeleteDBClusterSnapshotResponse
newDeleteDBClusterSnapshotResponse Int
pHttpStatus_ =
  DeleteDBClusterSnapshotResponse'
    { $sel:dbClusterSnapshot:DeleteDBClusterSnapshotResponse' :: Maybe DBClusterSnapshot
dbClusterSnapshot =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteDBClusterSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
deleteDBClusterSnapshotResponse_dbClusterSnapshot :: Lens.Lens' DeleteDBClusterSnapshotResponse (Prelude.Maybe DBClusterSnapshot)
deleteDBClusterSnapshotResponse_dbClusterSnapshot :: Lens' DeleteDBClusterSnapshotResponse (Maybe DBClusterSnapshot)
deleteDBClusterSnapshotResponse_dbClusterSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDBClusterSnapshotResponse' {Maybe DBClusterSnapshot
dbClusterSnapshot :: Maybe DBClusterSnapshot
$sel:dbClusterSnapshot:DeleteDBClusterSnapshotResponse' :: DeleteDBClusterSnapshotResponse -> Maybe DBClusterSnapshot
dbClusterSnapshot} -> Maybe DBClusterSnapshot
dbClusterSnapshot) (\s :: DeleteDBClusterSnapshotResponse
s@DeleteDBClusterSnapshotResponse' {} Maybe DBClusterSnapshot
a -> DeleteDBClusterSnapshotResponse
s {$sel:dbClusterSnapshot:DeleteDBClusterSnapshotResponse' :: Maybe DBClusterSnapshot
dbClusterSnapshot = Maybe DBClusterSnapshot
a} :: DeleteDBClusterSnapshotResponse)

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

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