{-# 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.S3.PutObjectTagging
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the supplied tag-set to an object that already exists in a bucket.
--
-- A tag is a key-value pair. You can associate tags with an object by
-- sending a PUT request against the tagging subresource that is associated
-- with the object. You can retrieve tags by sending a GET request. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectTagging.html GetObjectTagging>.
--
-- For tagging-related restrictions related to characters and encodings,
-- see
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/allocation-tag-restrictions.html Tag Restrictions>.
-- Note that Amazon S3 limits the maximum number of tags to 10 tags per
-- object.
--
-- To use this operation, you must have permission to perform the
-- @s3:PutObjectTagging@ action. By default, the bucket owner has this
-- permission and can grant this permission to others.
--
-- To put tags of any other version, use the @versionId@ query parameter.
-- You also need permission for the @s3:PutObjectVersionTagging@ action.
--
-- For information about the Amazon S3 object tagging feature, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/object-tagging.html Object Tagging>.
--
-- __Special Errors__
--
-- -   -   /Code: InvalidTagError/
--
--     -   /Cause: The tag provided was not a valid tag. This error can
--         occur if the tag did not pass input validation. For more
--         information, see
--         <https://docs.aws.amazon.com/AmazonS3/latest/dev/object-tagging.html Object Tagging>./
--
-- -   -   /Code: MalformedXMLError/
--
--     -   /Cause: The XML provided does not match the schema./
--
-- -   -   /Code: OperationAbortedError/
--
--     -   /Cause: A conflicting conditional action is currently in
--         progress against this resource. Please try again./
--
-- -   -   /Code: InternalError/
--
--     -   /Cause: The service was unable to apply the provided tag to the
--         object./
--
-- __Related Resources__
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectTagging.html GetObjectTagging>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_DeleteObjectTagging.html DeleteObjectTagging>
module Amazonka.S3.PutObjectTagging
  ( -- * Creating a Request
    PutObjectTagging (..),
    newPutObjectTagging,

    -- * Request Lenses
    putObjectTagging_checksumAlgorithm,
    putObjectTagging_contentMD5,
    putObjectTagging_expectedBucketOwner,
    putObjectTagging_requestPayer,
    putObjectTagging_versionId,
    putObjectTagging_bucket,
    putObjectTagging_key,
    putObjectTagging_tagging,

    -- * Destructuring the Response
    PutObjectTaggingResponse (..),
    newPutObjectTaggingResponse,

    -- * Response Lenses
    putObjectTaggingResponse_versionId,
    putObjectTaggingResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.S3.Types

-- | /See:/ 'newPutObjectTagging' smart constructor.
data PutObjectTagging = PutObjectTagging'
  { -- | Indicates the algorithm used to create the checksum for the object when
    -- using the SDK. This header will not provide any additional functionality
    -- if not using the SDK. When sending this header, there must be a
    -- corresponding @x-amz-checksum@ or @x-amz-trailer@ header sent.
    -- Otherwise, Amazon S3 fails the request with the HTTP status code
    -- @400 Bad Request@. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
    -- in the /Amazon S3 User Guide/.
    --
    -- If you provide an individual checksum, Amazon S3 ignores any provided
    -- @ChecksumAlgorithm@ parameter.
    PutObjectTagging -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | The MD5 hash for the request body.
    --
    -- For requests made using the Amazon Web Services Command Line Interface
    -- (CLI) or Amazon Web Services SDKs, this field is calculated
    -- automatically.
    PutObjectTagging -> Maybe Text
contentMD5 :: Prelude.Maybe Prelude.Text,
    -- | The account ID of the expected bucket owner. If the bucket is owned by a
    -- different account, the request fails with the HTTP status code
    -- @403 Forbidden@ (access denied).
    PutObjectTagging -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    PutObjectTagging -> Maybe RequestPayer
requestPayer :: Prelude.Maybe RequestPayer,
    -- | The versionId of the object that the tag-set will be added to.
    PutObjectTagging -> Maybe ObjectVersionId
versionId :: Prelude.Maybe ObjectVersionId,
    -- | The bucket name containing the object.
    --
    -- When using this action with an access point, you must direct requests to
    -- the access point hostname. The access point hostname takes the form
    -- /AccessPointName/-/AccountId/.s3-accesspoint./Region/.amazonaws.com.
    -- When using this action with an access point through the Amazon Web
    -- Services SDKs, you provide the access point ARN in place of the bucket
    -- name. For more information about access point ARNs, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/using-access-points.html Using access points>
    -- in the /Amazon S3 User Guide/.
    --
    -- When using this action with Amazon S3 on Outposts, you must direct
    -- requests to the S3 on Outposts hostname. The S3 on Outposts hostname
    -- takes the form
    -- @ @/@AccessPointName@/@-@/@AccountId@/@.@/@outpostID@/@.s3-outposts.@/@Region@/@.amazonaws.com@.
    -- When using this action with S3 on Outposts through the Amazon Web
    -- Services SDKs, you provide the Outposts bucket ARN in place of the
    -- bucket name. For more information about S3 on Outposts ARNs, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/S3onOutposts.html Using Amazon S3 on Outposts>
    -- in the /Amazon S3 User Guide/.
    PutObjectTagging -> BucketName
bucket :: BucketName,
    -- | Name of the object key.
    PutObjectTagging -> ObjectKey
key :: ObjectKey,
    -- | Container for the @TagSet@ and @Tag@ elements
    PutObjectTagging -> Tagging
tagging :: Tagging
  }
  deriving (PutObjectTagging -> PutObjectTagging -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutObjectTagging -> PutObjectTagging -> Bool
$c/= :: PutObjectTagging -> PutObjectTagging -> Bool
== :: PutObjectTagging -> PutObjectTagging -> Bool
$c== :: PutObjectTagging -> PutObjectTagging -> Bool
Prelude.Eq, ReadPrec [PutObjectTagging]
ReadPrec PutObjectTagging
Int -> ReadS PutObjectTagging
ReadS [PutObjectTagging]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutObjectTagging]
$creadListPrec :: ReadPrec [PutObjectTagging]
readPrec :: ReadPrec PutObjectTagging
$creadPrec :: ReadPrec PutObjectTagging
readList :: ReadS [PutObjectTagging]
$creadList :: ReadS [PutObjectTagging]
readsPrec :: Int -> ReadS PutObjectTagging
$creadsPrec :: Int -> ReadS PutObjectTagging
Prelude.Read, Int -> PutObjectTagging -> ShowS
[PutObjectTagging] -> ShowS
PutObjectTagging -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutObjectTagging] -> ShowS
$cshowList :: [PutObjectTagging] -> ShowS
show :: PutObjectTagging -> String
$cshow :: PutObjectTagging -> String
showsPrec :: Int -> PutObjectTagging -> ShowS
$cshowsPrec :: Int -> PutObjectTagging -> ShowS
Prelude.Show, forall x. Rep PutObjectTagging x -> PutObjectTagging
forall x. PutObjectTagging -> Rep PutObjectTagging x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutObjectTagging x -> PutObjectTagging
$cfrom :: forall x. PutObjectTagging -> Rep PutObjectTagging x
Prelude.Generic)

