{-# 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.GetObjectAttributes
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves all the metadata from an object without returning the object
-- itself. This action is useful if you\'re interested only in an object\'s
-- metadata. To use @GetObjectAttributes@, you must have READ access to the
-- object.
--
-- @GetObjectAttributes@ combines the functionality of @GetObjectAcl@,
-- @GetObjectLegalHold@, @GetObjectLockConfiguration@,
-- @GetObjectRetention@, @GetObjectTagging@, @HeadObject@, and @ListParts@.
-- All of the data returned with each of those individual calls can be
-- returned with a single call to @GetObjectAttributes@.
--
-- If you encrypt an object by using server-side encryption with
-- customer-provided encryption keys (SSE-C) when you store the object in
-- Amazon S3, then when you retrieve the metadata from the object, you must
-- use the following headers:
--
-- -   @x-amz-server-side-encryption-customer-algorithm@
--
-- -   @x-amz-server-side-encryption-customer-key@
--
-- -   @x-amz-server-side-encryption-customer-key-MD5@
--
-- For more information about SSE-C, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Server-Side Encryption (Using Customer-Provided Encryption Keys)>
-- in the /Amazon S3 User Guide/.
--
-- -   Encryption request headers, such as @x-amz-server-side-encryption@,
--     should not be sent for GET requests if your object uses server-side
--     encryption with Amazon Web Services KMS keys stored in Amazon Web
--     Services Key Management Service (SSE-KMS) or server-side encryption
--     with Amazon S3 managed encryption keys (SSE-S3). If your object does
--     use these types of keys, you\'ll get an HTTP @400 Bad Request@
--     error.
--
-- -   The last modified property in this case is the creation date of the
--     object.
--
-- Consider the following when using request headers:
--
-- -   If both of the @If-Match@ and @If-Unmodified-Since@ headers are
--     present in the request as follows, then Amazon S3 returns the HTTP
--     status code @200 OK@ and the data requested:
--
--     -   @If-Match@ condition evaluates to @true@.
--
--     -   @If-Unmodified-Since@ condition evaluates to @false@.
--
-- -   If both of the @If-None-Match@ and @If-Modified-Since@ headers are
--     present in the request as follows, then Amazon S3 returns the HTTP
--     status code @304 Not Modified@:
--
--     -   @If-None-Match@ condition evaluates to @false@.
--
--     -   @If-Modified-Since@ condition evaluates to @true@.
--
-- For more information about conditional requests, see
-- <https://tools.ietf.org/html/rfc7232 RFC 7232>.
--
-- __Permissions__
--
-- The permissions that you need to use this operation depend on whether
-- the bucket is versioned. If the bucket is versioned, you need both the
-- @s3:GetObjectVersion@ and @s3:GetObjectVersionAttributes@ permissions
-- for this operation. If the bucket is not versioned, you need the
-- @s3:GetObject@ and @s3:GetObjectAttributes@ permissions. For more
-- information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/using-with-s3-actions.html Specifying Permissions in a Policy>
-- in the /Amazon S3 User Guide/. If the object that you request does not
-- exist, the error Amazon S3 returns depends on whether you also have the
-- @s3:ListBucket@ permission.
--
-- -   If you have the @s3:ListBucket@ permission on the bucket, Amazon S3
--     returns an HTTP status code @404 Not Found@ (\"no such key\") error.
--
-- -   If you don\'t have the @s3:ListBucket@ permission, Amazon S3 returns
--     an HTTP status code @403 Forbidden@ (\"access denied\") error.
--
-- The following actions are related to @GetObjectAttributes@:
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObject.html GetObject>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectAcl.html GetObjectAcl>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectLegalHold.html GetObjectLegalHold>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectLockConfiguration.html GetObjectLockConfiguration>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectRetention.html GetObjectRetention>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectTagging.html GetObjectTagging>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_HeadObject.html HeadObject>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_ListParts.html ListParts>
module Amazonka.S3.GetObjectAttributes
  ( -- * Creating a Request
    GetObjectAttributes (..),
    newGetObjectAttributes,

    -- * Request Lenses
    getObjectAttributes_expectedBucketOwner,
    getObjectAttributes_maxParts,
    getObjectAttributes_partNumberMarker,
    getObjectAttributes_requestPayer,
    getObjectAttributes_sSECustomerAlgorithm,
    getObjectAttributes_sSECustomerKey,
    getObjectAttributes_sSECustomerKeyMD5,
    getObjectAttributes_versionId,
    getObjectAttributes_bucket,
    getObjectAttributes_key,
    getObjectAttributes_objectAttributes,

    -- * Destructuring the Response
    GetObjectAttributesResponse (..),
    newGetObjectAttributesResponse,

    -- * Response Lenses
    getObjectAttributesResponse_checksum,
    getObjectAttributesResponse_deleteMarker,
    getObjectAttributesResponse_eTag,
    getObjectAttributesResponse_lastModified,
    getObjectAttributesResponse_objectParts,
    getObjectAttributesResponse_objectSize,
    getObjectAttributesResponse_requestCharged,
    getObjectAttributesResponse_storageClass,
    getObjectAttributesResponse_versionId,
    getObjectAttributesResponse_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:/ 'newGetObjectAttributes' smart constructor.
data GetObjectAttributes = GetObjectAttributes'
  { -- | 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).
    GetObjectAttributes -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | Sets the maximum number of parts to return.
    GetObjectAttributes -> Maybe Int
maxParts :: Prelude.Maybe Prelude.Int,
    -- | Specifies the part after which listing should begin. Only parts with
    -- higher part numbers will be listed.
    GetObjectAttributes -> Maybe Int
partNumberMarker :: Prelude.Maybe Prelude.Int,
    GetObjectAttributes -> Maybe RequestPayer
requestPayer :: Prelude.Maybe RequestPayer,
    -- | Specifies the algorithm to use when encrypting the object (for example,
    -- AES256).
    GetObjectAttributes -> Maybe Text
sSECustomerAlgorithm :: Prelude.Maybe Prelude.Text,
    -- | Specifies the customer-provided encryption key for Amazon S3 to use in
    -- encrypting data. This value is used to store the object and then it is
    -- discarded; Amazon S3 does not store the encryption key. The key must be
    -- appropriate for use with the algorithm specified in the
    -- @x-amz-server-side-encryption-customer-algorithm@ header.
    GetObjectAttributes -> Maybe (Sensitive Text)
sSECustomerKey :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Specifies the 128-bit MD5 digest of the encryption key according to RFC
    -- 1321. Amazon S3 uses this header for a message integrity check to ensure
    -- that the encryption key was transmitted without error.
    GetObjectAttributes -> Maybe Text
sSECustomerKeyMD5 :: Prelude.Maybe Prelude.Text,
    -- | The version ID used to reference a specific version of the object.
    GetObjectAttributes -> Maybe ObjectVersionId
versionId :: Prelude.Maybe ObjectVersionId,
    -- | The name of the bucket that contains 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/.
    GetObjectAttributes -> BucketName
bucket :: BucketName,
    -- | The object key.
    GetObjectAttributes -> ObjectKey
key :: ObjectKey,
    -- | An XML header that specifies the fields at the root level that you want
    -- returned in the response. Fields that you do not specify are not
    -- returned.
    GetObjectAttributes -> [ObjectAttributes]
objectAttributes :: [ObjectAttributes]
  }
  deriving (GetObjectAttributes -> GetObjectAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetObjectAttributes -> GetObjectAttributes -> Bool
$c/= :: GetObjectAttributes -> GetObjectAttributes -> Bool
== :: GetObjectAttributes -> GetObjectAttributes -> Bool
$c== :: GetObjectAttributes -> GetObjectAttributes -> Bool
Prelude.Eq, Int -> GetObjectAttributes -> ShowS
[GetObjectAttributes] -> ShowS
GetObjectAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectAttributes] -> ShowS
$cshowList :: [GetObjectAttributes] -> ShowS
show :: GetObjectAttributes -> String
$cshow :: GetObjectAttributes -> String
showsPrec :: Int -> GetObjectAttributes -> ShowS
$cshowsPrec :: Int -> GetObjectAttributes -> ShowS
Prelude.Show, forall x. Rep GetObjectAttributes x -> GetObjectAttributes
forall x. GetObjectAttributes -> Rep GetObjectAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetObjectAttributes x -> GetObjectAttributes
$cfrom :: forall x. GetObjectAttributes -> Rep GetObjectAttributes x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectAttributes' 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', 'getObjectAttributes_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).
--
-- 'maxParts', 'getObjectAttributes_maxParts' - Sets the maximum number of parts to return.
--
-- 'partNumberMarker', 'getObjectAttributes_partNumberMarker' - Specifies the part after which listing should begin. Only parts with
-- higher part numbers will be listed.
--
-- 'requestPayer', 'getObjectAttributes_requestPayer' - Undocumented member.
--
-- 'sSECustomerAlgorithm', 'getObjectAttributes_sSECustomerAlgorithm' - Specifies the algorithm to use when encrypting the object (for example,
-- AES256).
--
-- 'sSECustomerKey', 'getObjectAttributes_sSECustomerKey' - Specifies the customer-provided encryption key for Amazon S3 to use in
-- encrypting data. This value is used to store the object and then it is
-- discarded; Amazon S3 does not store the encryption key. The key must be
-- appropriate for use with the algorithm specified in the
-- @x-amz-server-side-encryption-customer-algorithm@ header.
--
-- 'sSECustomerKeyMD5', 'getObjectAttributes_sSECustomerKeyMD5' - Specifies the 128-bit MD5 digest of the encryption key according to RFC
-- 1321. Amazon S3 uses this header for a message integrity check to ensure
-- that the encryption key was transmitted without error.
--
-- 'versionId', 'getObjectAttributes_versionId' - The version ID used to reference a specific version of the object.
--
-- 'bucket', 'getObjectAttributes_bucket' - The name of the bucket that contains 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', 'getObjectAttributes_key' - The object key.
--
-- 'objectAttributes', 'getObjectAttributes_objectAttributes' - An XML header that specifies the fields at the root level that you want
-- returned in the response. Fields that you do not specify are not
-- returned.
newGetObjectAttributes ::
  -- | 'bucket'
  BucketName ->
  -- | 'key'
  ObjectKey ->
  GetObjectAttributes
newGetObjectAttributes :: BucketName -> ObjectKey -> GetObjectAttributes
newGetObjectAttributes BucketName
pBucket_ ObjectKey
pKey_ =
  GetObjectAttributes'
    { $sel:expectedBucketOwner:GetObjectAttributes' :: Maybe Text
expectedBucketOwner =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxParts:GetObjectAttributes' :: Maybe Int
maxParts = forall a. Maybe a
Prelude.Nothing,
      $sel:partNumberMarker:GetObjectAttributes' :: Maybe Int
partNumberMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:requestPayer:GetObjectAttributes' :: Maybe RequestPayer
requestPayer = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerAlgorithm:GetObjectAttributes' :: Maybe Text
sSECustomerAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerKey:GetObjectAttributes' :: Maybe (Sensitive Text)
sSECustomerKey = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerKeyMD5:GetObjectAttributes' :: Maybe Text
sSECustomerKeyMD5 = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:GetObjectAttributes' :: Maybe ObjectVersionId
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:GetObjectAttributes' :: BucketName
bucket = BucketName
pBucket_,
      $sel:key:GetObjectAttributes' :: ObjectKey
key = ObjectKey
pKey_,
      $sel:objectAttributes:GetObjectAttributes' :: [ObjectAttributes]
objectAttributes = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | Sets the maximum number of parts to return.
getObjectAttributes_maxParts :: Lens.Lens' GetObjectAttributes (Prelude.Maybe Prelude.Int)
getObjectAttributes_maxParts :: Lens' GetObjectAttributes (Maybe Int)
getObjectAttributes_maxParts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {Maybe Int
maxParts :: Maybe Int
$sel:maxParts:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
maxParts} -> Maybe Int
maxParts) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} Maybe Int
a -> GetObjectAttributes
s {$sel:maxParts:GetObjectAttributes' :: Maybe Int
maxParts = Maybe Int
a} :: GetObjectAttributes)

-- | Specifies the part after which listing should begin. Only parts with
-- higher part numbers will be listed.
getObjectAttributes_partNumberMarker :: Lens.Lens' GetObjectAttributes (Prelude.Maybe Prelude.Int)
getObjectAttributes_partNumberMarker :: Lens' GetObjectAttributes (Maybe Int)
getObjectAttributes_partNumberMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {Maybe Int
partNumberMarker :: Maybe Int
$sel:partNumberMarker:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
partNumberMarker} -> Maybe Int
partNumberMarker) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} Maybe Int
a -> GetObjectAttributes
s {$sel:partNumberMarker:GetObjectAttributes' :: Maybe Int
partNumberMarker = Maybe Int
a} :: GetObjectAttributes)

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

