{-# 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.GetObjectTagging
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the tag-set of an object. You send the GET request against the
-- tagging subresource associated with the object.
--
-- To use this operation, you must have permission to perform the
-- @s3:GetObjectTagging@ action. By default, the GET action returns
-- information about current version of an object. For a versioned bucket,
-- you can have multiple versions of an object in your bucket. To retrieve
-- tags of any other version, use the versionId query parameter. You also
-- need permission for the @s3:GetObjectVersionTagging@ action.
--
-- By default, the bucket owner has this permission and can grant this
-- permission to others.
--
-- For information about the Amazon S3 object tagging feature, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/object-tagging.html Object Tagging>.
--
-- The following actions are related to @GetObjectTagging@:
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_DeleteObjectTagging.html DeleteObjectTagging>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectAttributes.html GetObjectAttributes>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_PutObjectTagging.html PutObjectTagging>
module Amazonka.S3.GetObjectTagging
  ( -- * Creating a Request
    GetObjectTagging (..),
    newGetObjectTagging,

    -- * Request Lenses
    getObjectTagging_expectedBucketOwner,
    getObjectTagging_requestPayer,
    getObjectTagging_versionId,
    getObjectTagging_bucket,
    getObjectTagging_key,

    -- * Destructuring the Response
    GetObjectTaggingResponse (..),
    newGetObjectTaggingResponse,

    -- * Response Lenses
    getObjectTaggingResponse_versionId,
    getObjectTaggingResponse_httpStatus,
    getObjectTaggingResponse_tagSet,
  )
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:/ 'newGetObjectTagging' smart constructor.
data GetObjectTagging = GetObjectTagging'
  { -- | 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).
    GetObjectTagging -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    GetObjectTagging -> Maybe RequestPayer
requestPayer :: Prelude.Maybe RequestPayer,
    -- | The versionId of the object for which to get the tagging information.
    GetObjectTagging -> Maybe ObjectVersionId
versionId :: Prelude.Maybe ObjectVersionId,
    -- | The bucket name containing the object for which to get the tagging
    -- information.
    --
    -- 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/.
    GetObjectTagging -> BucketName
bucket :: BucketName,
    -- | Object key for which to get the tagging information.
    GetObjectTagging -> ObjectKey
key :: ObjectKey
  }
  deriving (GetObjectTagging -> GetObjectTagging -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetObjectTagging -> GetObjectTagging -> Bool
$c/= :: GetObjectTagging -> GetObjectTagging -> Bool
== :: GetObjectTagging -> GetObjectTagging -> Bool
$c== :: GetObjectTagging -> GetObjectTagging -> Bool
Prelude.Eq, ReadPrec [GetObjectTagging]
ReadPrec GetObjectTagging
Int -> ReadS GetObjectTagging
ReadS [GetObjectTagging]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetObjectTagging]
$creadListPrec :: ReadPrec [GetObjectTagging]
readPrec :: ReadPrec GetObjectTagging
$creadPrec :: ReadPrec GetObjectTagging
readList :: ReadS [GetObjectTagging]
$creadList :: ReadS [GetObjectTagging]
readsPrec :: Int -> ReadS GetObjectTagging
$creadsPrec :: Int -> ReadS GetObjectTagging
Prelude.Read, Int -> GetObjectTagging -> ShowS
[GetObjectTagging] -> ShowS
GetObjectTagging -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectTagging] -> ShowS
$cshowList :: [GetObjectTagging] -> ShowS
show :: GetObjectTagging -> String
$cshow :: GetObjectTagging -> String
showsPrec :: Int -> GetObjectTagging -> ShowS
$cshowsPrec :: Int -> GetObjectTagging -> ShowS
Prelude.Show, forall x. Rep GetObjectTagging x -> GetObjectTagging
forall x. GetObjectTagging -> Rep GetObjectTagging x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetObjectTagging x -> GetObjectTagging
$cfrom :: forall x. GetObjectTagging -> Rep GetObjectTagging x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectTagging' 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:
--
-- 'expectedBucketOwner', 'getObjectTagging_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', 'getObjectTagging_requestPayer' - Undocumented member.
--
-- 'versionId', 'getObjectTagging_versionId' - The versionId of the object for which to get the tagging information.
--
-- 'bucket', 'getObjectTagging_bucket' - The bucket name containing the object for which to get the tagging
-- information.
--
-- 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', 'getObjectTagging_key' - Object key for which to get the tagging information.
newGetObjectTagging ::
  -- | 'bucket'
  BucketName ->
  -- | 'key'
  ObjectKey ->
  GetObjectTagging
