{-# 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.ListParts
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the parts that have been uploaded for a specific multipart upload.
-- This operation must include the upload ID, which you obtain by sending
-- the initiate multipart upload request (see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_CreateMultipartUpload.html CreateMultipartUpload>).
-- This request returns a maximum of 1,000 uploaded parts. The default
-- number of parts returned is 1,000 parts. You can restrict the number of
-- parts returned by specifying the @max-parts@ request parameter. If your
-- multipart upload consists of more than 1,000 parts, the response returns
-- an @IsTruncated@ field with the value of true, and a
-- @NextPartNumberMarker@ element. In subsequent @ListParts@ requests you
-- can include the part-number-marker query string parameter and set its
-- value to the @NextPartNumberMarker@ field value from the previous
-- response.
--
-- If the upload was created using a checksum algorithm, you will need to
-- have permission to the @kms:Decrypt@ action for the request to succeed.
--
-- For more information on multipart uploads, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/uploadobjusingmpu.html Uploading Objects Using Multipart Upload>.
--
-- For information on permissions required to use the multipart upload API,
-- see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/mpuAndPermissions.html Multipart Upload and Permissions>.
--
-- The following operations are related to @ListParts@:
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_CreateMultipartUpload.html CreateMultipartUpload>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPart.html UploadPart>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_CompleteMultipartUpload.html CompleteMultipartUpload>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_AbortMultipartUpload.html AbortMultipartUpload>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_GetObjectAttributes.html GetObjectAttributes>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_ListMultipartUploads.html ListMultipartUploads>
--
-- This operation returns paginated results.
module Amazonka.S3.ListParts
  ( -- * Creating a Request
    ListParts (..),
    newListParts,

    -- * Request Lenses
    listParts_expectedBucketOwner,
    listParts_maxParts,
    listParts_partNumberMarker,
    listParts_requestPayer,
    listParts_sSECustomerAlgorithm,
    listParts_sSECustomerKey,
    listParts_sSECustomerKeyMD5,
    listParts_bucket,
    listParts_key,
    listParts_uploadId,

    -- * Destructuring the Response
    ListPartsResponse (..),
    newListPartsResponse,

    -- * Response Lenses
    listPartsResponse_abortDate,
    listPartsResponse_abortRuleId,
    listPartsResponse_bucket,
    listPartsResponse_checksumAlgorithm,
    listPartsResponse_initiator,
    listPartsResponse_isTruncated,
    listPartsResponse_key,
    listPartsResponse_maxParts,
    listPartsResponse_nextPartNumberMarker,
    listPartsResponse_owner,
    listPartsResponse_partNumberMarker,
    listPartsResponse_parts,
    listPartsResponse_requestCharged,
    listPartsResponse_storageClass,
    listPartsResponse_uploadId,
    listPartsResponse_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:/ 'newListParts' smart constructor.
data ListParts = ListParts'
  { -- | 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).
    ListParts -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | Sets the maximum number of parts to return.
    ListParts -> Maybe Int
maxParts :: Prelude.Maybe Prelude.Int,
    -- | Specifies the part after which listing should begin. Only parts with
    -- higher part numbers will be listed.
    ListParts -> Maybe Int
partNumberMarker :: Prelude.Maybe Prelude.Int,
    ListParts -> Maybe RequestPayer
requestPayer :: Prelude.Maybe RequestPayer,
    -- | The server-side encryption (SSE) algorithm used to encrypt the object.
    -- This parameter is needed only when the object was created using a
    -- checksum algorithm. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
    -- in the /Amazon S3 User Guide/.
    ListParts -> Maybe Text
sSECustomerAlgorithm :: Prelude.Maybe Prelude.Text,
    -- | The server-side encryption (SSE) customer managed key. This parameter is
    -- needed only when the object was created using a checksum algorithm. For
    -- more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
    -- in the /Amazon S3 User Guide/.
    ListParts -> Maybe (Sensitive Text)
sSECustomerKey :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The MD5 server-side encryption (SSE) customer managed key. This
    -- parameter is needed only when the object was created using a checksum
    -- algorithm. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
    -- in the /Amazon S3 User Guide/.
    ListParts -> Maybe Text
sSECustomerKeyMD5 :: Prelude.Maybe Prelude.Text,
    -- | The name of the bucket to which the parts are being uploaded.
    --
    -- 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/.
    ListParts -> BucketName
bucket :: BucketName,
    -- | Object key for which the multipart upload was initiated.
    ListParts -> ObjectKey
key :: ObjectKey,
    -- | Upload ID identifying the multipart upload whose parts are being listed.
    ListParts -> Text
uploadId :: Prelude.Text
  }
  deriving (ListParts -> ListParts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListParts -> ListParts -> Bool
$c/= :: ListParts -> ListParts -> Bool
== :: ListParts -> ListParts -> Bool
$c== :: ListParts -> ListParts -> Bool
Prelude.Eq, Int -> ListParts -> ShowS
[ListParts] -> ShowS
ListParts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListParts] -> ShowS
$cshowList :: [ListParts] -> ShowS
show :: ListParts -> String
$cshow :: ListParts -> String
showsPrec :: Int -> ListParts -> ShowS
$cshowsPrec :: Int -> ListParts -> ShowS
Prelude.Show, forall x. Rep ListParts x -> ListParts
forall x. ListParts -> Rep ListParts x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListParts x -> ListParts
$cfrom :: forall x. ListParts -> Rep ListParts x
Prelude.Generic)

