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

    -- * Request Lenses
    deleteDBSnapshot_dbSnapshotIdentifier,

    -- * Destructuring the Response
    DeleteDBSnapshotResponse (..),
    newDeleteDBSnapshotResponse,

    -- * Response Lenses
    deleteDBSnapshotResponse_dbSnapshot,
    deleteDBSnapshotResponse_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.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

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

-- |
-- Create a value of 'DeleteDBSnapshot' 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:
--
-- 'dbSnapshotIdentifier', 'deleteDBSnapshot_dbSnapshotIdentifier' - The DB snapshot identifier.
--
-- Constraints: Must be the name of an existing DB snapshot in the
-- @available@ state.
newDeleteDBSnapshot ::
  -- | 'dbSnapshotIdentifier'
  Prelude.Text ->
  DeleteDBSnapshot
newDeleteDBSnapshot :: Text -> DeleteDBSnapshot
newDeleteDBSnapshot Text
pDBSnapshotIdentifier_ =
  DeleteDBSnapshot'
    { $sel:dbSnapshotIdentifier:DeleteDBSnapshot' :: Text
dbSnapshotIdentifier =
        Text
pDBSnapshotIdentifier_
    }

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

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

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

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

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

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

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

-- |
-- Create a value of 'DeleteDBSnapshotResponse' 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:
--
-- 'dbSnapshot', 'deleteDBSnapshotResponse_dbSnapshot' - Undocumented member.
--
-- 'httpStatus', 'deleteDBSnapshotResponse_httpStatus' - The response's http status code.
newDeleteDBSnapshotResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteDBSnapshotResponse
newDeleteDBSnapshotResponse :: Int -> DeleteDBSnapshotResponse
newDeleteDBSnapshotResponse Int
pHttpStatus_ =
  DeleteDBSnapshotResponse'
    { $sel:dbSnapshot:DeleteDBSnapshotResponse' :: Maybe DBSnapshot
dbSnapshot =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteDBSnapshotResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
deleteDBSnapshotResponse_dbSnapshot :: Lens.Lens' DeleteDBSnapshotResponse (Prelude.Maybe DBSnapshot)
deleteDBSnapshotResponse_dbSnapshot :: Lens' DeleteDBSnapshotResponse (Maybe DBSnapshot)
deleteDBSnapshotResponse_dbSnapshot = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDBSnapshotResponse' {Maybe DBSnapshot
dbSnapshot :: Maybe DBSnapshot
$sel:dbSnapshot:DeleteDBSnapshotResponse' :: DeleteDBSnapshotResponse -> Maybe DBSnapshot
dbSnapshot} -> Maybe DBSnapshot
dbSnapshot) (\s :: DeleteDBSnapshotResponse
s@DeleteDBSnapshotResponse' {} Maybe DBSnapshot
a -> DeleteDBSnapshotResponse
s {$sel:dbSnapshot:DeleteDBSnapshotResponse' :: Maybe DBSnapshot
dbSnapshot = Maybe DBSnapshot
a} :: DeleteDBSnapshotResponse)

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

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