-- |
-- Create a value of 'PutObjectTagging' 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:
--
-- 'checksumAlgorithm', 'putObjectTagging_checksumAlgorithm' - Indicates the algorithm used to create the checksum for the object when
-- using the SDK. This header will not provide any additional functionality
-- if not using the SDK. When sending this header, there must be a
-- corresponding @x-amz-checksum@ or @x-amz-trailer@ header sent.
-- Otherwise, Amazon S3 fails the request with the HTTP status code
-- @400 Bad Request@. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
-- in the /Amazon S3 User Guide/.
--
-- If you provide an individual checksum, Amazon S3 ignores any provided
-- @ChecksumAlgorithm@ parameter.
--
-- 'contentMD5', 'putObjectTagging_contentMD5' - The MD5 hash for the request body.
--
-- For requests made using the Amazon Web Services Command Line Interface
-- (CLI) or Amazon Web Services SDKs, this field is calculated
-- automatically.
--
-- 'expectedBucketOwner', 'putObjectTagging_expectedBucketOwner' - The account ID of the expected bucket owner. If the bucket is owned by a
-- different account, the request fails with the HTTP status code
-- @403 Forbidden@ (access denied).
--
-- 'requestPayer', 'putObjectTagging_requestPayer' - Undocumented member.
--
-- 'versionId', 'putObjectTagging_versionId' - The versionId of the object that the tag-set will be added to.
--
-- 'bucket', 'putObjectTagging_bucket' - The bucket name containing the object.
--
-- When using this action with an access point, you must direct requests to
-- the access point hostname. The access point hostname takes the form
-- /AccessPointName/-/AccountId/.s3-accesspoint./Region/.amazonaws.com.
-- When using this action with an access point through the Amazon Web
-- Services SDKs, you provide the access point ARN in place of the bucket
-- name. For more information about access point ARNs, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/using-access-points.html Using access points>
-- in the /Amazon S3 User Guide/.
--
-- When using this action with Amazon S3 on Outposts, you must direct
-- requests to the S3 on Outposts hostname. The S3 on Outposts hostname
-- takes the form
-- @ @/@AccessPointName@/@-@/@AccountId@/@.@/@outpostID@/@.s3-outposts.@/@Region@/@.amazonaws.com@.
-- When using this action with S3 on Outposts through the Amazon Web
-- Services SDKs, you provide the Outposts bucket ARN in place of the
-- bucket name. For more information about S3 on Outposts ARNs, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/S3onOutposts.html Using Amazon S3 on Outposts>
-- in the /Amazon S3 User Guide/.
--
-- 'key', 'putObjectTagging_key' - Name of the object key.
--
-- 'tagging', 'putObjectTagging_tagging' - Container for the @TagSet@ and @Tag@ elements
newPutObjectTagging ::
  -- | 'bucket'
  BucketName ->
  -- | 'key'
  ObjectKey ->
  -- | 'tagging'
  Tagging ->
  PutObjectTagging