-- |
-- Create a value of 'ListParts' 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', 'listParts_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', 'listParts_maxParts' - Sets the maximum number of parts to return.
--
-- 'partNumberMarker', 'listParts_partNumberMarker' - Specifies the part after which listing should begin. Only parts with
-- higher part numbers will be listed.
--
-- 'requestPayer', 'listParts_requestPayer' - Undocumented member.
--
-- 'sSECustomerAlgorithm', 'listParts_sSECustomerAlgorithm' - The server-side encryption (SSE) algorithm used to encrypt the object.
-- This parameter is needed only when the object was created using a
-- checksum algorithm. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
-- in the /Amazon S3 User Guide/.
--
-- 'sSECustomerKey', 'listParts_sSECustomerKey' - The server-side encryption (SSE) customer managed key. This parameter is
-- needed only when the object was created using a checksum algorithm. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
-- in the /Amazon S3 User Guide/.
--
-- 'sSECustomerKeyMD5', 'listParts_sSECustomerKeyMD5' - The MD5 server-side encryption (SSE) customer managed key. This
-- parameter is needed only when the object was created using a checksum
-- algorithm. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
-- in the /Amazon S3 User Guide/.
--
-- 'bucket', 'listParts_bucket' - The name of the bucket to which the parts are being uploaded.
--
-- 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', 'listParts_key' - Object key for which the multipart upload was initiated.
--
-- 'uploadId', 'listParts_uploadId' - Upload ID identifying the multipart upload whose parts are being listed.
newListParts ::
  -- | 'bucket'
  BucketName ->
  -- | 'key'
  ObjectKey ->
  -- | 'uploadId'
  Prelude.Text ->
  ListParts
newListParts :: BucketName -> ObjectKey -> Text -> ListParts
newListParts BucketName
pBucket_ ObjectKey
pKey_ Text
pUploadId_ =
  ListParts'
    { $sel:expectedBucketOwner:ListParts' :: Maybe Text
expectedBucketOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:maxParts:ListParts' :: Maybe Int
maxParts = forall a. Maybe a
Prelude.Nothing,
      $sel:partNumberMarker:ListParts' :: Maybe Int
partNumberMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:requestPayer:ListParts' :: Maybe RequestPayer
requestPayer = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerAlgorithm:ListParts' :: Maybe Text
sSECustomerAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerKey:ListParts' :: Maybe (Sensitive Text)
sSECustomerKey = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerKeyMD5:ListParts' :: Maybe Text
sSECustomerKeyMD5 = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:ListParts' :: BucketName
bucket = BucketName
pBucket_,
      $sel:key:ListParts' :: ObjectKey
key = ObjectKey
pKey_,
      $sel:uploadId:ListParts' :: Text
uploadId = Text
pUploadId_
    }

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

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

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

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

-- | The server-side encryption (SSE) algorithm used to encrypt the object.
-- This parameter is needed only when the object was created using a
-- checksum algorithm. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
-- in the /Amazon S3 User Guide/.
listParts_sSECustomerAlgorithm :: Lens.Lens' ListParts (Prelude.Maybe Prelude.Text)
listParts_sSECustomerAlgorithm :: Lens' ListParts (Maybe Text)
listParts_sSECustomerAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParts' {Maybe Text
sSECustomerAlgorithm :: Maybe Text
$sel:sSECustomerAlgorithm:ListParts' :: ListParts -> Maybe Text
sSECustomerAlgorithm} -> Maybe Text
sSECustomerAlgorithm) (\s :: ListParts
s@ListParts' {} Maybe Text
a -> ListParts
s {$sel:sSECustomerAlgorithm:ListParts' :: Maybe Text
sSECustomerAlgorithm = Maybe Text
a} :: ListParts)

-- | The server-side encryption (SSE) customer managed key. This parameter is
-- needed only when the object was created using a checksum algorithm. For
-- more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
-- in the /Amazon S3 User Guide/.
listParts_sSECustomerKey :: Lens.Lens' ListParts (Prelude.Maybe Prelude.Text)
listParts_sSECustomerKey :: Lens' ListParts (Maybe Text)
listParts_sSECustomerKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParts' {Maybe (Sensitive Text)
sSECustomerKey :: Maybe (Sensitive Text)
$sel:sSECustomerKey:ListParts' :: ListParts -> Maybe (Sensitive Text)
sSECustomerKey} -> Maybe (Sensitive Text)
sSECustomerKey) (\s :: ListParts
s@ListParts' {} Maybe (Sensitive Text)
a -> ListParts
s {$sel:sSECustomerKey:ListParts' :: Maybe (Sensitive Text)
sSECustomerKey = Maybe (Sensitive Text)
a} :: ListParts) 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

