{-# 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.Backup.DeleteBackupVaultNotifications
-- 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 event notifications for the specified backup vault.
module Amazonka.Backup.DeleteBackupVaultNotifications
  ( -- * Creating a Request
    DeleteBackupVaultNotifications (..),
    newDeleteBackupVaultNotifications,

    -- * Request Lenses
    deleteBackupVaultNotifications_backupVaultName,

    -- * Destructuring the Response
    DeleteBackupVaultNotificationsResponse (..),
    newDeleteBackupVaultNotificationsResponse,
  )
where

import Amazonka.Backup.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeleteBackupVaultNotifications' smart constructor.
data DeleteBackupVaultNotifications = DeleteBackupVaultNotifications'
  { -- | The name of a logical container where backups are stored. Backup vaults
    -- are identified by names that are unique to the account used to create
    -- them and the Region where they are created. They consist of lowercase
    -- letters, numbers, and hyphens.
    DeleteBackupVaultNotifications -> Text
backupVaultName :: Prelude.Text
  }
  deriving (DeleteBackupVaultNotifications
-> DeleteBackupVaultNotifications -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteBackupVaultNotifications
-> DeleteBackupVaultNotifications -> Bool
$c/= :: DeleteBackupVaultNotifications
-> DeleteBackupVaultNotifications -> Bool
== :: DeleteBackupVaultNotifications
-> DeleteBackupVaultNotifications -> Bool
$c== :: DeleteBackupVaultNotifications
-> DeleteBackupVaultNotifications -> Bool
Prelude.Eq, ReadPrec [DeleteBackupVaultNotifications]
ReadPrec DeleteBackupVaultNotifications
Int -> ReadS DeleteBackupVaultNotifications
ReadS [DeleteBackupVaultNotifications]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteBackupVaultNotifications]
$creadListPrec :: ReadPrec [DeleteBackupVaultNotifications]
readPrec :: ReadPrec DeleteBackupVaultNotifications
$creadPrec :: ReadPrec DeleteBackupVaultNotifications
readList :: ReadS [DeleteBackupVaultNotifications]
$creadList :: ReadS [DeleteBackupVaultNotifications]
readsPrec :: Int -> ReadS DeleteBackupVaultNotifications
$creadsPrec :: Int -> ReadS DeleteBackupVaultNotifications
Prelude.Read, Int -> DeleteBackupVaultNotifications -> ShowS
[DeleteBackupVaultNotifications] -> ShowS
DeleteBackupVaultNotifications -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteBackupVaultNotifications] -> ShowS
$cshowList :: [DeleteBackupVaultNotifications] -> ShowS
show :: DeleteBackupVaultNotifications -> String
$cshow :: DeleteBackupVaultNotifications -> String
showsPrec :: Int -> DeleteBackupVaultNotifications -> ShowS
$cshowsPrec :: Int -> DeleteBackupVaultNotifications -> ShowS
Prelude.Show, forall x.
Rep DeleteBackupVaultNotifications x
-> DeleteBackupVaultNotifications
forall x.
DeleteBackupVaultNotifications
-> Rep DeleteBackupVaultNotifications x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteBackupVaultNotifications x
-> DeleteBackupVaultNotifications
$cfrom :: forall x.
DeleteBackupVaultNotifications
-> Rep DeleteBackupVaultNotifications x
Prelude.Generic)

-- |
-- Create a value of 'DeleteBackupVaultNotifications' 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:
--
-- 'backupVaultName', 'deleteBackupVaultNotifications_backupVaultName' - The name of a logical container where backups are stored. Backup vaults
-- are identified by names that are unique to the account used to create
-- them and the Region where they are created. They consist of lowercase
-- letters, numbers, and hyphens.
newDeleteBackupVaultNotifications ::
  -- | 'backupVaultName'
  Prelude.Text ->
  DeleteBackupVaultNotifications
newDeleteBackupVaultNotifications :: Text -> DeleteBackupVaultNotifications
newDeleteBackupVaultNotifications Text
pBackupVaultName_ =
  DeleteBackupVaultNotifications'
    { $sel:backupVaultName:DeleteBackupVaultNotifications' :: Text
backupVaultName =
        Text
pBackupVaultName_
    }

-- | The name of a logical container where backups are stored. Backup vaults
-- are identified by names that are unique to the account used to create
-- them and the Region where they are created. They consist of lowercase
-- letters, numbers, and hyphens.
deleteBackupVaultNotifications_backupVaultName :: Lens.Lens' DeleteBackupVaultNotifications Prelude.Text
deleteBackupVaultNotifications_backupVaultName :: Lens' DeleteBackupVaultNotifications Text
deleteBackupVaultNotifications_backupVaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBackupVaultNotifications' {Text
backupVaultName :: Text
$sel:backupVaultName:DeleteBackupVaultNotifications' :: DeleteBackupVaultNotifications -> Text
backupVaultName} -> Text
backupVaultName) (\s :: DeleteBackupVaultNotifications
s@DeleteBackupVaultNotifications' {} Text
a -> DeleteBackupVaultNotifications
s {$sel:backupVaultName:DeleteBackupVaultNotifications' :: Text
backupVaultName = Text
a} :: DeleteBackupVaultNotifications)

