{-# 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.Glacier.DeleteVault
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation deletes a vault. Amazon S3 Glacier will delete a vault
-- only if there are no archives in the vault as of the last inventory and
-- there have been no writes to the vault since the last inventory. If
-- either of these conditions is not satisfied, the vault deletion fails
-- (that is, the vault is not removed) and Amazon S3 Glacier returns an
-- error. You can use DescribeVault to return the number of archives in a
-- vault, and you can use
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/api-initiate-job-post.html Initiate a Job (POST jobs)>
-- to initiate a new inventory retrieval for a vault. The inventory
-- contains the archive IDs you use to delete archives using
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/api-archive-delete.html Delete Archive (DELETE archive)>.
--
-- This operation is idempotent.
--
-- An AWS account has full permission to perform all operations (actions).
-- However, AWS Identity and Access Management (IAM) users don\'t have any
-- permissions by default. You must grant them explicit permission to
-- perform specific actions. For more information, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/using-iam-with-amazon-glacier.html Access Control Using AWS Identity and Access Management (IAM)>.
--
-- For conceptual information and underlying REST API, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/deleting-vaults.html Deleting a Vault in Amazon Glacier>
-- and
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/api-vault-delete.html Delete Vault>
-- in the /Amazon S3 Glacier Developer Guide/.
module Amazonka.Glacier.DeleteVault
  ( -- * Creating a Request
    DeleteVault (..),
    newDeleteVault,

    -- * Request Lenses
    deleteVault_accountId,
    deleteVault_vaultName,

    -- * Destructuring the Response
    DeleteVaultResponse (..),
    newDeleteVaultResponse,
  )
where

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

-- | Provides options for deleting a vault from Amazon S3 Glacier.
--
-- /See:/ 'newDeleteVault' smart constructor.
data DeleteVault = DeleteVault'
  { -- | The @AccountId@ value is the AWS account ID of the account that owns the
    -- vault. You can either specify an AWS account ID or optionally a single
    -- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
    -- ID associated with the credentials used to sign the request. If you use
    -- an account ID, do not include any hyphens (\'-\') in the ID.
    DeleteVault -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    DeleteVault -> Text
vaultName :: Prelude.Text
  }
  deriving (DeleteVault -> DeleteVault -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteVault -> DeleteVault -> Bool
$c/= :: DeleteVault -> DeleteVault -> Bool
== :: DeleteVault -> DeleteVault -> Bool
$c== :: DeleteVault -> DeleteVault -> Bool
Prelude.Eq, ReadPrec [DeleteVault]
ReadPrec DeleteVault
Int -> ReadS DeleteVault
ReadS [DeleteVault]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteVault]
$creadListPrec :: ReadPrec [DeleteVault]
readPrec :: ReadPrec DeleteVault
$creadPrec :: ReadPrec DeleteVault
readList :: ReadS [DeleteVault]
$creadList :: ReadS [DeleteVault]
readsPrec :: Int -> ReadS DeleteVault
$creadsPrec :: Int -> ReadS DeleteVault
Prelude.Read, Int -> DeleteVault -> ShowS
[DeleteVault] -> ShowS
DeleteVault -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteVault] -> ShowS
$cshowList :: [DeleteVault] -> ShowS
show :: DeleteVault -> String
$cshow :: DeleteVault -> String
showsPrec :: Int -> DeleteVault -> ShowS
$cshowsPrec :: Int -> DeleteVault -> ShowS
Prelude.Show, forall x. Rep DeleteVault x -> DeleteVault
forall x. DeleteVault -> Rep DeleteVault x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteVault x -> DeleteVault
$cfrom :: forall x. DeleteVault -> Rep DeleteVault x
Prelude.Generic)

-- |
-- Create a value of 'DeleteVault' 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:
--
-- 'accountId', 'deleteVault_accountId' - The @AccountId@ value is the AWS account ID of the account that owns the
-- vault. You can either specify an AWS account ID or optionally a single
-- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
-- ID associated with the credentials used to sign the request. If you use
-- an account ID, do not include any hyphens (\'-\') in the ID.
--
-- 'vaultName', 'deleteVault_vaultName' - The name of the vault.
newDeleteVault ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  DeleteVault
newDeleteVault :: Text -> Text -> DeleteVault
newDeleteVault Text
pAccountId_ Text
pVaultName_ =
  DeleteVault'
    { $sel:accountId:DeleteVault' :: Text
accountId = Text
pAccountId_,
      $sel:vaultName:DeleteVault' :: Text
vaultName = Text
pVaultName_
    }

-- | The @AccountId@ value is the AWS account ID of the account that owns the
-- vault. You can either specify an AWS account ID or optionally a single
-- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
-- ID associated with the credentials used to sign the request. If you use
-- an account ID, do not include any hyphens (\'-\') in the ID.
deleteVault_accountId :: Lens.Lens' DeleteVault Prelude.Text
deleteVault_accountId :: Lens' DeleteVault Text
deleteVault_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteVault' {Text
accountId :: Text
$sel:accountId:DeleteVault' :: DeleteVault -> Text
accountId} -> Text
accountId) (\s :: DeleteVault
s@DeleteVault' {} Text
a -> DeleteVault
s {$sel:accountId:DeleteVault' :: Text
accountId = Text
a} :: DeleteVault)

-- | The name of the vault.
deleteVault_vaultName :: Lens.Lens' DeleteVault Prelude.Text
deleteVault_vaultName :: Lens' DeleteVault Text
deleteVault_vaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteVault' {Text
vaultName :: Text
$sel:vaultName:DeleteVault' :: DeleteVault -> Text
vaultName} -> Text
vaultName) (\s :: DeleteVault
s@DeleteVault' {} Text
a -> DeleteVault
s {$sel:vaultName:DeleteVault' :: Text
vaultName = Text
a} :: DeleteVault)

instance Core.AWSRequest DeleteVault where
  type AWSResponse DeleteVault = DeleteVaultResponse
  request :: (Service -> Service) -> DeleteVault -> Request DeleteVault
request Service -> Service
overrides =
    forall a. ByteString -> Request a -> Request a
Request.glacierVersionHeader (Service -> ByteString
Core.version Service
defaultService)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. 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 DeleteVault
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteVault)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteVaultResponse
DeleteVaultResponse'

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

instance Prelude.NFData DeleteVault where
  rnf :: DeleteVault -> ()
rnf DeleteVault' {Text
vaultName :: Text
accountId :: Text
$sel:vaultName:DeleteVault' :: DeleteVault -> Text
$sel:accountId:DeleteVault' :: DeleteVault -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vaultName

instance Data.ToHeaders DeleteVault where
  toHeaders :: DeleteVault -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteVault where
  toPath :: DeleteVault -> ByteString
toPath DeleteVault' {Text
vaultName :: Text
accountId :: Text
$sel:vaultName:DeleteVault' :: DeleteVault -> Text
$sel:accountId:DeleteVault' :: DeleteVault -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/vaults/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
vaultName
      ]

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

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

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

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