-- | The MD5 server-side encryption (SSE) customer managed key. This
-- parameter is needed only when the object was created using a checksum
-- algorithm. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/ServerSideEncryptionCustomerKeys.html Protecting data using SSE-C keys>
-- in the /Amazon S3 User Guide/.
listParts_sSECustomerKeyMD5 :: Lens.Lens' ListParts (Prelude.Maybe Prelude.Text)
listParts_sSECustomerKeyMD5 :: Lens' ListParts (Maybe Text)
listParts_sSECustomerKeyMD5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParts' {Maybe Text
sSECustomerKeyMD5 :: Maybe Text
$sel:sSECustomerKeyMD5:ListParts' :: ListParts -> Maybe Text
sSECustomerKeyMD5} -> Maybe Text
sSECustomerKeyMD5) (\s :: ListParts
s@ListParts' {} Maybe Text
a -> ListParts
s {$sel:sSECustomerKeyMD5:ListParts' :: Maybe Text
sSECustomerKeyMD5 = Maybe Text
a} :: ListParts)

-- | The name of the bucket to which the parts are being uploaded.
--
-- 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/.
listParts_bucket :: Lens.Lens' ListParts BucketName
listParts_bucket :: Lens' ListParts BucketName
listParts_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParts' {BucketName
bucket :: BucketName
$sel:bucket:ListParts' :: ListParts -> BucketName
bucket} -> BucketName
bucket) (\s :: ListParts
s@ListParts' {} BucketName
a -> ListParts
s {$sel:bucket:ListParts' :: BucketName
bucket = BucketName
a} :: ListParts)

-- | Object key for which the multipart upload was initiated.
listParts_key :: Lens.Lens' ListParts ObjectKey
listParts_key :: Lens' ListParts ObjectKey
listParts_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParts' {ObjectKey
key :: ObjectKey
$sel:key:ListParts' :: ListParts -> ObjectKey
key} -> ObjectKey
key) (\s :: ListParts
s@ListParts' {} ObjectKey
a -> ListParts
s {$sel:key:ListParts' :: ObjectKey
key = ObjectKey
a} :: ListParts)

-- | Upload ID identifying the multipart upload whose parts are being listed.
listParts_uploadId :: Lens.Lens' ListParts Prelude.Text
listParts_uploadId :: Lens' ListParts Text
listParts_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListParts' {Text
uploadId :: Text
$sel:uploadId:ListParts' :: ListParts -> Text
uploadId} -> Text
uploadId) (\s :: ListParts
s@ListParts' {} Text
a -> ListParts
s {$sel:uploadId:ListParts' :: Text
uploadId = Text
a} :: ListParts)

instance Core.AWSPager ListParts where
  page :: ListParts -> AWSResponse ListParts -> Maybe ListParts
page ListParts
rq AWSResponse ListParts
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListParts
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPartsResponse (Maybe Bool)
listPartsResponse_isTruncated
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. Maybe a -> Bool
Prelude.isNothing
        ( AWSResponse ListParts
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPartsResponse (Maybe Int)
listPartsResponse_nextPartNumberMarker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListParts
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListParts (Maybe Int)
listParts_partNumberMarker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListParts
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPartsResponse (Maybe Int)
listPartsResponse_nextPartNumberMarker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListParts where
  type AWSResponse ListParts = ListPartsResponse
  request :: (Service -> Service) -> ListParts -> Request ListParts
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 ListParts
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListParts)))
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 RFC822
-> Maybe Text
-> Maybe BucketName
-> Maybe ChecksumAlgorithm
-> Maybe Initiator
-> Maybe Bool
-> Maybe ObjectKey
-> Maybe Int
-> Maybe Int
-> Maybe Owner
-> Maybe Int
-> Maybe [Part]
-> Maybe RequestCharged
-> Maybe StorageClass
-> Maybe Text
-> Int
-> ListPartsResponse
ListPartsResponse'
            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-abort-date")
            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-abort-rule-id")
            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
"Bucket")
            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
"ChecksumAlgorithm")
            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
"Initiator")
            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
"IsTruncated")
            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
"Key")
            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
"MaxParts")
            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
"NextPartNumberMarker")
            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
"Owner")
            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
"PartNumberMarker")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"Part") [Node]
x)
            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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"UploadId")
            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 ListParts where
  hashWithSalt :: Int -> ListParts -> Int
hashWithSalt Int
_salt ListParts' {Maybe Int
Maybe Text
Maybe (Sensitive Text)
Maybe RequestPayer
Text
ObjectKey
BucketName
uploadId :: Text
key :: ObjectKey
bucket :: BucketName
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
partNumberMarker :: Maybe Int
maxParts :: Maybe Int
expectedBucketOwner :: Maybe Text
$sel:uploadId:ListParts' :: ListParts -> Text
$sel:key:ListParts' :: ListParts -> ObjectKey
$sel:bucket:ListParts' :: ListParts -> BucketName
$sel:sSECustomerKeyMD5:ListParts' :: ListParts -> Maybe Text
$sel:sSECustomerKey:ListParts' :: ListParts -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:ListParts' :: ListParts -> Maybe Text
$sel:requestPayer:ListParts' :: ListParts -> Maybe RequestPayer
$sel:partNumberMarker:ListParts' :: ListParts -> Maybe Int
$sel:maxParts:ListParts' :: ListParts -> Maybe Int
$sel:expectedBucketOwner:ListParts' :: ListParts -> 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` BucketName
bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectKey
key
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
uploadId

instance Prelude.NFData ListParts where
  rnf :: ListParts -> ()