newPutObjectTagging :: BucketName -> ObjectKey -> Tagging -> PutObjectTagging
newPutObjectTagging BucketName
pBucket_ ObjectKey
pKey_ Tagging
pTagging_ =
  PutObjectTagging'
    { $sel:checksumAlgorithm:PutObjectTagging' :: Maybe ChecksumAlgorithm
checksumAlgorithm =
        forall a. Maybe a
Prelude.Nothing,
      $sel:contentMD5:PutObjectTagging' :: Maybe Text
contentMD5 = forall a. Maybe a
Prelude.Nothing,
      $sel:expectedBucketOwner:PutObjectTagging' :: Maybe Text
expectedBucketOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:requestPayer:PutObjectTagging' :: Maybe RequestPayer
requestPayer = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:PutObjectTagging' :: Maybe ObjectVersionId
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:PutObjectTagging' :: BucketName
bucket = BucketName
pBucket_,
      $sel:key:PutObjectTagging' :: ObjectKey
key = ObjectKey
pKey_,
      $sel:tagging:PutObjectTagging' :: Tagging
tagging = Tagging
pTagging_
    }

-- | Indicates the algorithm used to create the checksum for the object when
-- using the SDK. This header will not provide any additional functionality
-- if not using the SDK. When sending this header, there must be a
-- corresponding @x-amz-checksum@ or @x-amz-trailer@ header sent.
-- Otherwise, Amazon S3 fails the request with the HTTP status code
-- @400 Bad Request@. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
-- in the /Amazon S3 User Guide/.
--
-- If you provide an individual checksum, Amazon S3 ignores any provided
-- @ChecksumAlgorithm@ parameter.
putObjectTagging_checksumAlgorithm :: Lens.Lens' PutObjectTagging (Prelude.Maybe ChecksumAlgorithm)
putObjectTagging_checksumAlgorithm :: Lens' PutObjectTagging (Maybe ChecksumAlgorithm)
putObjectTagging_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTagging' {Maybe ChecksumAlgorithm
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:checksumAlgorithm:PutObjectTagging' :: PutObjectTagging -> Maybe ChecksumAlgorithm
checksumAlgorithm} -> Maybe ChecksumAlgorithm
checksumAlgorithm) (\s :: PutObjectTagging
s@PutObjectTagging' {} Maybe ChecksumAlgorithm
a -> PutObjectTagging
s {$sel:checksumAlgorithm:PutObjectTagging' :: Maybe ChecksumAlgorithm
checksumAlgorithm = Maybe ChecksumAlgorithm
a} :: PutObjectTagging)