-- | Specifies the algorithm to use when encrypting the object (for example,
-- AES256).
getObjectAttributes_sSECustomerAlgorithm :: Lens.Lens' GetObjectAttributes (Prelude.Maybe Prelude.Text)
getObjectAttributes_sSECustomerAlgorithm :: Lens' GetObjectAttributes (Maybe Text)
getObjectAttributes_sSECustomerAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {Maybe Text
sSECustomerAlgorithm :: Maybe Text
$sel:sSECustomerAlgorithm:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
sSECustomerAlgorithm} -> Maybe Text
sSECustomerAlgorithm) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} Maybe Text
a -> GetObjectAttributes
s {$sel:sSECustomerAlgorithm:GetObjectAttributes' :: Maybe Text
sSECustomerAlgorithm = Maybe Text
a} :: GetObjectAttributes)

-- | Specifies the customer-provided encryption key for Amazon S3 to use in
-- encrypting data. This value is used to store the object and then it is
-- discarded; Amazon S3 does not store the encryption key. The key must be
-- appropriate for use with the algorithm specified in the
-- @x-amz-server-side-encryption-customer-algorithm@ header.
getObjectAttributes_sSECustomerKey :: Lens.Lens' GetObjectAttributes (Prelude.Maybe Prelude.Text)
getObjectAttributes_sSECustomerKey :: Lens' GetObjectAttributes (Maybe Text)
getObjectAttributes_sSECustomerKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {Maybe (Sensitive Text)
sSECustomerKey :: Maybe (Sensitive Text)
$sel:sSECustomerKey:GetObjectAttributes' :: GetObjectAttributes -> Maybe (Sensitive Text)
sSECustomerKey} -> Maybe (Sensitive Text)
sSECustomerKey) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} Maybe (Sensitive Text)
a -> GetObjectAttributes
s {$sel:sSECustomerKey:GetObjectAttributes' :: Maybe (Sensitive Text)
sSECustomerKey = Maybe (Sensitive Text)
a} :: GetObjectAttributes) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | Specifies the 128-bit MD5 digest of the encryption key according to RFC
-- 1321. Amazon S3 uses this header for a message integrity check to ensure
-- that the encryption key was transmitted without error.
getObjectAttributes_sSECustomerKeyMD5 :: Lens.Lens' GetObjectAttributes (Prelude.Maybe Prelude.Text)
getObjectAttributes_sSECustomerKeyMD5 :: Lens' GetObjectAttributes (Maybe Text)
getObjectAttributes_sSECustomerKeyMD5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {Maybe Text
sSECustomerKeyMD5 :: Maybe Text
$sel:sSECustomerKeyMD5:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
sSECustomerKeyMD5} -> Maybe Text
sSECustomerKeyMD5) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} Maybe Text
a -> GetObjectAttributes
s {$sel:sSECustomerKeyMD5:GetObjectAttributes' :: Maybe Text
sSECustomerKeyMD5 = Maybe Text
a} :: GetObjectAttributes)

-- | The version ID used to reference a specific version of the object.
getObjectAttributes_versionId :: Lens.Lens' GetObjectAttributes (Prelude.Maybe ObjectVersionId)
getObjectAttributes_versionId :: Lens' GetObjectAttributes (Maybe ObjectVersionId)
getObjectAttributes_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {Maybe ObjectVersionId
versionId :: Maybe ObjectVersionId
$sel:versionId:GetObjectAttributes' :: GetObjectAttributes -> Maybe ObjectVersionId
versionId} -> Maybe ObjectVersionId
versionId) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} Maybe ObjectVersionId
a -> GetObjectAttributes
s {$sel:versionId:GetObjectAttributes' :: Maybe ObjectVersionId
versionId = Maybe ObjectVersionId
a} :: GetObjectAttributes)

-- | The name of the bucket that contains 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/.
getObjectAttributes_bucket :: Lens.Lens' GetObjectAttributes BucketName
getObjectAttributes_bucket :: Lens' GetObjectAttributes BucketName
getObjectAttributes_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {BucketName
bucket :: BucketName
$sel:bucket:GetObjectAttributes' :: GetObjectAttributes -> BucketName
bucket} -> BucketName
bucket) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} BucketName
a -> GetObjectAttributes
s {$sel:bucket:GetObjectAttributes' :: BucketName
bucket = BucketName
a} :: GetObjectAttributes)

-- | The object key.
getObjectAttributes_key :: Lens.Lens' GetObjectAttributes ObjectKey
getObjectAttributes_key :: Lens' GetObjectAttributes ObjectKey
getObjectAttributes_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {ObjectKey
key :: ObjectKey
$sel:key:GetObjectAttributes' :: GetObjectAttributes -> ObjectKey
key} -> ObjectKey
key) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} ObjectKey
a -> GetObjectAttributes
s {$sel:key:GetObjectAttributes' :: ObjectKey
key = ObjectKey
a} :: GetObjectAttributes)

-- | An XML header that specifies the fields at the root level that you want
-- returned in the response. Fields that you do not specify are not
-- returned.
getObjectAttributes_objectAttributes :: Lens.Lens' GetObjectAttributes [ObjectAttributes]
getObjectAttributes_objectAttributes :: Lens' GetObjectAttributes [ObjectAttributes]
getObjectAttributes_objectAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributes' {[ObjectAttributes]
objectAttributes :: [ObjectAttributes]
$sel:objectAttributes:GetObjectAttributes' :: GetObjectAttributes -> [ObjectAttributes]
objectAttributes} -> [ObjectAttributes]
objectAttributes) (\s :: GetObjectAttributes
s@GetObjectAttributes' {} [ObjectAttributes]
a -> GetObjectAttributes
s {$sel:objectAttributes:GetObjectAttributes' :: [ObjectAttributes]
objectAttributes = [ObjectAttributes]
a} :: GetObjectAttributes) 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 Core.AWSRequest GetObjectAttributes where
  type
    AWSResponse GetObjectAttributes =
      GetObjectAttributesResponse
  request :: (Service -> Service)
-> GetObjectAttributes -> Request GetObjectAttributes
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 GetObjectAttributes
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetObjectAttributes)))
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 Checksum
-> Maybe Bool
-> Maybe ETag
-> Maybe RFC822
-> Maybe GetObjectAttributesParts
-> Maybe Integer
-> Maybe RequestCharged
-> Maybe StorageClass
-> Maybe ObjectVersionId
-> Int
-> GetObjectAttributesResponse
GetObjectAttributesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Checksum")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-delete-marker")
            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
"ETag")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Last-Modified")
            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
"ObjectParts")
            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
"ObjectSize")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-request-charged")
            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
"StorageClass")
            forall (f :: * -> *) a b. Applicative f => 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 GetObjectAttributes where
  hashWithSalt :: Int -> GetObjectAttributes -> Int
hashWithSalt Int
_salt GetObjectAttributes' {[ObjectAttributes]
Maybe Int
Maybe Text
Maybe (Sensitive Text)
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
objectAttributes :: [ObjectAttributes]
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
partNumberMarker :: Maybe Int
maxParts :: Maybe Int
expectedBucketOwner :: Maybe Text
$sel:objectAttributes:GetObjectAttributes' :: GetObjectAttributes -> [ObjectAttributes]
$sel:key:GetObjectAttributes' :: GetObjectAttributes -> ObjectKey
$sel:bucket:GetObjectAttributes' :: GetObjectAttributes -> BucketName
$sel:versionId:GetObjectAttributes' :: GetObjectAttributes -> Maybe ObjectVersionId
$sel:sSECustomerKeyMD5:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:sSECustomerKey:GetObjectAttributes' :: GetObjectAttributes -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:requestPayer:GetObjectAttributes' :: GetObjectAttributes -> Maybe RequestPayer
$sel:partNumberMarker:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:maxParts:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:expectedBucketOwner:GetObjectAttributes' :: GetObjectAttributes -> 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 Int
maxParts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
partNumberMarker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RequestPayer
requestPayer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sSECustomerAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
sSECustomerKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sSECustomerKeyMD5
      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` [ObjectAttributes]
objectAttributes

instance Prelude.NFData GetObjectAttributes where
  rnf :: GetObjectAttributes -> ()
rnf GetObjectAttributes' {[ObjectAttributes]
Maybe Int
Maybe Text
Maybe (Sensitive Text)
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
objectAttributes :: [ObjectAttributes]
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
partNumberMarker :: Maybe Int
maxParts :: Maybe Int
expectedBucketOwner :: Maybe Text
$sel:objectAttributes:GetObjectAttributes' :: GetObjectAttributes -> [ObjectAttributes]
$sel:key:GetObjectAttributes' :: GetObjectAttributes -> ObjectKey
$sel:bucket:GetObjectAttributes' :: GetObjectAttributes -> BucketName
$sel:versionId:GetObjectAttributes' :: GetObjectAttributes -> Maybe ObjectVersionId
$sel:sSECustomerKeyMD5:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:sSECustomerKey:GetObjectAttributes' :: GetObjectAttributes -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:requestPayer:GetObjectAttributes' :: GetObjectAttributes -> Maybe RequestPayer
$sel:partNumberMarker:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:maxParts:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:expectedBucketOwner:GetObjectAttributes' :: GetObjectAttributes -> 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 Int
maxParts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
partNumberMarker
      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 Text
sSECustomerAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
sSECustomerKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sSECustomerKeyMD5
      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 [ObjectAttributes]
objectAttributes

instance Data.ToHeaders GetObjectAttributes where
  toHeaders :: GetObjectAttributes -> ResponseHeaders
toHeaders GetObjectAttributes' {[ObjectAttributes]
Maybe Int
Maybe Text
Maybe (Sensitive Text)
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
objectAttributes :: [ObjectAttributes]
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
partNumberMarker :: Maybe Int
maxParts :: Maybe Int
expectedBucketOwner :: Maybe Text
$sel:objectAttributes:GetObjectAttributes' :: GetObjectAttributes -> [ObjectAttributes]
$sel:key:GetObjectAttributes' :: GetObjectAttributes -> ObjectKey
$sel:bucket:GetObjectAttributes' :: GetObjectAttributes -> BucketName
$sel:versionId:GetObjectAttributes' :: GetObjectAttributes -> Maybe ObjectVersionId
$sel:sSECustomerKeyMD5:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:sSECustomerKey:GetObjectAttributes' :: GetObjectAttributes -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:requestPayer:GetObjectAttributes' :: GetObjectAttributes -> Maybe RequestPayer
$sel:partNumberMarker:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:maxParts:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:expectedBucketOwner:GetObjectAttributes' :: GetObjectAttributes -> 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-max-parts" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Int
maxParts,
        HeaderName
"x-amz-part-number-marker" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Int
partNumberMarker,
        HeaderName
"x-amz-request-payer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe RequestPayer
requestPayer,
        HeaderName
"x-amz-server-side-encryption-customer-algorithm"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
sSECustomerAlgorithm,
        HeaderName
"x-amz-server-side-encryption-customer-key"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
sSECustomerKey,
        HeaderName
"x-amz-server-side-encryption-customer-key-MD5"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
sSECustomerKeyMD5,
        HeaderName
"x-amz-object-attributes" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# [ObjectAttributes]
objectAttributes
      ]

instance Data.ToPath GetObjectAttributes where
  toPath :: GetObjectAttributes -> ByteString
toPath GetObjectAttributes' {[ObjectAttributes]
Maybe Int
Maybe Text
Maybe (Sensitive Text)
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
objectAttributes :: [ObjectAttributes]
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
partNumberMarker :: Maybe Int
maxParts :: Maybe Int
expectedBucketOwner :: Maybe Text
$sel:objectAttributes:GetObjectAttributes' :: GetObjectAttributes -> [ObjectAttributes]
$sel:key:GetObjectAttributes' :: GetObjectAttributes -> ObjectKey
$sel:bucket:GetObjectAttributes' :: GetObjectAttributes -> BucketName
$sel:versionId:GetObjectAttributes' :: GetObjectAttributes -> Maybe ObjectVersionId
$sel:sSECustomerKeyMD5:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:sSECustomerKey:GetObjectAttributes' :: GetObjectAttributes -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:requestPayer:GetObjectAttributes' :: GetObjectAttributes -> Maybe RequestPayer
$sel:partNumberMarker:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:maxParts:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:expectedBucketOwner:GetObjectAttributes' :: GetObjectAttributes -> 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 GetObjectAttributes where
  toQuery :: GetObjectAttributes -> QueryString
toQuery GetObjectAttributes' {[ObjectAttributes]
Maybe Int
Maybe Text
Maybe (Sensitive Text)
Maybe ObjectVersionId
Maybe RequestPayer
ObjectKey
BucketName
objectAttributes :: [ObjectAttributes]
key :: ObjectKey
bucket :: BucketName
versionId :: Maybe ObjectVersionId
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
partNumberMarker :: Maybe Int
maxParts :: Maybe Int
expectedBucketOwner :: Maybe Text
$sel:objectAttributes:GetObjectAttributes' :: GetObjectAttributes -> [ObjectAttributes]
$sel:key:GetObjectAttributes' :: GetObjectAttributes -> ObjectKey
$sel:bucket:GetObjectAttributes' :: GetObjectAttributes -> BucketName
$sel:versionId:GetObjectAttributes' :: GetObjectAttributes -> Maybe ObjectVersionId
$sel:sSECustomerKeyMD5:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:sSECustomerKey:GetObjectAttributes' :: GetObjectAttributes -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
$sel:requestPayer:GetObjectAttributes' :: GetObjectAttributes -> Maybe RequestPayer
$sel:partNumberMarker:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:maxParts:GetObjectAttributes' :: GetObjectAttributes -> Maybe Int
$sel:expectedBucketOwner:GetObjectAttributes' :: GetObjectAttributes -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"versionId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ObjectVersionId
versionId, QueryString
"attributes"]

-- | /See:/ 'newGetObjectAttributesResponse' smart constructor.
data GetObjectAttributesResponse = GetObjectAttributesResponse'
  { -- | The checksum or digest of the object.
    GetObjectAttributesResponse -> Maybe Checksum
checksum :: Prelude.Maybe Checksum,
    -- | Specifies whether the object retrieved was (@true@) or was not (@false@)
    -- a delete marker. If @false@, this response header does not appear in the
    -- response.
    GetObjectAttributesResponse -> Maybe Bool
deleteMarker :: Prelude.Maybe Prelude.Bool,
    -- | An ETag is an opaque identifier assigned by a web server to a specific
    -- version of a resource found at a URL.
    GetObjectAttributesResponse -> Maybe ETag
eTag :: Prelude.Maybe ETag,
    -- | The creation date of the object.
    GetObjectAttributesResponse -> Maybe RFC822
lastModified :: Prelude.Maybe Data.RFC822,
    -- | A collection of parts associated with a multipart upload.
    GetObjectAttributesResponse -> Maybe GetObjectAttributesParts
objectParts :: Prelude.Maybe GetObjectAttributesParts,
    -- | The size of the object in bytes.
    GetObjectAttributesResponse -> Maybe Integer
objectSize :: Prelude.Maybe Prelude.Integer,
    GetObjectAttributesResponse -> Maybe RequestCharged
requestCharged :: Prelude.Maybe RequestCharged,
    -- | Provides the storage class information of the object. Amazon S3 returns
    -- this header for all objects except for S3 Standard storage class
    -- objects.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/storage-class-intro.html Storage Classes>.
    GetObjectAttributesResponse -> Maybe StorageClass
storageClass :: Prelude.Maybe StorageClass,
    -- | The version ID of the object.
    GetObjectAttributesResponse -> Maybe ObjectVersionId
versionId :: Prelude.Maybe ObjectVersionId,
    -- | The response's http status code.
    GetObjectAttributesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
$c/= :: GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
== :: GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
$c== :: GetObjectAttributesResponse -> GetObjectAttributesResponse -> Bool
Prelude.Eq, ReadPrec [GetObjectAttributesResponse]
ReadPrec GetObjectAttributesResponse
Int -> ReadS GetObjectAttributesResponse
ReadS [GetObjectAttributesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetObjectAttributesResponse]
$creadListPrec :: ReadPrec [GetObjectAttributesResponse]
readPrec :: ReadPrec GetObjectAttributesResponse
$creadPrec :: ReadPrec GetObjectAttributesResponse
readList :: ReadS [GetObjectAttributesResponse]
$creadList :: ReadS [GetObjectAttributesResponse]
readsPrec :: Int -> ReadS GetObjectAttributesResponse
$creadsPrec :: Int -> ReadS GetObjectAttributesResponse
Prelude.Read, Int -> GetObjectAttributesResponse -> ShowS
[GetObjectAttributesResponse] -> ShowS
GetObjectAttributesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectAttributesResponse] -> ShowS
$cshowList :: [GetObjectAttributesResponse] -> ShowS
show :: GetObjectAttributesResponse -> String
$cshow :: GetObjectAttributesResponse -> String
showsPrec :: Int -> GetObjectAttributesResponse -> ShowS
$cshowsPrec :: Int -> GetObjectAttributesResponse -> ShowS
Prelude.Show, forall x.
Rep GetObjectAttributesResponse x -> GetObjectAttributesResponse
forall x.
GetObjectAttributesResponse -> Rep GetObjectAttributesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetObjectAttributesResponse x -> GetObjectAttributesResponse
$cfrom :: forall x.
GetObjectAttributesResponse -> Rep GetObjectAttributesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectAttributesResponse' 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:
--
-- 'checksum', 'getObjectAttributesResponse_checksum' - The checksum or digest of the object.
--
-- 'deleteMarker', 'getObjectAttributesResponse_deleteMarker' - Specifies whether the object retrieved was (@true@) or was not (@false@)
-- a delete marker. If @false@, this response header does not appear in the
-- response.
--
-- 'eTag', 'getObjectAttributesResponse_eTag' - An ETag is an opaque identifier assigned by a web server to a specific
-- version of a resource found at a URL.
--
-- 'lastModified', 'getObjectAttributesResponse_lastModified' - The creation date of the object.
--
-- 'objectParts', 'getObjectAttributesResponse_objectParts' - A collection of parts associated with a multipart upload.
--
-- 'objectSize', 'getObjectAttributesResponse_objectSize' - The size of the object in bytes.
--
-- 'requestCharged', 'getObjectAttributesResponse_requestCharged' - Undocumented member.
--
-- 'storageClass', 'getObjectAttributesResponse_storageClass' - Provides the storage class information of the object. Amazon S3 returns
-- this header for all objects except for S3 Standard storage class
-- objects.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/storage-class-intro.html Storage Classes>.
--
-- 'versionId', 'getObjectAttributesResponse_versionId' - The version ID of the object.
--
-- 'httpStatus', 'getObjectAttributesResponse_httpStatus' - The response's http status code.
newGetObjectAttributesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetObjectAttributesResponse
newGetObjectAttributesResponse :: Int -> GetObjectAttributesResponse
newGetObjectAttributesResponse Int
pHttpStatus_ =
  GetObjectAttributesResponse'
    { $sel:checksum:GetObjectAttributesResponse' :: Maybe Checksum
checksum =
        forall a. Maybe a
Prelude.Nothing,
      $sel:deleteMarker:GetObjectAttributesResponse' :: Maybe Bool
deleteMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:eTag:GetObjectAttributesResponse' :: Maybe ETag
eTag = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModified:GetObjectAttributesResponse' :: Maybe RFC822
lastModified = forall a. Maybe a
Prelude.Nothing,
      $sel:objectParts:GetObjectAttributesResponse' :: Maybe GetObjectAttributesParts
objectParts = forall a. Maybe a
Prelude.Nothing,
      $sel:objectSize:GetObjectAttributesResponse' :: Maybe Integer
objectSize = forall a. Maybe a
Prelude.Nothing,
      $sel:requestCharged:GetObjectAttributesResponse' :: Maybe RequestCharged
requestCharged = forall a. Maybe a
Prelude.Nothing,
      $sel:storageClass:GetObjectAttributesResponse' :: Maybe StorageClass
storageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:GetObjectAttributesResponse' :: Maybe ObjectVersionId
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetObjectAttributesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The checksum or digest of the object.
getObjectAttributesResponse_checksum :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe Checksum)
getObjectAttributesResponse_checksum :: Lens' GetObjectAttributesResponse (Maybe Checksum)
getObjectAttributesResponse_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe Checksum
checksum :: Maybe Checksum
$sel:checksum:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe Checksum
checksum} -> Maybe Checksum
checksum) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe Checksum
a -> GetObjectAttributesResponse
s {$sel:checksum:GetObjectAttributesResponse' :: Maybe Checksum
checksum = Maybe Checksum
a} :: GetObjectAttributesResponse)

-- | Specifies whether the object retrieved was (@true@) or was not (@false@)
-- a delete marker. If @false@, this response header does not appear in the
-- response.
getObjectAttributesResponse_deleteMarker :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe Prelude.Bool)
getObjectAttributesResponse_deleteMarker :: Lens' GetObjectAttributesResponse (Maybe Bool)
getObjectAttributesResponse_deleteMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe Bool
deleteMarker :: Maybe Bool
$sel:deleteMarker:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe Bool
deleteMarker} -> Maybe Bool
deleteMarker) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe Bool
a -> GetObjectAttributesResponse
s {$sel:deleteMarker:GetObjectAttributesResponse' :: Maybe Bool
deleteMarker = Maybe Bool
a} :: GetObjectAttributesResponse)

-- | An ETag is an opaque identifier assigned by a web server to a specific
-- version of a resource found at a URL.
getObjectAttributesResponse_eTag :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe ETag)
getObjectAttributesResponse_eTag :: Lens' GetObjectAttributesResponse (Maybe ETag)
getObjectAttributesResponse_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe ETag
eTag :: Maybe ETag
$sel:eTag:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe ETag
eTag} -> Maybe ETag
eTag) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe ETag
a -> GetObjectAttributesResponse
s {$sel:eTag:GetObjectAttributesResponse' :: Maybe ETag
eTag = Maybe ETag
a} :: GetObjectAttributesResponse)

-- | The creation date of the object.
getObjectAttributesResponse_lastModified :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe Prelude.UTCTime)
getObjectAttributesResponse_lastModified :: Lens' GetObjectAttributesResponse (Maybe UTCTime)
getObjectAttributesResponse_lastModified = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe RFC822
lastModified :: Maybe RFC822
$sel:lastModified:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe RFC822
lastModified} -> Maybe RFC822
lastModified) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe RFC822
a -> GetObjectAttributesResponse
s {$sel:lastModified:GetObjectAttributesResponse' :: Maybe RFC822
lastModified = Maybe RFC822
a} :: GetObjectAttributesResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | A collection of parts associated with a multipart upload.
getObjectAttributesResponse_objectParts :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe GetObjectAttributesParts)
getObjectAttributesResponse_objectParts :: Lens' GetObjectAttributesResponse (Maybe GetObjectAttributesParts)
getObjectAttributesResponse_objectParts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe GetObjectAttributesParts
objectParts :: Maybe GetObjectAttributesParts
$sel:objectParts:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe GetObjectAttributesParts
objectParts} -> Maybe GetObjectAttributesParts
objectParts) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe GetObjectAttributesParts
a -> GetObjectAttributesResponse
s {$sel:objectParts:GetObjectAttributesResponse' :: Maybe GetObjectAttributesParts
objectParts = Maybe GetObjectAttributesParts
a} :: GetObjectAttributesResponse)

-- | The size of the object in bytes.
getObjectAttributesResponse_objectSize :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe Prelude.Integer)
getObjectAttributesResponse_objectSize :: Lens' GetObjectAttributesResponse (Maybe Integer)
getObjectAttributesResponse_objectSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe Integer
objectSize :: Maybe Integer
$sel:objectSize:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe Integer
objectSize} -> Maybe Integer
objectSize) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe Integer
a -> GetObjectAttributesResponse
s {$sel:objectSize:GetObjectAttributesResponse' :: Maybe Integer
objectSize = Maybe Integer
a} :: GetObjectAttributesResponse)

-- | Undocumented member.
getObjectAttributesResponse_requestCharged :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe RequestCharged)
getObjectAttributesResponse_requestCharged :: Lens' GetObjectAttributesResponse (Maybe RequestCharged)
getObjectAttributesResponse_requestCharged = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe RequestCharged
requestCharged :: Maybe RequestCharged
$sel:requestCharged:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe RequestCharged
requestCharged} -> Maybe RequestCharged
requestCharged) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe RequestCharged
a -> GetObjectAttributesResponse
s {$sel:requestCharged:GetObjectAttributesResponse' :: Maybe RequestCharged
requestCharged = Maybe RequestCharged
a} :: GetObjectAttributesResponse)

-- | Provides the storage class information of the object. Amazon S3 returns
-- this header for all objects except for S3 Standard storage class
-- objects.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/storage-class-intro.html Storage Classes>.
getObjectAttributesResponse_storageClass :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe StorageClass)
getObjectAttributesResponse_storageClass :: Lens' GetObjectAttributesResponse (Maybe StorageClass)
getObjectAttributesResponse_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe StorageClass
storageClass :: Maybe StorageClass
$sel:storageClass:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe StorageClass
storageClass} -> Maybe StorageClass
storageClass) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe StorageClass
a -> GetObjectAttributesResponse
s {$sel:storageClass:GetObjectAttributesResponse' :: Maybe StorageClass
storageClass = Maybe StorageClass
a} :: GetObjectAttributesResponse)

-- | The version ID of the object.
getObjectAttributesResponse_versionId :: Lens.Lens' GetObjectAttributesResponse (Prelude.Maybe ObjectVersionId)
getObjectAttributesResponse_versionId :: Lens' GetObjectAttributesResponse (Maybe ObjectVersionId)
getObjectAttributesResponse_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectAttributesResponse' {Maybe ObjectVersionId
versionId :: Maybe ObjectVersionId
$sel:versionId:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe ObjectVersionId
versionId} -> Maybe ObjectVersionId
versionId) (\s :: GetObjectAttributesResponse
s@GetObjectAttributesResponse' {} Maybe ObjectVersionId
a -> GetObjectAttributesResponse
s {$sel:versionId:GetObjectAttributesResponse' :: Maybe ObjectVersionId
versionId = Maybe ObjectVersionId
a} :: GetObjectAttributesResponse)

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

instance Prelude.NFData GetObjectAttributesResponse where
  rnf :: GetObjectAttributesResponse -> ()
rnf GetObjectAttributesResponse' {Int
Maybe Bool
Maybe Integer
Maybe RFC822
Maybe ObjectVersionId
Maybe ETag
Maybe Checksum
Maybe GetObjectAttributesParts
Maybe RequestCharged
Maybe StorageClass
httpStatus :: Int
versionId :: Maybe ObjectVersionId
storageClass :: Maybe StorageClass
requestCharged :: Maybe RequestCharged
objectSize :: Maybe Integer
objectParts :: Maybe GetObjectAttributesParts
lastModified :: Maybe RFC822
eTag :: Maybe ETag
deleteMarker :: Maybe Bool
checksum :: Maybe Checksum
$sel:httpStatus:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Int
$sel:versionId:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe ObjectVersionId
$sel:storageClass:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe StorageClass
$sel:requestCharged:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe RequestCharged
$sel:objectSize:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe Integer
$sel:objectParts:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe GetObjectAttributesParts
$sel:lastModified:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe RFC822
$sel:eTag:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe ETag
$sel:deleteMarker:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe Bool
$sel:checksum:GetObjectAttributesResponse' :: GetObjectAttributesResponse -> Maybe Checksum
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Checksum
checksum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deleteMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ETag
eTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RFC822
lastModified
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GetObjectAttributesParts
objectParts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
objectSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestCharged
requestCharged
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageClass
storageClass
      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 Int
httpStatus