rnf ListParts' {Maybe Int
Maybe Text
Maybe (Sensitive Text)
Maybe RequestPayer
Text
ObjectKey
BucketName
uploadId :: Text
key :: ObjectKey
bucket :: BucketName
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
partNumberMarker :: Maybe Int
maxParts :: Maybe Int
expectedBucketOwner :: Maybe Text
$sel:uploadId:ListParts' :: ListParts -> Text
$sel:key:ListParts' :: ListParts -> ObjectKey
$sel:bucket:ListParts' :: ListParts -> BucketName
$sel:sSECustomerKeyMD5:ListParts' :: ListParts -> Maybe Text
$sel:sSECustomerKey:ListParts' :: ListParts -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:ListParts' :: ListParts -> Maybe Text
$sel:requestPayer:ListParts' :: ListParts -> Maybe RequestPayer
$sel:partNumberMarker:ListParts' :: ListParts -> Maybe Int
$sel:maxParts:ListParts' :: ListParts -> Maybe Int
$sel:expectedBucketOwner:ListParts' :: ListParts -> 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 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 Text
uploadId

instance Data.ToHeaders ListParts where
  toHeaders :: ListParts -> ResponseHeaders
toHeaders ListParts' {Maybe Int
Maybe Text
Maybe (Sensitive Text)
Maybe RequestPayer
Text
ObjectKey
BucketName
uploadId :: Text
key :: ObjectKey
bucket :: BucketName
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
partNumberMarker :: Maybe Int
maxParts :: Maybe Int
expectedBucketOwner :: Maybe Text
$sel:uploadId:ListParts' :: ListParts -> Text
$sel:key:ListParts' :: ListParts -> ObjectKey
$sel:bucket:ListParts' :: ListParts -> BucketName
$sel:sSECustomerKeyMD5:ListParts' :: ListParts -> Maybe Text
$sel:sSECustomerKey:ListParts' :: ListParts -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:ListParts' :: ListParts -> Maybe Text
$sel:requestPayer:ListParts' :: ListParts -> Maybe RequestPayer
$sel:partNumberMarker:ListParts' :: ListParts -> Maybe Int
$sel:maxParts:ListParts' :: ListParts -> Maybe Int
$sel:expectedBucketOwner:ListParts' :: ListParts -> 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,
        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
      ]

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