-- | The MD5 hash for the request body.
--
-- For requests made using the Amazon Web Services Command Line Interface
-- (CLI) or Amazon Web Services SDKs, this field is calculated
-- automatically.
putObjectTagging_contentMD5 :: Lens.Lens' PutObjectTagging (Prelude.Maybe Prelude.Text)
putObjectTagging_contentMD5 :: Lens' PutObjectTagging (Maybe Text)
putObjectTagging_contentMD5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTagging' {Maybe Text
contentMD5 :: Maybe Text
$sel:contentMD5:PutObjectTagging' :: PutObjectTagging -> Maybe Text
contentMD5} -> Maybe Text
contentMD5) (\s :: PutObjectTagging
s@PutObjectTagging' {} Maybe Text
a -> PutObjectTagging
s {$sel:contentMD5:PutObjectTagging' :: Maybe Text
contentMD5 = Maybe Text
a} :: PutObjectTagging)

-- | The account ID of the expected bucket owner. If the bucket is owned by a
-- different account, the request fails with the HTTP status code
-- @403 Forbidden@ (access denied).
putObjectTagging_expectedBucketOwner :: Lens.Lens' PutObjectTagging (Prelude.Maybe Prelude.Text)
putObjectTagging_expectedBucketOwner :: Lens' PutObjectTagging (Maybe Text)
putObjectTagging_expectedBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTagging' {Maybe Text
expectedBucketOwner :: Maybe Text
$sel:expectedBucketOwner:PutObjectTagging' :: PutObjectTagging -> Maybe Text
expectedBucketOwner} -> Maybe Text
expectedBucketOwner) (\s :: PutObjectTagging
s@PutObjectTagging' {} Maybe Text
a -> PutObjectTagging
s {$sel:expectedBucketOwner:PutObjectTagging' :: Maybe Text
expectedBucketOwner = Maybe Text
a} :: PutObjectTagging)

-- | Undocumented member.
putObjectTagging_requestPayer :: Lens.Lens' PutObjectTagging (Prelude.Maybe RequestPayer)
putObjectTagging_requestPayer :: Lens' PutObjectTagging (Maybe RequestPayer)
putObjectTagging_requestPayer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTagging' {Maybe RequestPayer
requestPayer :: Maybe RequestPayer
$sel:requestPayer:PutObjectTagging' :: PutObjectTagging -> Maybe RequestPayer
requestPayer} -> Maybe RequestPayer
requestPayer) (\s :: PutObjectTagging
s@PutObjectTagging' {} Maybe RequestPayer
a -> PutObjectTagging
s {$sel:requestPayer:PutObjectTagging' :: Maybe RequestPayer
requestPayer = Maybe RequestPayer
a} :: PutObjectTagging)

-- | The versionId of the object that the tag-set will be added to.
putObjectTagging_versionId :: Lens.Lens' PutObjectTagging (Prelude.Maybe ObjectVersionId)
putObjectTagging_versionId :: Lens' PutObjectTagging (Maybe ObjectVersionId)
putObjectTagging_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTagging' {Maybe ObjectVersionId
versionId :: Maybe ObjectVersionId
$sel:versionId:PutObjectTagging' :: PutObjectTagging -> Maybe ObjectVersionId
versionId} -> Maybe ObjectVersionId
versionId) (\s :: PutObjectTagging
s@PutObjectTagging' {} Maybe ObjectVersionId
a -> PutObjectTagging
s {$sel:versionId:PutObjectTagging' :: Maybe ObjectVersionId
versionId = Maybe ObjectVersionId
a} :: PutObjectTagging)

