{-# 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.RemoveTagsFromVault
-- 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 removes one or more tags from the set of tags attached to
-- a vault. For more information about tags, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/tagging.html Tagging Amazon S3 Glacier Resources>.
-- This operation is idempotent. The operation will be successful, even if
-- there are no tags attached to the vault.
module Amazonka.Glacier.RemoveTagsFromVault
  ( -- * Creating a Request
    RemoveTagsFromVault (..),
    newRemoveTagsFromVault,

    -- * Request Lenses
    removeTagsFromVault_tagKeys,
    removeTagsFromVault_accountId,
    removeTagsFromVault_vaultName,

    -- * Destructuring the Response
    RemoveTagsFromVaultResponse (..),
    newRemoveTagsFromVaultResponse,
  )
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

-- | The input value for @RemoveTagsFromVaultInput@.
--
-- /See:/ 'newRemoveTagsFromVault' smart constructor.
data RemoveTagsFromVault = RemoveTagsFromVault'
  { -- | A list of tag keys. Each corresponding tag is removed from the vault.
    RemoveTagsFromVault -> Maybe [Text]
tagKeys :: Prelude.Maybe [Prelude.Text],
    -- | 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.
    RemoveTagsFromVault -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    RemoveTagsFromVault -> Text
vaultName :: Prelude.Text
  }
  deriving (RemoveTagsFromVault -> RemoveTagsFromVault -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveTagsFromVault -> RemoveTagsFromVault -> Bool
$c/= :: RemoveTagsFromVault -> RemoveTagsFromVault -> Bool
== :: RemoveTagsFromVault -> RemoveTagsFromVault -> Bool
$c== :: RemoveTagsFromVault -> RemoveTagsFromVault -> Bool
Prelude.Eq, ReadPrec [RemoveTagsFromVault]
ReadPrec RemoveTagsFromVault
Int -> ReadS RemoveTagsFromVault
ReadS [RemoveTagsFromVault]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveTagsFromVault]
$creadListPrec :: ReadPrec [RemoveTagsFromVault]
readPrec :: ReadPrec RemoveTagsFromVault
$creadPrec :: ReadPrec RemoveTagsFromVault
readList :: ReadS [RemoveTagsFromVault]
$creadList :: ReadS [RemoveTagsFromVault]
readsPrec :: Int -> ReadS RemoveTagsFromVault
$creadsPrec :: Int -> ReadS RemoveTagsFromVault
Prelude.Read, Int -> RemoveTagsFromVault -> ShowS
[RemoveTagsFromVault] -> ShowS
RemoveTagsFromVault -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveTagsFromVault] -> ShowS
$cshowList :: [RemoveTagsFromVault] -> ShowS
show :: RemoveTagsFromVault -> String
$cshow :: RemoveTagsFromVault -> String
showsPrec :: Int -> RemoveTagsFromVault -> ShowS
$cshowsPrec :: Int -> RemoveTagsFromVault -> ShowS
Prelude.Show, forall x. Rep RemoveTagsFromVault x -> RemoveTagsFromVault
forall x. RemoveTagsFromVault -> Rep RemoveTagsFromVault x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoveTagsFromVault x -> RemoveTagsFromVault
$cfrom :: forall x. RemoveTagsFromVault -> Rep RemoveTagsFromVault x
Prelude.Generic)

-- |
-- Create a value of 'RemoveTagsFromVault' 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:
--
-- 'tagKeys', 'removeTagsFromVault_tagKeys' - A list of tag keys. Each corresponding tag is removed from the vault.
--
-- 'accountId', 'removeTagsFromVault_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', 'removeTagsFromVault_vaultName' - The name of the vault.
newRemoveTagsFromVault ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  RemoveTagsFromVault
newRemoveTagsFromVault :: Text -> Text -> RemoveTagsFromVault
newRemoveTagsFromVault Text
pAccountId_ Text
pVaultName_ =
  RemoveTagsFromVault'
    { $sel:tagKeys:RemoveTagsFromVault' :: Maybe [Text]
tagKeys = forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:RemoveTagsFromVault' :: Text
accountId = Text
pAccountId_,
      $sel:vaultName:RemoveTagsFromVault' :: Text
vaultName = Text
pVaultName_
    }