-- | /See:/ 'newListPartsResponse' smart constructor.
data ListPartsResponse = ListPartsResponse'
  { -- | If the bucket has a lifecycle rule configured with an action to abort
    -- incomplete multipart uploads and the prefix in the lifecycle rule
    -- matches the object name in the request, then the response includes this
    -- header indicating when the initiated multipart upload will become
    -- eligible for abort operation. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/mpuoverview.html#mpu-abort-incomplete-mpu-lifecycle-config Aborting Incomplete Multipart Uploads Using a Bucket Lifecycle Policy>.
    --
    -- The response will also include the @x-amz-abort-rule-id@ header that
    -- will provide the ID of the lifecycle configuration rule that defines
    -- this action.
    ListPartsResponse -> Maybe RFC822
abortDate :: Prelude.Maybe Data.RFC822,
    -- | This header is returned along with the @x-amz-abort-date@ header. It
    -- identifies applicable lifecycle configuration rule that defines the
    -- action to abort incomplete multipart uploads.
    ListPartsResponse -> Maybe Text
abortRuleId :: Prelude.Maybe Prelude.Text,
    -- | The name of the bucket to which the multipart upload was initiated. Does
    -- not return the access point ARN or access point alias if used.
    ListPartsResponse -> Maybe BucketName
bucket :: Prelude.Maybe BucketName,
    -- | The algorithm that was used to create a checksum of the object.
    ListPartsResponse -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | Container element that identifies who initiated the multipart upload. If
    -- the initiator is an Amazon Web Services account, this element provides
    -- the same information as the @Owner@ element. If the initiator is an IAM
    -- User, this element provides the user ARN and display name.
    ListPartsResponse -> Maybe Initiator
initiator :: Prelude.Maybe Initiator,
    -- | Indicates whether the returned list of parts is truncated. A true value
    -- indicates that the list was truncated. A list can be truncated if the
    -- number of parts exceeds the limit returned in the MaxParts element.
    ListPartsResponse -> Maybe Bool
isTruncated :: Prelude.Maybe Prelude.Bool,
    -- | Object key for which the multipart upload was initiated.
    ListPartsResponse -> Maybe ObjectKey
key :: Prelude.Maybe ObjectKey,
    -- | Maximum number of parts that were allowed in the response.
    ListPartsResponse -> Maybe Int
maxParts :: Prelude.Maybe Prelude.Int,
    -- | When a list is truncated, this element specifies the last part in the
    -- list, as well as the value to use for the part-number-marker request
    -- parameter in a subsequent request.
    ListPartsResponse -> Maybe Int
nextPartNumberMarker :: Prelude.Maybe Prelude.Int,
    -- | Container element that identifies the object owner, after the object is
    -- created. If multipart upload is initiated by an IAM user, this element
    -- provides the parent account ID and display name.
    ListPartsResponse -> Maybe Owner
owner :: Prelude.Maybe Owner,
    -- | When a list is truncated, this element specifies the last part in the
    -- list, as well as the value to use for the part-number-marker request
    -- parameter in a subsequent request.
    ListPartsResponse -> Maybe Int
partNumberMarker :: Prelude.Maybe Prelude.Int,
    -- | Container for elements related to a particular part. A response can
    -- contain zero or more @Part@ elements.
    ListPartsResponse -> Maybe [Part]
parts :: Prelude.Maybe [Part],
    ListPartsResponse -> Maybe RequestCharged
requestCharged :: Prelude.Maybe RequestCharged,
    -- | Class of storage (STANDARD or REDUCED_REDUNDANCY) used to store the
    -- uploaded object.
    ListPartsResponse -> Maybe StorageClass
storageClass :: Prelude.Maybe StorageClass,
    -- | Upload ID identifying the multipart upload whose parts are being listed.
    ListPartsResponse -> Maybe Text
uploadId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListPartsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPartsResponse -> ListPartsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPartsResponse -> ListPartsResponse -> Bool
$c/= :: ListPartsResponse -> ListPartsResponse -> Bool
== :: ListPartsResponse -> ListPartsResponse -> Bool
$c== :: ListPartsResponse -> ListPartsResponse -> Bool
Prelude.Eq, ReadPrec [ListPartsResponse]
ReadPrec ListPartsResponse
Int -> ReadS ListPartsResponse
ReadS [ListPartsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPartsResponse]
$creadListPrec :: ReadPrec [ListPartsResponse]
readPrec :: ReadPrec ListPartsResponse
$creadPrec :: ReadPrec ListPartsResponse
readList :: ReadS [ListPartsResponse]
$creadList :: ReadS [ListPartsResponse]
readsPrec :: Int -> ReadS ListPartsResponse
$creadsPrec :: Int -> ReadS ListPartsResponse
Prelude.Read, Int -> ListPartsResponse -> ShowS
[ListPartsResponse] -> ShowS
ListPartsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPartsResponse] -> ShowS
$cshowList :: [ListPartsResponse] -> ShowS
show :: ListPartsResponse -> String
$cshow :: ListPartsResponse -> String
showsPrec :: Int -> ListPartsResponse -> ShowS
$cshowsPrec :: Int -> ListPartsResponse -> ShowS
Prelude.Show, forall x. Rep ListPartsResponse x -> ListPartsResponse
forall x. ListPartsResponse -> Rep ListPartsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPartsResponse x -> ListPartsResponse
$cfrom :: forall x. ListPartsResponse -> Rep ListPartsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPartsResponse' 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:
--
-- 'abortDate', 'listPartsResponse_abortDate' - If the bucket has a lifecycle rule configured with an action to abort
-- incomplete multipart uploads and the prefix in the lifecycle rule
-- matches the object name in the request, then the response includes this
-- header indicating when the initiated multipart upload will become
-- eligible for abort operation. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/mpuoverview.html#mpu-abort-incomplete-mpu-lifecycle-config Aborting Incomplete Multipart Uploads Using a Bucket Lifecycle Policy>.
--
-- The response will also include the @x-amz-abort-rule-id@ header that
-- will provide the ID of the lifecycle configuration rule that defines
-- this action.
--
-- 'abortRuleId', 'listPartsResponse_abortRuleId' - This header is returned along with the @x-amz-abort-date@ header. It
-- identifies applicable lifecycle configuration rule that defines the
-- action to abort incomplete multipart uploads.
--
-- 'bucket', 'listPartsResponse_bucket' - The name of the bucket to which the multipart upload was initiated. Does
-- not return the access point ARN or access point alias if used.
--
-- 'checksumAlgorithm', 'listPartsResponse_checksumAlgorithm' - The algorithm that was used to create a checksum of the object.
--
-- 'initiator', 'listPartsResponse_initiator' - Container element that identifies who initiated the multipart upload. If
-- the initiator is an Amazon Web Services account, this element provides
-- the same information as the @Owner@ element. If the initiator is an IAM
-- User, this element provides the user ARN and display name.
--
-- 'isTruncated', 'listPartsResponse_isTruncated' - Indicates whether the returned list of parts is truncated. A true value
-- indicates that the list was truncated. A list can be truncated if the
-- number of parts exceeds the limit returned in the MaxParts element.
--
-- 'key', 'listPartsResponse_key' - Object key for which the multipart upload was initiated.
--
-- 'maxParts', 'listPartsResponse_maxParts' - Maximum number of parts that were allowed in the response.
--
-- 'nextPartNumberMarker', 'listPartsResponse_nextPartNumberMarker' - When a list is truncated, this element specifies the last part in the
-- list, as well as the value to use for the part-number-marker request
-- parameter in a subsequent request.
--
-- 'owner', 'listPartsResponse_owner' - Container element that identifies the object owner, after the object is
-- created. If multipart upload is initiated by an IAM user, this element
-- provides the parent account ID and display name.
--
-- 'partNumberMarker', 'listPartsResponse_partNumberMarker' - When a list is truncated, this element specifies the last part in the
-- list, as well as the value to use for the part-number-marker request
-- parameter in a subsequent request.
--
-- 'parts', 'listPartsResponse_parts' - Container for elements related to a particular part. A response can
-- contain zero or more @Part@ elements.
--
-- 'requestCharged', 'listPartsResponse_requestCharged' - Undocumented member.
--
-- 'storageClass', 'listPartsResponse_storageClass' - Class of storage (STANDARD or REDUCED_REDUNDANCY) used to store the
-- uploaded object.
--
-- 'uploadId', 'listPartsResponse_uploadId' - Upload ID identifying the multipart upload whose parts are being listed.
--
-- 'httpStatus', 'listPartsResponse_httpStatus' - The response's http status code.
newListPartsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPartsResponse
newListPartsResponse :: Int -> ListPartsResponse
newListPartsResponse Int
pHttpStatus_ =
  ListPartsResponse'
    { $sel:abortDate:ListPartsResponse' :: Maybe RFC822
abortDate = forall a. Maybe a
Prelude.Nothing,
      $sel:abortRuleId:ListPartsResponse' :: Maybe Text
abortRuleId = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:ListPartsResponse' :: Maybe BucketName
bucket = forall a. Maybe a
Prelude.Nothing,
      $sel:checksumAlgorithm:ListPartsResponse' :: Maybe ChecksumAlgorithm
checksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:initiator:ListPartsResponse' :: Maybe Initiator
initiator = forall a. Maybe a
Prelude.Nothing,
      $sel:isTruncated:ListPartsResponse' :: Maybe Bool
isTruncated = forall a. Maybe a
Prelude.Nothing,
      $sel:key:ListPartsResponse' :: Maybe ObjectKey
key = forall a. Maybe a
Prelude.Nothing,
      $sel:maxParts:ListPartsResponse' :: Maybe Int
maxParts = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPartNumberMarker:ListPartsResponse' :: Maybe Int
nextPartNumberMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:owner:ListPartsResponse' :: Maybe Owner
owner = forall a. Maybe a
Prelude.Nothing,
      $sel:partNumberMarker:ListPartsResponse' :: Maybe Int
partNumberMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:parts:ListPartsResponse' :: Maybe [Part]
parts = forall a. Maybe a
Prelude.Nothing,
      $sel:requestCharged:ListPartsResponse' :: Maybe RequestCharged
requestCharged = forall a. Maybe a
Prelude.Nothing,
      $sel:storageClass:ListPartsResponse' :: Maybe StorageClass
storageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:uploadId:ListPartsResponse' :: Maybe Text
uploadId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPartsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the bucket has a lifecycle rule configured with an action to abort
-- incomplete multipart uploads and the prefix in the lifecycle rule
-- matches the object name in the request, then the response includes this
-- header indicating when the initiated multipart upload will become
-- eligible for abort operation. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/mpuoverview.html#mpu-abort-incomplete-mpu-lifecycle-config Aborting Incomplete Multipart Uploads Using a Bucket Lifecycle Policy>.
--
-- The response will also include the @x-amz-abort-rule-id@ header that
-- will provide the ID of the lifecycle configuration rule that defines
-- this action.
listPartsResponse_abortDate :: Lens.Lens' ListPartsResponse (Prelude.Maybe Prelude.UTCTime)
listPartsResponse_abortDate :: Lens' ListPartsResponse (Maybe UTCTime)
listPartsResponse_abortDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe RFC822
abortDate :: Maybe RFC822
$sel:abortDate:ListPartsResponse' :: ListPartsResponse -> Maybe RFC822
abortDate} -> Maybe RFC822
abortDate) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe RFC822
a -> ListPartsResponse
s {$sel:abortDate:ListPartsResponse' :: Maybe RFC822
abortDate = Maybe RFC822
a} :: ListPartsResponse) 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