-- | The bucket name containing the object.
--
-- When using this action with an access point, you must direct requests to
-- the access point hostname. The access point hostname takes the form
-- /AccessPointName/-/AccountId/.s3-accesspoint./Region/.amazonaws.com.
-- When using this action with an access point through the Amazon Web
-- Services SDKs, you provide the access point ARN in place of the bucket
-- name. For more information about access point ARNs, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/using-access-points.html Using access points>
-- in the /Amazon S3 User Guide/.
--
-- When using this action with Amazon S3 on Outposts, you must direct
-- requests to the S3 on Outposts hostname. The S3 on Outposts hostname
-- takes the form
-- @ @/@AccessPointName@/@-@/@AccountId@/@.@/@outpostID@/@.s3-outposts.@/@Region@/@.amazonaws.com@.
-- When using this action with S3 on Outposts through the Amazon Web
-- Services SDKs, you provide the Outposts bucket ARN in place of the
-- bucket name. For more information about S3 on Outposts ARNs, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/S3onOutposts.html Using Amazon S3 on Outposts>
-- in the /Amazon S3 User Guide/.
putObjectTagging_bucket :: Lens.Lens' PutObjectTagging BucketName
putObjectTagging_bucket :: Lens' PutObjectTagging BucketName
putObjectTagging_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTagging' {BucketName
bucket :: BucketName
$sel:bucket:PutObjectTagging' :: PutObjectTagging -> BucketName
bucket} -> BucketName
bucket) (\s :: PutObjectTagging
s@PutObjectTagging' {} BucketName
a -> PutObjectTagging
s {$sel:bucket:PutObjectTagging' :: BucketName
bucket = BucketName
a} :: PutObjectTagging)

-- | Name of the object key.
putObjectTagging_key :: Lens.Lens' PutObjectTagging ObjectKey
putObjectTagging_key :: Lens' PutObjectTagging ObjectKey
putObjectTagging_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTagging' {ObjectKey
key :: ObjectKey
$sel:key:PutObjectTagging' :: PutObjectTagging -> ObjectKey
key} -> ObjectKey
key) (\s :: PutObjectTagging
s@PutObjectTagging' {} ObjectKey
a -> PutObjectTagging
s {$sel:key:PutObjectTagging' :: ObjectKey
key = ObjectKey
a} :: PutObjectTagging)

-- | Container for the @TagSet@ and @Tag@ elements
putObjectTagging_tagging :: Lens.Lens' PutObjectTagging Tagging
putObjectTagging_tagging :: Lens' PutObjectTagging Tagging
putObjectTagging_tagging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTagging' {Tagging
tagging :: Tagging
$sel:tagging:PutObjectTagging' :: PutObjectTagging -> Tagging
tagging} -> Tagging
tagging) (\s :: PutObjectTagging
s@PutObjectTagging' {} Tagging
a -> PutObjectTagging
s {$sel:tagging:PutObjectTagging' :: Tagging
tagging = Tagging
a} :: PutObjectTagging)

instance Core.AWSRequest PutObjectTagging where
  type
    AWSResponse PutObjectTagging =
      PutObjectTaggingResponse
  request :: (Service -> Service)
-> PutObjectTagging -> Request PutObjectTagging
request Service -> Service
overrides =
    forall a. Request a -> Request a
Request.s3vhost
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.putXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutObjectTagging
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutObjectTagging)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Maybe ObjectVersionId -> Int -> PutObjectTaggingResponse
PutObjectTaggingResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-version-id")
            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 PutObjectTagging where
  hashWithSalt :: Int -> PutObjectTagging -> Int
hashWithSalt Int
_salt PutObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe ChecksumAlgorithm
Maybe RequestPayer
ObjectKey
BucketName
Tagging
tagging :: Tagging
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:tagging:PutObjectTagging' :: PutObjectTagging -> Tagging
$sel:key:PutObjectTagging' :: PutObjectTagging -> ObjectKey
$sel:bucket:PutObjectTagging' :: PutObjectTagging -> BucketName
$sel:versionId:PutObjectTagging' :: PutObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:PutObjectTagging' :: PutObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:contentMD5:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:checksumAlgorithm:PutObjectTagging' :: PutObjectTagging -> Maybe ChecksumAlgorithm
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChecksumAlgorithm
checksumAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentMD5
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedBucketOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RequestPayer
requestPayer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ObjectVersionId
versionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketName
bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectKey
key
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Tagging
tagging

instance Prelude.NFData PutObjectTagging where
  rnf :: PutObjectTagging -> ()
rnf PutObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe ChecksumAlgorithm
Maybe RequestPayer
ObjectKey
BucketName
Tagging
tagging :: Tagging
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:tagging:PutObjectTagging' :: PutObjectTagging -> Tagging
$sel:key:PutObjectTagging' :: PutObjectTagging -> ObjectKey
$sel:bucket:PutObjectTagging' :: PutObjectTagging -> BucketName
$sel:versionId:PutObjectTagging' :: PutObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:PutObjectTagging' :: PutObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:contentMD5:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:checksumAlgorithm:PutObjectTagging' :: PutObjectTagging -> Maybe ChecksumAlgorithm
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ChecksumAlgorithm
checksumAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentMD5
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expectedBucketOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestPayer
requestPayer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ObjectVersionId
versionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BucketName
bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ObjectKey
key
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Tagging
tagging

instance Data.ToElement PutObjectTagging where
  toElement :: PutObjectTagging -> Element
toElement PutObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe ChecksumAlgorithm
Maybe RequestPayer
ObjectKey
BucketName
Tagging
tagging :: Tagging
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:tagging:PutObjectTagging' :: PutObjectTagging -> Tagging
$sel:key:PutObjectTagging' :: PutObjectTagging -> ObjectKey
$sel:bucket:PutObjectTagging' :: PutObjectTagging -> BucketName
$sel:versionId:PutObjectTagging' :: PutObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:PutObjectTagging' :: PutObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:contentMD5:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:checksumAlgorithm:PutObjectTagging' :: PutObjectTagging -> Maybe ChecksumAlgorithm
..} =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{http://s3.amazonaws.com/doc/2006-03-01/}Tagging"
      Tagging
tagging

instance Data.ToHeaders PutObjectTagging where
  toHeaders :: PutObjectTagging -> ResponseHeaders
toHeaders PutObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe ChecksumAlgorithm
Maybe RequestPayer
ObjectKey
BucketName
Tagging
tagging :: Tagging
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:tagging:PutObjectTagging' :: PutObjectTagging -> Tagging
$sel:key:PutObjectTagging' :: PutObjectTagging -> ObjectKey
$sel:bucket:PutObjectTagging' :: PutObjectTagging -> BucketName
$sel:versionId:PutObjectTagging' :: PutObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:PutObjectTagging' :: PutObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:contentMD5:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:checksumAlgorithm:PutObjectTagging' :: PutObjectTagging -> Maybe ChecksumAlgorithm
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-sdk-checksum-algorithm"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ChecksumAlgorithm
checksumAlgorithm,
        HeaderName
"Content-MD5" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
contentMD5,
        HeaderName
"x-amz-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
expectedBucketOwner,
        HeaderName
"x-amz-request-payer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe RequestPayer
requestPayer
      ]

instance Data.ToPath PutObjectTagging where
  toPath :: PutObjectTagging -> ByteString
toPath PutObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe ChecksumAlgorithm
Maybe RequestPayer
ObjectKey
BucketName
Tagging
tagging :: Tagging
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:tagging:PutObjectTagging' :: PutObjectTagging -> Tagging
$sel:key:PutObjectTagging' :: PutObjectTagging -> ObjectKey
$sel:bucket:PutObjectTagging' :: PutObjectTagging -> BucketName
$sel:versionId:PutObjectTagging' :: PutObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:PutObjectTagging' :: PutObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:contentMD5:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:checksumAlgorithm:PutObjectTagging' :: PutObjectTagging -> Maybe ChecksumAlgorithm
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS BucketName
bucket, ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS ObjectKey
key]

instance Data.ToQuery PutObjectTagging where
  toQuery :: PutObjectTagging -> QueryString
toQuery PutObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe ChecksumAlgorithm
Maybe RequestPayer
ObjectKey
BucketName
Tagging
tagging :: Tagging
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
contentMD5 :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:tagging:PutObjectTagging' :: PutObjectTagging -> Tagging
$sel:key:PutObjectTagging' :: PutObjectTagging -> ObjectKey
$sel:bucket:PutObjectTagging' :: PutObjectTagging -> BucketName
$sel:versionId:PutObjectTagging' :: PutObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:PutObjectTagging' :: PutObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:contentMD5:PutObjectTagging' :: PutObjectTagging -> Maybe Text
$sel:checksumAlgorithm:PutObjectTagging' :: PutObjectTagging -> Maybe ChecksumAlgorithm
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"versionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ObjectVersionId
versionId, QueryString
"tagging"]

-- | /See:/ 'newPutObjectTaggingResponse' smart constructor.
data PutObjectTaggingResponse = PutObjectTaggingResponse'
  { -- | The versionId of the object the tag-set was added to.
    PutObjectTaggingResponse -> Maybe ObjectVersionId
versionId :: Prelude.Maybe ObjectVersionId,
    -- | The response's http status code.
    PutObjectTaggingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutObjectTaggingResponse -> PutObjectTaggingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutObjectTaggingResponse -> PutObjectTaggingResponse -> Bool
$c/= :: PutObjectTaggingResponse -> PutObjectTaggingResponse -> Bool
== :: PutObjectTaggingResponse -> PutObjectTaggingResponse -> Bool
$c== :: PutObjectTaggingResponse -> PutObjectTaggingResponse -> Bool
Prelude.Eq, ReadPrec [PutObjectTaggingResponse]
ReadPrec PutObjectTaggingResponse
Int -> ReadS PutObjectTaggingResponse
ReadS [PutObjectTaggingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutObjectTaggingResponse]
$creadListPrec :: ReadPrec [PutObjectTaggingResponse]
readPrec :: ReadPrec PutObjectTaggingResponse
$creadPrec :: ReadPrec PutObjectTaggingResponse
readList :: ReadS [PutObjectTaggingResponse]
$creadList :: ReadS [PutObjectTaggingResponse]
readsPrec :: Int -> ReadS PutObjectTaggingResponse
$creadsPrec :: Int -> ReadS PutObjectTaggingResponse
Prelude.Read, Int -> PutObjectTaggingResponse -> ShowS
[PutObjectTaggingResponse] -> ShowS
PutObjectTaggingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutObjectTaggingResponse] -> ShowS
$cshowList :: [PutObjectTaggingResponse] -> ShowS
show :: PutObjectTaggingResponse -> String
$cshow :: PutObjectTaggingResponse -> String
showsPrec :: Int -> PutObjectTaggingResponse -> ShowS
$cshowsPrec :: Int -> PutObjectTaggingResponse -> ShowS
Prelude.Show, forall x.
Rep PutObjectTaggingResponse x -> PutObjectTaggingResponse
forall x.
PutObjectTaggingResponse -> Rep PutObjectTaggingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutObjectTaggingResponse x -> PutObjectTaggingResponse
$cfrom :: forall x.
PutObjectTaggingResponse -> Rep PutObjectTaggingResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutObjectTaggingResponse' 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:
--
-- 'versionId', 'putObjectTaggingResponse_versionId' - The versionId of the object the tag-set was added to.
--
-- 'httpStatus', 'putObjectTaggingResponse_httpStatus' - The response's http status code.
newPutObjectTaggingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutObjectTaggingResponse
newPutObjectTaggingResponse :: Int -> PutObjectTaggingResponse
newPutObjectTaggingResponse Int
pHttpStatus_ =
  PutObjectTaggingResponse'
    { $sel:versionId:PutObjectTaggingResponse' :: Maybe ObjectVersionId
versionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutObjectTaggingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The versionId of the object the tag-set was added to.
putObjectTaggingResponse_versionId :: Lens.Lens' PutObjectTaggingResponse (Prelude.Maybe ObjectVersionId)
putObjectTaggingResponse_versionId :: Lens' PutObjectTaggingResponse (Maybe ObjectVersionId)
putObjectTaggingResponse_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutObjectTaggingResponse' {Maybe ObjectVersionId
versionId :: Maybe ObjectVersionId
$sel:versionId:PutObjectTaggingResponse' :: PutObjectTaggingResponse -> Maybe ObjectVersionId
versionId} -> Maybe ObjectVersionId
versionId) (\s :: PutObjectTaggingResponse
s@PutObjectTaggingResponse' {} Maybe ObjectVersionId
a -> PutObjectTaggingResponse
s {$sel:versionId:PutObjectTaggingResponse' :: Maybe ObjectVersionId
versionId = Maybe ObjectVersionId
a} :: PutObjectTaggingResponse)

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

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