instance
  Core.AWSRequest
    DeleteBackupVaultNotifications
  where
  type
    AWSResponse DeleteBackupVaultNotifications =
      DeleteBackupVaultNotificationsResponse
  request :: (Service -> Service)
-> DeleteBackupVaultNotifications
-> Request DeleteBackupVaultNotifications
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteBackupVaultNotifications
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DeleteBackupVaultNotifications)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DeleteBackupVaultNotificationsResponse
DeleteBackupVaultNotificationsResponse'

instance
  Prelude.Hashable
    DeleteBackupVaultNotifications
  where
  hashWithSalt :: Int -> DeleteBackupVaultNotifications -> Int
hashWithSalt
    Int
_salt
    DeleteBackupVaultNotifications' {Text
backupVaultName :: Text
$sel:backupVaultName:DeleteBackupVaultNotifications' :: DeleteBackupVaultNotifications -> Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupVaultName

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

instance
  Data.ToHeaders
    DeleteBackupVaultNotifications
  where
  toHeaders :: DeleteBackupVaultNotifications -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteBackupVaultNotifications where
  toPath :: DeleteBackupVaultNotifications -> ByteString
toPath DeleteBackupVaultNotifications' {Text
backupVaultName :: Text
$sel:backupVaultName:DeleteBackupVaultNotifications' :: DeleteBackupVaultNotifications -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/backup-vaults/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupVaultName,
        ByteString
"/notification-configuration"
      ]

instance Data.ToQuery DeleteBackupVaultNotifications where
  toQuery :: DeleteBackupVaultNotifications -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newDeleteBackupVaultNotificationsResponse' smart constructor.
data DeleteBackupVaultNotificationsResponse = DeleteBackupVaultNotificationsResponse'
  {
  }
  deriving (DeleteBackupVaultNotificationsResponse
-> DeleteBackupVaultNotificationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteBackupVaultNotificationsResponse
-> DeleteBackupVaultNotificationsResponse -> Bool
$c/= :: DeleteBackupVaultNotificationsResponse
-> DeleteBackupVaultNotificationsResponse -> Bool
== :: DeleteBackupVaultNotificationsResponse
-> DeleteBackupVaultNotificationsResponse -> Bool
$c== :: DeleteBackupVaultNotificationsResponse
-> DeleteBackupVaultNotificationsResponse -> Bool
Prelude.Eq, ReadPrec [DeleteBackupVaultNotificationsResponse]
ReadPrec DeleteBackupVaultNotificationsResponse
Int -> ReadS DeleteBackupVaultNotificationsResponse
ReadS [DeleteBackupVaultNotificationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteBackupVaultNotificationsResponse]
$creadListPrec :: ReadPrec [DeleteBackupVaultNotificationsResponse]
readPrec :: ReadPrec DeleteBackupVaultNotificationsResponse
$creadPrec :: ReadPrec DeleteBackupVaultNotificationsResponse
readList :: ReadS [DeleteBackupVaultNotificationsResponse]
$creadList :: ReadS [DeleteBackupVaultNotificationsResponse]
readsPrec :: Int -> ReadS DeleteBackupVaultNotificationsResponse
$creadsPrec :: Int -> ReadS DeleteBackupVaultNotificationsResponse
Prelude.Read, Int -> DeleteBackupVaultNotificationsResponse -> ShowS
[DeleteBackupVaultNotificationsResponse] -> ShowS
DeleteBackupVaultNotificationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteBackupVaultNotificationsResponse] -> ShowS
$cshowList :: [DeleteBackupVaultNotificationsResponse] -> ShowS
show :: DeleteBackupVaultNotificationsResponse -> String
$cshow :: DeleteBackupVaultNotificationsResponse -> String
showsPrec :: Int -> DeleteBackupVaultNotificationsResponse -> ShowS
$cshowsPrec :: Int -> DeleteBackupVaultNotificationsResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteBackupVaultNotificationsResponse x
-> DeleteBackupVaultNotificationsResponse
forall x.
DeleteBackupVaultNotificationsResponse
-> Rep DeleteBackupVaultNotificationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteBackupVaultNotificationsResponse x
-> DeleteBackupVaultNotificationsResponse
$cfrom :: forall x.
DeleteBackupVaultNotificationsResponse
-> Rep DeleteBackupVaultNotificationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteBackupVaultNotificationsResponse' 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.
newDeleteBackupVaultNotificationsResponse ::
  DeleteBackupVaultNotificationsResponse
newDeleteBackupVaultNotificationsResponse :: DeleteBackupVaultNotificationsResponse
newDeleteBackupVaultNotificationsResponse =
  DeleteBackupVaultNotificationsResponse
DeleteBackupVaultNotificationsResponse'

instance
  Prelude.NFData
    DeleteBackupVaultNotificationsResponse
  where
  rnf :: DeleteBackupVaultNotificationsResponse -> ()
rnf DeleteBackupVaultNotificationsResponse
_ = ()