-- | This header is returned along with the @x-amz-abort-date@ header. It
-- identifies applicable lifecycle configuration rule that defines the
-- action to abort incomplete multipart uploads.
listPartsResponse_abortRuleId :: Lens.Lens' ListPartsResponse (Prelude.Maybe Prelude.Text)
listPartsResponse_abortRuleId :: Lens' ListPartsResponse (Maybe Text)
listPartsResponse_abortRuleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe Text
abortRuleId :: Maybe Text
$sel:abortRuleId:ListPartsResponse' :: ListPartsResponse -> Maybe Text
abortRuleId} -> Maybe Text
abortRuleId) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe Text
a -> ListPartsResponse
s {$sel:abortRuleId:ListPartsResponse' :: Maybe Text
abortRuleId = Maybe Text
a} :: ListPartsResponse)

-- | The name of the bucket to which the multipart upload was initiated. Does
-- not return the access point ARN or access point alias if used.
listPartsResponse_bucket :: Lens.Lens' ListPartsResponse (Prelude.Maybe BucketName)
listPartsResponse_bucket :: Lens' ListPartsResponse (Maybe BucketName)
listPartsResponse_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe BucketName
bucket :: Maybe BucketName
$sel:bucket:ListPartsResponse' :: ListPartsResponse -> Maybe BucketName
bucket} -> Maybe BucketName
bucket) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe BucketName
a -> ListPartsResponse
s {$sel:bucket:ListPartsResponse' :: Maybe BucketName
bucket = Maybe BucketName
a} :: ListPartsResponse)

-- | The algorithm that was used to create a checksum of the object.
listPartsResponse_checksumAlgorithm :: Lens.Lens' ListPartsResponse (Prelude.Maybe ChecksumAlgorithm)
listPartsResponse_checksumAlgorithm :: Lens' ListPartsResponse (Maybe ChecksumAlgorithm)
listPartsResponse_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe ChecksumAlgorithm
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:checksumAlgorithm:ListPartsResponse' :: ListPartsResponse -> Maybe ChecksumAlgorithm
checksumAlgorithm} -> Maybe ChecksumAlgorithm
checksumAlgorithm) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe ChecksumAlgorithm
a -> ListPartsResponse
s {$sel:checksumAlgorithm:ListPartsResponse' :: Maybe ChecksumAlgorithm
checksumAlgorithm = Maybe ChecksumAlgorithm
a} :: ListPartsResponse)