newGetObjectTagging :: BucketName -> ObjectKey -> GetObjectTagging
newGetObjectTagging BucketName
pBucket_ ObjectKey
pKey_ =
  GetObjectTagging'
    { $sel:expectedBucketOwner:GetObjectTagging' :: Maybe Text
expectedBucketOwner =
        forall a. Maybe a
Prelude.Nothing,
      $sel:requestPayer:GetObjectTagging' :: Maybe RequestPayer
requestPayer = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:GetObjectTagging' :: Maybe ObjectVersionId
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:GetObjectTagging' :: BucketName
bucket = BucketName
pBucket_,
      $sel:key:GetObjectTagging' :: ObjectKey
key = ObjectKey
pKey_
    }

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

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

-- | The versionId of the object for which to get the tagging information.
getObjectTagging_versionId :: Lens.Lens' GetObjectTagging (Prelude.Maybe ObjectVersionId)
getObjectTagging_versionId :: Lens' GetObjectTagging (Maybe ObjectVersionId)
getObjectTagging_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectTagging' {Maybe ObjectVersionId
versionId :: Maybe ObjectVersionId
$sel:versionId:GetObjectTagging' :: GetObjectTagging -> Maybe ObjectVersionId
versionId} -> Maybe ObjectVersionId
versionId) (\s :: GetObjectTagging
s@GetObjectTagging' {} Maybe ObjectVersionId
a -> GetObjectTagging
s {$sel:versionId:GetObjectTagging' :: Maybe ObjectVersionId
versionId = Maybe ObjectVersionId
a} :: GetObjectTagging)

-- | The bucket name containing the object for which to get the tagging
-- information.
--
-- 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/.
getObjectTagging_bucket :: Lens.Lens' GetObjectTagging BucketName
getObjectTagging_bucket :: Lens' GetObjectTagging BucketName
getObjectTagging_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectTagging' {BucketName
bucket :: BucketName
$sel:bucket:GetObjectTagging' :: GetObjectTagging -> BucketName
bucket} -> BucketName
bucket) (\s :: GetObjectTagging
s@GetObjectTagging' {} BucketName
a -> GetObjectTagging
s {$sel:bucket:GetObjectTagging' :: BucketName
bucket = BucketName
a} :: GetObjectTagging)

-- | Object key for which to get the tagging information.
getObjectTagging_key :: Lens.Lens' GetObjectTagging ObjectKey
getObjectTagging_key :: Lens' GetObjectTagging ObjectKey
getObjectTagging_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectTagging' {ObjectKey
key :: ObjectKey
$sel:key:GetObjectTagging' :: GetObjectTagging -> ObjectKey
key} -> ObjectKey
key) (\s :: GetObjectTagging
s@GetObjectTagging' {} ObjectKey
a -> GetObjectTagging
s {$sel:key:GetObjectTagging' :: ObjectKey
key = ObjectKey
a} :: GetObjectTagging)

instance Core.AWSRequest GetObjectTagging where
  type
    AWSResponse GetObjectTagging =
      GetObjectTaggingResponse
  request :: (Service -> Service)
-> GetObjectTagging -> Request GetObjectTagging
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 => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetObjectTagging
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetObjectTagging)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ObjectVersionId -> Int -> [Tag] -> GetObjectTaggingResponse
GetObjectTaggingResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"TagSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"Tag"
                        )
      )

instance Prelude.Hashable GetObjectTagging where
  hashWithSalt :: Int -> GetObjectTagging -> Int
hashWithSalt Int
_salt GetObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
$sel:key:GetObjectTagging' :: GetObjectTagging -> ObjectKey
$sel:bucket:GetObjectTagging' :: GetObjectTagging -> BucketName
$sel:versionId:GetObjectTagging' :: GetObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:GetObjectTagging' :: GetObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:GetObjectTagging' :: GetObjectTagging -> Maybe Text
..} =
    Int
_salt
      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

instance Prelude.NFData GetObjectTagging where
  rnf :: GetObjectTagging -> ()
rnf GetObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
$sel:key:GetObjectTagging' :: GetObjectTagging -> ObjectKey
$sel:bucket:GetObjectTagging' :: GetObjectTagging -> BucketName
$sel:versionId:GetObjectTagging' :: GetObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:GetObjectTagging' :: GetObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:GetObjectTagging' :: GetObjectTagging -> Maybe Text
..} =
    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

instance Data.ToHeaders GetObjectTagging where
  toHeaders :: GetObjectTagging -> ResponseHeaders
toHeaders GetObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
$sel:key:GetObjectTagging' :: GetObjectTagging -> ObjectKey
$sel:bucket:GetObjectTagging' :: GetObjectTagging -> BucketName
$sel:versionId:GetObjectTagging' :: GetObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:GetObjectTagging' :: GetObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:GetObjectTagging' :: GetObjectTagging -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ 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 GetObjectTagging where
  toPath :: GetObjectTagging -> ByteString
toPath GetObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
$sel:key:GetObjectTagging' :: GetObjectTagging -> ObjectKey
$sel:bucket:GetObjectTagging' :: GetObjectTagging -> BucketName
$sel:versionId:GetObjectTagging' :: GetObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:GetObjectTagging' :: GetObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:GetObjectTagging' :: GetObjectTagging -> Maybe Text
..} =
    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 GetObjectTagging where
  toQuery :: GetObjectTagging -> QueryString
toQuery GetObjectTagging' {Maybe Text
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
requestPayer :: Maybe RequestPayer
expectedBucketOwner :: Maybe Text
$sel:key:GetObjectTagging' :: GetObjectTagging -> ObjectKey
$sel:bucket:GetObjectTagging' :: GetObjectTagging -> BucketName
$sel:versionId:GetObjectTagging' :: GetObjectTagging -> Maybe ObjectVersionId
$sel:requestPayer:GetObjectTagging' :: GetObjectTagging -> Maybe RequestPayer
$sel:expectedBucketOwner:GetObjectTagging' :: GetObjectTagging -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"versionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ObjectVersionId
versionId, QueryString
"tagging"]

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

-- |
-- Create a value of 'GetObjectTaggingResponse' 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', 'getObjectTaggingResponse_versionId' - The versionId of the object for which you got the tagging information.
--
-- 'httpStatus', 'getObjectTaggingResponse_httpStatus' - The response's http status code.
--
-- 'tagSet', 'getObjectTaggingResponse_tagSet' - Contains the tag set.
newGetObjectTaggingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetObjectTaggingResponse
newGetObjectTaggingResponse :: Int -> GetObjectTaggingResponse
newGetObjectTaggingResponse Int
pHttpStatus_ =
  GetObjectTaggingResponse'
    { $sel:versionId:GetObjectTaggingResponse' :: Maybe ObjectVersionId
versionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetObjectTaggingResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:tagSet:GetObjectTaggingResponse' :: [Tag]
tagSet = forall a. Monoid a => a
Prelude.mempty
    }

-- | The versionId of the object for which you got the tagging information.
getObjectTaggingResponse_versionId :: Lens.Lens' GetObjectTaggingResponse (Prelude.Maybe ObjectVersionId)
getObjectTaggingResponse_versionId :: Lens' GetObjectTaggingResponse (Maybe ObjectVersionId)
getObjectTaggingResponse_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectTaggingResponse' {Maybe ObjectVersionId
versionId :: Maybe ObjectVersionId
$sel:versionId:GetObjectTaggingResponse' :: GetObjectTaggingResponse -> Maybe ObjectVersionId
versionId} -> Maybe ObjectVersionId
versionId) (\s :: GetObjectTaggingResponse
s@GetObjectTaggingResponse' {} Maybe ObjectVersionId
a -> GetObjectTaggingResponse
s {$sel:versionId:GetObjectTaggingResponse' :: Maybe ObjectVersionId
versionId = Maybe ObjectVersionId
a} :: GetObjectTaggingResponse)

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

-- | Contains the tag set.
getObjectTaggingResponse_tagSet :: Lens.Lens' GetObjectTaggingResponse [Tag]
getObjectTaggingResponse_tagSet :: Lens' GetObjectTaggingResponse [Tag]
getObjectTaggingResponse_tagSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectTaggingResponse' {[Tag]
tagSet :: [Tag]
$sel:tagSet:GetObjectTaggingResponse' :: GetObjectTaggingResponse -> [Tag]
tagSet} -> [Tag]
tagSet) (\s :: GetObjectTaggingResponse
s@GetObjectTaggingResponse' {} [Tag]
a -> GetObjectTaggingResponse
s {$sel:tagSet:GetObjectTaggingResponse' :: [Tag]
tagSet = [Tag]
a} :: GetObjectTaggingResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Prelude.NFData GetObjectTaggingResponse where
  rnf :: GetObjectTaggingResponse -> ()
rnf GetObjectTaggingResponse' {Int
[Tag]
Maybe ObjectVersionId
tagSet :: [Tag]
httpStatus :: Int
versionId :: Maybe ObjectVersionId
$sel:tagSet:GetObjectTaggingResponse' :: GetObjectTaggingResponse -> [Tag]
$sel:httpStatus:GetObjectTaggingResponse' :: GetObjectTaggingResponse -> Int
$sel:versionId:GetObjectTaggingResponse' :: GetObjectTaggingResponse -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Tag]
tagSet