-- | A list of tag keys. Each corresponding tag is removed from the vault.
removeTagsFromVault_tagKeys :: Lens.Lens' RemoveTagsFromVault (Prelude.Maybe [Prelude.Text])
removeTagsFromVault_tagKeys :: Lens' RemoveTagsFromVault (Maybe [Text])
removeTagsFromVault_tagKeys = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveTagsFromVault' {Maybe [Text]
tagKeys :: Maybe [Text]
$sel:tagKeys:RemoveTagsFromVault' :: RemoveTagsFromVault -> Maybe [Text]
tagKeys} -> Maybe [Text]
tagKeys) (\s :: RemoveTagsFromVault
s@RemoveTagsFromVault' {} Maybe [Text]
a -> RemoveTagsFromVault
s {$sel:tagKeys:RemoveTagsFromVault' :: Maybe [Text]
tagKeys = Maybe [Text]
a} :: RemoveTagsFromVault) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | 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.
removeTagsFromVault_accountId :: Lens.Lens' RemoveTagsFromVault Prelude.Text
removeTagsFromVault_accountId :: Lens' RemoveTagsFromVault Text
removeTagsFromVault_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveTagsFromVault' {Text
accountId :: Text
$sel:accountId:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
accountId} -> Text
accountId) (\s :: RemoveTagsFromVault
s@RemoveTagsFromVault' {} Text
a -> RemoveTagsFromVault
s {$sel:accountId:RemoveTagsFromVault' :: Text
accountId = Text
a} :: RemoveTagsFromVault)

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

instance Core.AWSRequest RemoveTagsFromVault where
  type
    AWSResponse RemoveTagsFromVault =
      RemoveTagsFromVaultResponse
  request :: (Service -> Service)
-> RemoveTagsFromVault -> Request RemoveTagsFromVault
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, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RemoveTagsFromVault
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RemoveTagsFromVault)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull RemoveTagsFromVaultResponse
RemoveTagsFromVaultResponse'

instance Prelude.Hashable RemoveTagsFromVault where
  hashWithSalt :: Int -> RemoveTagsFromVault -> Int
hashWithSalt Int
_salt RemoveTagsFromVault' {Maybe [Text]
Text
vaultName :: Text
accountId :: Text
tagKeys :: Maybe [Text]
$sel:vaultName:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
$sel:accountId:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
$sel:tagKeys:RemoveTagsFromVault' :: RemoveTagsFromVault -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
tagKeys
      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 RemoveTagsFromVault where
  rnf :: RemoveTagsFromVault -> ()
rnf RemoveTagsFromVault' {Maybe [Text]
Text
vaultName :: Text
accountId :: Text
tagKeys :: Maybe [Text]
$sel:vaultName:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
$sel:accountId:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
$sel:tagKeys:RemoveTagsFromVault' :: RemoveTagsFromVault -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
tagKeys
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 RemoveTagsFromVault where
  toHeaders :: RemoveTagsFromVault -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON RemoveTagsFromVault where
  toJSON :: RemoveTagsFromVault -> Value
toJSON RemoveTagsFromVault' {Maybe [Text]
Text
vaultName :: Text
accountId :: Text
tagKeys :: Maybe [Text]
$sel:vaultName:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
$sel:accountId:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
$sel:tagKeys:RemoveTagsFromVault' :: RemoveTagsFromVault -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"TagKeys" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
tagKeys]
      )

instance Data.ToPath RemoveTagsFromVault where
  toPath :: RemoveTagsFromVault -> ByteString
toPath RemoveTagsFromVault' {Maybe [Text]
Text
vaultName :: Text
accountId :: Text
tagKeys :: Maybe [Text]
$sel:vaultName:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
$sel:accountId:RemoveTagsFromVault' :: RemoveTagsFromVault -> Text
$sel:tagKeys:RemoveTagsFromVault' :: RemoveTagsFromVault -> Maybe [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,
        ByteString
"/tags"
      ]

instance Data.ToQuery RemoveTagsFromVault where
  toQuery :: RemoveTagsFromVault -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const
      (forall a. Monoid a => [a] -> a
Prelude.mconcat [QueryString
"operation=remove"])

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

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

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