-- | Container element that identifies who initiated the multipart upload. If
-- the initiator is an Amazon Web Services account, this element provides
-- the same information as the @Owner@ element. If the initiator is an IAM
-- User, this element provides the user ARN and display name.
listPartsResponse_initiator :: Lens.Lens' ListPartsResponse (Prelude.Maybe Initiator)
listPartsResponse_initiator :: Lens' ListPartsResponse (Maybe Initiator)
listPartsResponse_initiator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe Initiator
initiator :: Maybe Initiator
$sel:initiator:ListPartsResponse' :: ListPartsResponse -> Maybe Initiator
initiator} -> Maybe Initiator
initiator) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe Initiator
a -> ListPartsResponse
s {$sel:initiator:ListPartsResponse' :: Maybe Initiator
initiator = Maybe Initiator
a} :: ListPartsResponse)

-- | Indicates whether the returned list of parts is truncated. A true value
-- indicates that the list was truncated. A list can be truncated if the
-- number of parts exceeds the limit returned in the MaxParts element.
listPartsResponse_isTruncated :: Lens.Lens' ListPartsResponse (Prelude.Maybe Prelude.Bool)
listPartsResponse_isTruncated :: Lens' ListPartsResponse (Maybe Bool)
listPartsResponse_isTruncated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe Bool
isTruncated :: Maybe Bool
$sel:isTruncated:ListPartsResponse' :: ListPartsResponse -> Maybe Bool
isTruncated} -> Maybe Bool
isTruncated) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe Bool
a -> ListPartsResponse
s {$sel:isTruncated:ListPartsResponse' :: Maybe Bool
isTruncated = Maybe Bool
a} :: ListPartsResponse)

-- | Object key for which the multipart upload was initiated.
listPartsResponse_key :: Lens.Lens' ListPartsResponse (Prelude.Maybe ObjectKey)
listPartsResponse_key :: Lens' ListPartsResponse (Maybe ObjectKey)
listPartsResponse_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe ObjectKey
key :: Maybe ObjectKey
$sel:key:ListPartsResponse' :: ListPartsResponse -> Maybe ObjectKey
key} -> Maybe ObjectKey
key) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe ObjectKey
a -> ListPartsResponse
s {$sel:key:ListPartsResponse' :: Maybe ObjectKey
key = Maybe ObjectKey
a} :: ListPartsResponse)

-- | Maximum number of parts that were allowed in the response.
listPartsResponse_maxParts :: Lens.Lens' ListPartsResponse (Prelude.Maybe Prelude.Int)
listPartsResponse_maxParts :: Lens' ListPartsResponse (Maybe Int)
listPartsResponse_maxParts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe Int
maxParts :: Maybe Int
$sel:maxParts:ListPartsResponse' :: ListPartsResponse -> Maybe Int
maxParts} -> Maybe Int
maxParts) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe Int
a -> ListPartsResponse
s {$sel:maxParts:ListPartsResponse' :: Maybe Int
maxParts = Maybe Int
a} :: ListPartsResponse)

-- | When a list is truncated, this element specifies the last part in the
-- list, as well as the value to use for the part-number-marker request
-- parameter in a subsequent request.
listPartsResponse_nextPartNumberMarker :: Lens.Lens' ListPartsResponse (Prelude.Maybe Prelude.Int)
listPartsResponse_nextPartNumberMarker :: Lens' ListPartsResponse (Maybe Int)
listPartsResponse_nextPartNumberMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe Int
nextPartNumberMarker :: Maybe Int
$sel:nextPartNumberMarker:ListPartsResponse' :: ListPartsResponse -> Maybe Int
nextPartNumberMarker} -> Maybe Int
nextPartNumberMarker) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe Int
a -> ListPartsResponse
s {$sel:nextPartNumberMarker:ListPartsResponse' :: Maybe Int
nextPartNumberMarker = Maybe Int
a} :: ListPartsResponse)

-- | Container element that identifies the object owner, after the object is
-- created. If multipart upload is initiated by an IAM user, this element
-- provides the parent account ID and display name.
listPartsResponse_owner :: Lens.Lens' ListPartsResponse (Prelude.Maybe Owner)
listPartsResponse_owner :: Lens' ListPartsResponse (Maybe Owner)
listPartsResponse_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe Owner
owner :: Maybe Owner
$sel:owner:ListPartsResponse' :: ListPartsResponse -> Maybe Owner
owner} -> Maybe Owner
owner) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe Owner
a -> ListPartsResponse
s {$sel:owner:ListPartsResponse' :: Maybe Owner
owner = Maybe Owner
a} :: ListPartsResponse)

-- | When a list is truncated, this element specifies the last part in the
-- list, as well as the value to use for the part-number-marker request
-- parameter in a subsequent request.
listPartsResponse_partNumberMarker :: Lens.Lens' ListPartsResponse (Prelude.Maybe Prelude.Int)
listPartsResponse_partNumberMarker :: Lens' ListPartsResponse (Maybe Int)
listPartsResponse_partNumberMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe Int
partNumberMarker :: Maybe Int
$sel:partNumberMarker:ListPartsResponse' :: ListPartsResponse -> Maybe Int
partNumberMarker} -> Maybe Int
partNumberMarker) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe Int
a -> ListPartsResponse
s {$sel:partNumberMarker:ListPartsResponse' :: Maybe Int
partNumberMarker = Maybe Int
a} :: ListPartsResponse)

