{-# 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.AddTagsToVault
-- 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 adds the specified tags to a vault. Each tag is composed
-- of a key and a value. Each vault can have up to 10 tags. If your request
-- would cause the tag limit for the vault to be exceeded, the operation
-- throws the @LimitExceededException@ error. If a tag already exists on
-- the vault under a specified key, the existing key value will be
-- overwritten. For more information about tags, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/tagging.html Tagging Amazon S3 Glacier Resources>.
module Amazonka.Glacier.AddTagsToVault
  ( -- * Creating a Request
    AddTagsToVault (..),
    newAddTagsToVault,

    -- * Request Lenses
    addTagsToVault_tags,
    addTagsToVault_accountId,
    addTagsToVault_vaultName,

    -- * Destructuring the Response
    AddTagsToVaultResponse (..),
    newAddTagsToVaultResponse,
  )
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 values for @AddTagsToVault@.
--
-- /See:/ 'newAddTagsToVault' smart constructor.
data AddTagsToVault = AddTagsToVault'
  { -- | The tags to add to the vault. Each tag is composed of a key and a value.
    -- The value can be an empty string.
    AddTagsToVault -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text 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.
    AddTagsToVault -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    AddTagsToVault -> Text
vaultName :: Prelude.Text
  }
  deriving (AddTagsToVault -> AddTagsToVault -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddTagsToVault -> AddTagsToVault -> Bool
$c/= :: AddTagsToVault -> AddTagsToVault -> Bool
== :: AddTagsToVault -> AddTagsToVault -> Bool
$c== :: AddTagsToVault -> AddTagsToVault -> Bool
Prelude.Eq, ReadPrec [AddTagsToVault]
ReadPrec AddTagsToVault
Int -> ReadS AddTagsToVault
ReadS [AddTagsToVault]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddTagsToVault]
$creadListPrec :: ReadPrec [AddTagsToVault]
readPrec :: ReadPrec AddTagsToVault
$creadPrec :: ReadPrec AddTagsToVault
readList :: ReadS [AddTagsToVault]
$creadList :: ReadS [AddTagsToVault]
readsPrec :: Int -> ReadS AddTagsToVault
$creadsPrec :: Int -> ReadS AddTagsToVault
Prelude.Read, Int -> AddTagsToVault -> ShowS
[AddTagsToVault] -> ShowS
AddTagsToVault -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddTagsToVault] -> ShowS
$cshowList :: [AddTagsToVault] -> ShowS
show :: AddTagsToVault -> String
$cshow :: AddTagsToVault -> String
showsPrec :: Int -> AddTagsToVault -> ShowS
$cshowsPrec :: Int -> AddTagsToVault -> ShowS
Prelude.Show, forall x. Rep AddTagsToVault x -> AddTagsToVault
forall x. AddTagsToVault -> Rep AddTagsToVault x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddTagsToVault x -> AddTagsToVault
$cfrom :: forall x. AddTagsToVault -> Rep AddTagsToVault x
Prelude.Generic)

-- |
-- Create a value of 'AddTagsToVault' 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:
--
-- 'tags', 'addTagsToVault_tags' - The tags to add to the vault. Each tag is composed of a key and a value.
-- The value can be an empty string.
--
-- 'accountId', 'addTagsToVault_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', 'addTagsToVault_vaultName' - The name of the vault.
newAddTagsToVault ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  AddTagsToVault
newAddTagsToVault :: Text -> Text -> AddTagsToVault
newAddTagsToVault Text
pAccountId_ Text
pVaultName_ =
  AddTagsToVault'
    { $sel:tags:AddTagsToVault' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:accountId:AddTagsToVault' :: Text
accountId = Text
pAccountId_,
      $sel:vaultName:AddTagsToVault' :: Text
vaultName = Text
pVaultName_
    }

-- | The tags to add to the vault. Each tag is composed of a key and a value.
-- The value can be an empty string.
addTagsToVault_tags :: Lens.Lens' AddTagsToVault (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
addTagsToVault_tags :: Lens' AddTagsToVault (Maybe (HashMap Text Text))
addTagsToVault_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddTagsToVault' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:AddTagsToVault' :: AddTagsToVault -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: AddTagsToVault
s@AddTagsToVault' {} Maybe (HashMap Text Text)
a -> AddTagsToVault
s {$sel:tags:AddTagsToVault' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: AddTagsToVault) 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.
addTagsToVault_accountId :: Lens.Lens' AddTagsToVault Prelude.Text
addTagsToVault_accountId :: Lens' AddTagsToVault Text
addTagsToVault_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddTagsToVault' {Text
accountId :: Text
$sel:accountId:AddTagsToVault' :: AddTagsToVault -> Text
accountId} -> Text
accountId) (\s :: AddTagsToVault
s@AddTagsToVault' {} Text
a -> AddTagsToVault
s {$sel:accountId:AddTagsToVault' :: Text
accountId = Text
a} :: AddTagsToVault)

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

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

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

instance Data.ToJSON AddTagsToVault where
  toJSON :: AddTagsToVault -> Value
toJSON AddTagsToVault' {Maybe (HashMap Text Text)
Text
vaultName :: Text
accountId :: Text
tags :: Maybe (HashMap Text Text)
$sel:vaultName:AddTagsToVault' :: AddTagsToVault -> Text
$sel:accountId:AddTagsToVault' :: AddTagsToVault -> Text
$sel:tags:AddTagsToVault' :: AddTagsToVault -> Maybe (HashMap Text Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"Tags" 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 (HashMap Text Text)
tags]
      )

instance Data.ToPath AddTagsToVault where
  toPath :: AddTagsToVault -> ByteString
toPath AddTagsToVault' {Maybe (HashMap Text Text)
Text
vaultName :: Text
accountId :: Text
tags :: Maybe (HashMap Text Text)
$sel:vaultName:AddTagsToVault' :: AddTagsToVault -> Text
$sel:accountId:AddTagsToVault' :: AddTagsToVault -> Text
$sel:tags:AddTagsToVault' :: AddTagsToVault -> Maybe (HashMap Text 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 AddTagsToVault where
  toQuery :: AddTagsToVault -> QueryString
toQuery =
    forall a b. a -> b -> a
Prelude.const (forall a. Monoid a => [a] -> a
Prelude.mconcat [QueryString
"operation=add"])

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

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

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