-- | Container for elements related to a particular part. A response can
-- contain zero or more @Part@ elements.
listPartsResponse_parts :: Lens.Lens' ListPartsResponse (Prelude.Maybe [Part])
listPartsResponse_parts :: Lens' ListPartsResponse (Maybe [Part])
listPartsResponse_parts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe [Part]
parts :: Maybe [Part]
$sel:parts:ListPartsResponse' :: ListPartsResponse -> Maybe [Part]
parts} -> Maybe [Part]
parts) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe [Part]
a -> ListPartsResponse
s {$sel:parts:ListPartsResponse' :: Maybe [Part]
parts = Maybe [Part]
a} :: ListPartsResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | Class of storage (STANDARD or REDUCED_REDUNDANCY) used to store the
-- uploaded object.
listPartsResponse_storageClass :: Lens.Lens' ListPartsResponse (Prelude.Maybe StorageClass)
listPartsResponse_storageClass :: Lens' ListPartsResponse (Maybe StorageClass)
listPartsResponse_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe StorageClass
storageClass :: Maybe StorageClass
$sel:storageClass:ListPartsResponse' :: ListPartsResponse -> Maybe StorageClass
storageClass} -> Maybe StorageClass
storageClass) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe StorageClass
a -> ListPartsResponse
s {$sel:storageClass:ListPartsResponse' :: Maybe StorageClass
storageClass = Maybe StorageClass
a} :: ListPartsResponse)

-- | Upload ID identifying the multipart upload whose parts are being listed.
listPartsResponse_uploadId :: Lens.Lens' ListPartsResponse (Prelude.Maybe Prelude.Text)
listPartsResponse_uploadId :: Lens' ListPartsResponse (Maybe Text)
listPartsResponse_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPartsResponse' {Maybe Text
uploadId :: Maybe Text
$sel:uploadId:ListPartsResponse' :: ListPartsResponse -> Maybe Text
uploadId} -> Maybe Text
uploadId) (\s :: ListPartsResponse
s@ListPartsResponse' {} Maybe Text
a -> ListPartsResponse
s {$sel:uploadId:ListPartsResponse' :: Maybe Text
uploadId = Maybe Text
a} :: ListPartsResponse)

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

instance Prelude.NFData ListPartsResponse where
  rnf :: ListPartsResponse -> ()
rnf ListPartsResponse' {Int
Maybe Bool
Maybe Int
Maybe [Part]
Maybe Text
Maybe RFC822
Maybe ObjectKey
Maybe BucketName
Maybe ChecksumAlgorithm
Maybe Initiator
Maybe Owner
Maybe RequestCharged
Maybe StorageClass
httpStatus :: Int
uploadId :: Maybe Text
storageClass :: Maybe StorageClass
requestCharged :: Maybe RequestCharged
parts :: Maybe [Part]
partNumberMarker :: Maybe Int
owner :: Maybe Owner
nextPartNumberMarker :: Maybe Int
maxParts :: Maybe Int
key :: Maybe ObjectKey
isTruncated :: Maybe Bool
initiator :: Maybe Initiator
checksumAlgorithm :: Maybe ChecksumAlgorithm
bucket :: Maybe BucketName
abortRuleId :: Maybe Text
abortDate :: Maybe RFC822
$sel:httpStatus:ListPartsResponse' :: ListPartsResponse -> Int
$sel:uploadId:ListPartsResponse' :: ListPartsResponse -> Maybe Text
$sel:storageClass:ListPartsResponse' :: ListPartsResponse -> Maybe StorageClass
$sel:requestCharged:ListPartsResponse' :: ListPartsResponse -> Maybe RequestCharged
$sel:parts:ListPartsResponse' :: ListPartsResponse -> Maybe [Part]
$sel:partNumberMarker:ListPartsResponse' :: ListPartsResponse -> Maybe Int
$sel:owner:ListPartsResponse' :: ListPartsResponse -> Maybe Owner
$sel:nextPartNumberMarker:ListPartsResponse' :: ListPartsResponse -> Maybe Int
$sel:maxParts:ListPartsResponse' :: ListPartsResponse -> Maybe Int
$sel:key:ListPartsResponse' :: ListPartsResponse -> Maybe ObjectKey
$sel:isTruncated:ListPartsResponse' :: ListPartsResponse -> Maybe Bool
$sel:initiator:ListPartsResponse' :: ListPartsResponse -> Maybe Initiator
$sel:checksumAlgorithm:ListPartsResponse' :: ListPartsResponse -> Maybe ChecksumAlgorithm
$sel:bucket:ListPartsResponse' :: ListPartsResponse -> Maybe BucketName
$sel:abortRuleId:ListPartsResponse' :: ListPartsResponse -> Maybe Text
$sel:abortDate:ListPartsResponse' :: ListPartsResponse -> Maybe RFC822
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RFC822
abortDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
abortRuleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BucketName
bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Initiator
initiator
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isTruncated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ObjectKey
key
      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
nextPartNumberMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Owner
owner
      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 [Part]
parts
      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 Text
uploadId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus