{-# 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.ListMultipartUploads
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This action lists in-progress multipart uploads. An in-progress
-- multipart upload is a multipart upload that has been initiated using the
-- Initiate Multipart Upload request, but has not yet been completed or
-- aborted.
--
-- This action returns at most 1,000 multipart uploads in the response.
-- 1,000 multipart uploads is the maximum number of uploads a response can
-- include, which is also the default value. You can further limit the
-- number of uploads in a response by specifying the @max-uploads@
-- parameter in the response. If additional multipart uploads satisfy the
-- list criteria, the response will contain an @IsTruncated@ element with
-- the value true. To list the additional multipart uploads, use the
-- @key-marker@ and @upload-id-marker@ request parameters.
--
-- In the response, the uploads are sorted by key. If your application has
-- initiated more than one multipart upload using the same object key, then
-- uploads in the response are first sorted by key. Additionally, uploads
-- are sorted in ascending order within each key by the upload initiation
-- time.
--
-- 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 @ListMultipartUploads@:
--
-- -   <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_ListParts.html ListParts>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_AbortMultipartUpload.html AbortMultipartUpload>
--
-- This operation returns paginated results.
module Amazonka.S3.ListMultipartUploads
  ( -- * Creating a Request
    ListMultipartUploads (..),
    newListMultipartUploads,

    -- * Request Lenses
    listMultipartUploads_delimiter,
    listMultipartUploads_encodingType,
    listMultipartUploads_expectedBucketOwner,
    listMultipartUploads_keyMarker,
    listMultipartUploads_maxUploads,
    listMultipartUploads_prefix,
    listMultipartUploads_uploadIdMarker,
    listMultipartUploads_bucket,

    -- * Destructuring the Response
    ListMultipartUploadsResponse (..),
    newListMultipartUploadsResponse,

    -- * Response Lenses
    listMultipartUploadsResponse_bucket,
    listMultipartUploadsResponse_commonPrefixes,
    listMultipartUploadsResponse_delimiter,
    listMultipartUploadsResponse_encodingType,
    listMultipartUploadsResponse_isTruncated,
    listMultipartUploadsResponse_keyMarker,
    listMultipartUploadsResponse_maxUploads,
    listMultipartUploadsResponse_nextKeyMarker,
    listMultipartUploadsResponse_nextUploadIdMarker,
    listMultipartUploadsResponse_prefix,
    listMultipartUploadsResponse_uploadIdMarker,
    listMultipartUploadsResponse_uploads,
    listMultipartUploadsResponse_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:/ 'newListMultipartUploads' smart constructor.
data ListMultipartUploads = ListMultipartUploads'
  { -- | Character you use to group keys.
    --
    -- All keys that contain the same string between the prefix, if specified,
    -- and the first occurrence of the delimiter after the prefix are grouped
    -- under a single result element, @CommonPrefixes@. If you don\'t specify
    -- the prefix parameter, then the substring starts at the beginning of the
    -- key. The keys that are grouped under @CommonPrefixes@ result element are
    -- not returned elsewhere in the response.
    ListMultipartUploads -> Maybe Delimiter
delimiter :: Prelude.Maybe Delimiter,
    ListMultipartUploads -> Maybe EncodingType
encodingType :: Prelude.Maybe EncodingType,
    -- | 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).
    ListMultipartUploads -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | Together with upload-id-marker, this parameter specifies the multipart
    -- upload after which listing should begin.
    --
    -- If @upload-id-marker@ is not specified, only the keys lexicographically
    -- greater than the specified @key-marker@ will be included in the list.
    --
    -- If @upload-id-marker@ is specified, any multipart uploads for a key
    -- equal to the @key-marker@ might also be included, provided those
    -- multipart uploads have upload IDs lexicographically greater than the
    -- specified @upload-id-marker@.
    ListMultipartUploads -> Maybe Text
keyMarker :: Prelude.Maybe Prelude.Text,
    -- | Sets the maximum number of multipart uploads, from 1 to 1,000, to return
    -- in the response body. 1,000 is the maximum number of uploads that can be
    -- returned in a response.
    ListMultipartUploads -> Maybe Int
maxUploads :: Prelude.Maybe Prelude.Int,
    -- | Lists in-progress uploads only for those keys that begin with the
    -- specified prefix. You can use prefixes to separate a bucket into
    -- different grouping of keys. (You can think of using prefix to make
    -- groups in the same way you\'d use a folder in a file system.)
    ListMultipartUploads -> Maybe Text
prefix :: Prelude.Maybe Prelude.Text,
    -- | Together with key-marker, specifies the multipart upload after which
    -- listing should begin. If key-marker is not specified, the
    -- upload-id-marker parameter is ignored. Otherwise, any multipart uploads
    -- for a key equal to the key-marker might be included in the list only if
    -- they have an upload ID lexicographically greater than the specified
    -- @upload-id-marker@.
    ListMultipartUploads -> Maybe Text
uploadIdMarker :: Prelude.Maybe Prelude.Text,
    -- | The name of the bucket to which the multipart upload was initiated.
    --
    -- 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/.
    ListMultipartUploads -> BucketName
bucket :: BucketName
  }
  deriving (ListMultipartUploads -> ListMultipartUploads -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMultipartUploads -> ListMultipartUploads -> Bool
$c/= :: ListMultipartUploads -> ListMultipartUploads -> Bool
== :: ListMultipartUploads -> ListMultipartUploads -> Bool
$c== :: ListMultipartUploads -> ListMultipartUploads -> Bool
Prelude.Eq, ReadPrec [ListMultipartUploads]
ReadPrec ListMultipartUploads
Int -> ReadS ListMultipartUploads
ReadS [ListMultipartUploads]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMultipartUploads]
$creadListPrec :: ReadPrec [ListMultipartUploads]
readPrec :: ReadPrec ListMultipartUploads
$creadPrec :: ReadPrec ListMultipartUploads
readList :: ReadS [ListMultipartUploads]
$creadList :: ReadS [ListMultipartUploads]
readsPrec :: Int -> ReadS ListMultipartUploads
$creadsPrec :: Int -> ReadS ListMultipartUploads
Prelude.Read, Int -> ListMultipartUploads -> ShowS
[ListMultipartUploads] -> ShowS
ListMultipartUploads -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMultipartUploads] -> ShowS
$cshowList :: [ListMultipartUploads] -> ShowS
show :: ListMultipartUploads -> String
$cshow :: ListMultipartUploads -> String
showsPrec :: Int -> ListMultipartUploads -> ShowS
$cshowsPrec :: Int -> ListMultipartUploads -> ShowS
Prelude.Show, forall x. Rep ListMultipartUploads x -> ListMultipartUploads
forall x. ListMultipartUploads -> Rep ListMultipartUploads x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListMultipartUploads x -> ListMultipartUploads
$cfrom :: forall x. ListMultipartUploads -> Rep ListMultipartUploads x
Prelude.Generic)

-- |
-- Create a value of 'ListMultipartUploads' 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:
--
-- 'delimiter', 'listMultipartUploads_delimiter' - Character you use to group keys.
--
-- All keys that contain the same string between the prefix, if specified,
-- and the first occurrence of the delimiter after the prefix are grouped
-- under a single result element, @CommonPrefixes@. If you don\'t specify
-- the prefix parameter, then the substring starts at the beginning of the
-- key. The keys that are grouped under @CommonPrefixes@ result element are
-- not returned elsewhere in the response.
--
-- 'encodingType', 'listMultipartUploads_encodingType' - Undocumented member.
--
-- 'expectedBucketOwner', 'listMultipartUploads_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).
--
-- 'keyMarker', 'listMultipartUploads_keyMarker' - Together with upload-id-marker, this parameter specifies the multipart
-- upload after which listing should begin.
--
-- If @upload-id-marker@ is not specified, only the keys lexicographically
-- greater than the specified @key-marker@ will be included in the list.
--
-- If @upload-id-marker@ is specified, any multipart uploads for a key
-- equal to the @key-marker@ might also be included, provided those
-- multipart uploads have upload IDs lexicographically greater than the
-- specified @upload-id-marker@.
--
-- 'maxUploads', 'listMultipartUploads_maxUploads' - Sets the maximum number of multipart uploads, from 1 to 1,000, to return
-- in the response body. 1,000 is the maximum number of uploads that can be
-- returned in a response.
--
-- 'prefix', 'listMultipartUploads_prefix' - Lists in-progress uploads only for those keys that begin with the
-- specified prefix. You can use prefixes to separate a bucket into
-- different grouping of keys. (You can think of using prefix to make
-- groups in the same way you\'d use a folder in a file system.)
--
-- 'uploadIdMarker', 'listMultipartUploads_uploadIdMarker' - Together with key-marker, specifies the multipart upload after which
-- listing should begin. If key-marker is not specified, the
-- upload-id-marker parameter is ignored. Otherwise, any multipart uploads
-- for a key equal to the key-marker might be included in the list only if
-- they have an upload ID lexicographically greater than the specified
-- @upload-id-marker@.
--
-- 'bucket', 'listMultipartUploads_bucket' - The name of the bucket to which the multipart upload was initiated.
--
-- 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/.
newListMultipartUploads ::
  -- | 'bucket'
  BucketName ->
  ListMultipartUploads
newListMultipartUploads :: BucketName -> ListMultipartUploads
newListMultipartUploads BucketName
pBucket_ =
  ListMultipartUploads'
    { $sel:delimiter:ListMultipartUploads' :: Maybe Delimiter
delimiter = forall a. Maybe a
Prelude.Nothing,
      $sel:encodingType:ListMultipartUploads' :: Maybe EncodingType
encodingType = forall a. Maybe a
Prelude.Nothing,
      $sel:expectedBucketOwner:ListMultipartUploads' :: Maybe Text
expectedBucketOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:keyMarker:ListMultipartUploads' :: Maybe Text
keyMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxUploads:ListMultipartUploads' :: Maybe Int
maxUploads = forall a. Maybe a
Prelude.Nothing,
      $sel:prefix:ListMultipartUploads' :: Maybe Text
prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:uploadIdMarker:ListMultipartUploads' :: Maybe Text
uploadIdMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:ListMultipartUploads' :: BucketName
bucket = BucketName
pBucket_
    }

-- | Character you use to group keys.
--
-- All keys that contain the same string between the prefix, if specified,
-- and the first occurrence of the delimiter after the prefix are grouped
-- under a single result element, @CommonPrefixes@. If you don\'t specify
-- the prefix parameter, then the substring starts at the beginning of the
-- key. The keys that are grouped under @CommonPrefixes@ result element are
-- not returned elsewhere in the response.
listMultipartUploads_delimiter :: Lens.Lens' ListMultipartUploads (Prelude.Maybe Delimiter)
listMultipartUploads_delimiter :: Lens' ListMultipartUploads (Maybe Delimiter)
listMultipartUploads_delimiter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploads' {Maybe Delimiter
delimiter :: Maybe Delimiter
$sel:delimiter:ListMultipartUploads' :: ListMultipartUploads -> Maybe Delimiter
delimiter} -> Maybe Delimiter
delimiter) (\s :: ListMultipartUploads
s@ListMultipartUploads' {} Maybe Delimiter
a -> ListMultipartUploads
s {$sel:delimiter:ListMultipartUploads' :: Maybe Delimiter
delimiter = Maybe Delimiter
a} :: ListMultipartUploads)

-- | Undocumented member.
listMultipartUploads_encodingType :: Lens.Lens' ListMultipartUploads (Prelude.Maybe EncodingType)
listMultipartUploads_encodingType :: Lens' ListMultipartUploads (Maybe EncodingType)
listMultipartUploads_encodingType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploads' {Maybe EncodingType
encodingType :: Maybe EncodingType
$sel:encodingType:ListMultipartUploads' :: ListMultipartUploads -> Maybe EncodingType
encodingType} -> Maybe EncodingType
encodingType) (\s :: ListMultipartUploads
s@ListMultipartUploads' {} Maybe EncodingType
a -> ListMultipartUploads
s {$sel:encodingType:ListMultipartUploads' :: Maybe EncodingType
encodingType = Maybe EncodingType
a} :: ListMultipartUploads)

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

-- | Together with upload-id-marker, this parameter specifies the multipart
-- upload after which listing should begin.
--
-- If @upload-id-marker@ is not specified, only the keys lexicographically
-- greater than the specified @key-marker@ will be included in the list.
--
-- If @upload-id-marker@ is specified, any multipart uploads for a key
-- equal to the @key-marker@ might also be included, provided those
-- multipart uploads have upload IDs lexicographically greater than the
-- specified @upload-id-marker@.
listMultipartUploads_keyMarker :: Lens.Lens' ListMultipartUploads (Prelude.Maybe Prelude.Text)
listMultipartUploads_keyMarker :: Lens' ListMultipartUploads (Maybe Text)
listMultipartUploads_keyMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploads' {Maybe Text
keyMarker :: Maybe Text
$sel:keyMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
keyMarker} -> Maybe Text
keyMarker) (\s :: ListMultipartUploads
s@ListMultipartUploads' {} Maybe Text
a -> ListMultipartUploads
s {$sel:keyMarker:ListMultipartUploads' :: Maybe Text
keyMarker = Maybe Text
a} :: ListMultipartUploads)

-- | Sets the maximum number of multipart uploads, from 1 to 1,000, to return
-- in the response body. 1,000 is the maximum number of uploads that can be
-- returned in a response.
listMultipartUploads_maxUploads :: Lens.Lens' ListMultipartUploads (Prelude.Maybe Prelude.Int)
listMultipartUploads_maxUploads :: Lens' ListMultipartUploads (Maybe Int)
listMultipartUploads_maxUploads = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploads' {Maybe Int
maxUploads :: Maybe Int
$sel:maxUploads:ListMultipartUploads' :: ListMultipartUploads -> Maybe Int
maxUploads} -> Maybe Int
maxUploads) (\s :: ListMultipartUploads
s@ListMultipartUploads' {} Maybe Int
a -> ListMultipartUploads
s {$sel:maxUploads:ListMultipartUploads' :: Maybe Int
maxUploads = Maybe Int
a} :: ListMultipartUploads)

-- | Lists in-progress uploads only for those keys that begin with the
-- specified prefix. You can use prefixes to separate a bucket into
-- different grouping of keys. (You can think of using prefix to make
-- groups in the same way you\'d use a folder in a file system.)
listMultipartUploads_prefix :: Lens.Lens' ListMultipartUploads (Prelude.Maybe Prelude.Text)
listMultipartUploads_prefix :: Lens' ListMultipartUploads (Maybe Text)
listMultipartUploads_prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploads' {Maybe Text
prefix :: Maybe Text
$sel:prefix:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
prefix} -> Maybe Text
prefix) (\s :: ListMultipartUploads
s@ListMultipartUploads' {} Maybe Text
a -> ListMultipartUploads
s {$sel:prefix:ListMultipartUploads' :: Maybe Text
prefix = Maybe Text
a} :: ListMultipartUploads)

-- | Together with key-marker, specifies the multipart upload after which
-- listing should begin. If key-marker is not specified, the
-- upload-id-marker parameter is ignored. Otherwise, any multipart uploads
-- for a key equal to the key-marker might be included in the list only if
-- they have an upload ID lexicographically greater than the specified
-- @upload-id-marker@.
listMultipartUploads_uploadIdMarker :: Lens.Lens' ListMultipartUploads (Prelude.Maybe Prelude.Text)
listMultipartUploads_uploadIdMarker :: Lens' ListMultipartUploads (Maybe Text)
listMultipartUploads_uploadIdMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploads' {Maybe Text
uploadIdMarker :: Maybe Text
$sel:uploadIdMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
uploadIdMarker} -> Maybe Text
uploadIdMarker) (\s :: ListMultipartUploads
s@ListMultipartUploads' {} Maybe Text
a -> ListMultipartUploads
s {$sel:uploadIdMarker:ListMultipartUploads' :: Maybe Text
uploadIdMarker = Maybe Text
a} :: ListMultipartUploads)

-- | The name of the bucket to which the multipart upload was initiated.
--
-- 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/.
listMultipartUploads_bucket :: Lens.Lens' ListMultipartUploads BucketName
listMultipartUploads_bucket :: Lens' ListMultipartUploads BucketName
listMultipartUploads_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploads' {BucketName
bucket :: BucketName
$sel:bucket:ListMultipartUploads' :: ListMultipartUploads -> BucketName
bucket} -> BucketName
bucket) (\s :: ListMultipartUploads
s@ListMultipartUploads' {} BucketName
a -> ListMultipartUploads
s {$sel:bucket:ListMultipartUploads' :: BucketName
bucket = BucketName
a} :: ListMultipartUploads)

instance Core.AWSPager ListMultipartUploads where
  page :: ListMultipartUploads
-> AWSResponse ListMultipartUploads -> Maybe ListMultipartUploads
page ListMultipartUploads
rq AWSResponse ListMultipartUploads
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListMultipartUploads
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMultipartUploadsResponse (Maybe Bool)
listMultipartUploadsResponse_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 ListMultipartUploads
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_nextKeyMarker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        )
        Bool -> Bool -> Bool
Prelude.&& forall a. Maybe a -> Bool
Prelude.isNothing
          ( AWSResponse ListMultipartUploads
rs
              forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_nextUploadIdMarker
              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.$ ListMultipartUploads
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListMultipartUploads (Maybe Text)
listMultipartUploads_keyMarker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListMultipartUploads
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_nextKeyMarker
          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 b. a -> (a -> b) -> b
Prelude.& Lens' ListMultipartUploads (Maybe Text)
listMultipartUploads_uploadIdMarker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListMultipartUploads
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_nextUploadIdMarker
          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 ListMultipartUploads where
  type
    AWSResponse ListMultipartUploads =
      ListMultipartUploadsResponse
  request :: (Service -> Service)
-> ListMultipartUploads -> Request ListMultipartUploads
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 ListMultipartUploads
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListMultipartUploads)))
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 BucketName
-> Maybe [CommonPrefix]
-> Maybe Delimiter
-> Maybe EncodingType
-> Maybe Bool
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [MultipartUpload]
-> Int
-> ListMultipartUploadsResponse
ListMultipartUploadsResponse'
            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
"Bucket")
            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
"CommonPrefixes") [Node]
x)
            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
"Delimiter")
            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
"EncodingType")
            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
"KeyMarker")
            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
"MaxUploads")
            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
"NextKeyMarker")
            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
"NextUploadIdMarker")
            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
"Prefix")
            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
"UploadIdMarker")
            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
"Upload") [Node]
x)
            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 ListMultipartUploads where
  hashWithSalt :: Int -> ListMultipartUploads -> Int
hashWithSalt Int
_salt ListMultipartUploads' {Maybe Delimiter
Maybe Int
Maybe Text
Maybe EncodingType
BucketName
bucket :: BucketName
uploadIdMarker :: Maybe Text
prefix :: Maybe Text
maxUploads :: Maybe Int
keyMarker :: Maybe Text
expectedBucketOwner :: Maybe Text
encodingType :: Maybe EncodingType
delimiter :: Maybe Delimiter
$sel:bucket:ListMultipartUploads' :: ListMultipartUploads -> BucketName
$sel:uploadIdMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:prefix:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:maxUploads:ListMultipartUploads' :: ListMultipartUploads -> Maybe Int
$sel:keyMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:expectedBucketOwner:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:encodingType:ListMultipartUploads' :: ListMultipartUploads -> Maybe EncodingType
$sel:delimiter:ListMultipartUploads' :: ListMultipartUploads -> Maybe Delimiter
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Delimiter
delimiter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncodingType
encodingType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedBucketOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyMarker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxUploads
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
uploadIdMarker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketName
bucket

instance Prelude.NFData ListMultipartUploads where
  rnf :: ListMultipartUploads -> ()
rnf ListMultipartUploads' {Maybe Delimiter
Maybe Int
Maybe Text
Maybe EncodingType
BucketName
bucket :: BucketName
uploadIdMarker :: Maybe Text
prefix :: Maybe Text
maxUploads :: Maybe Int
keyMarker :: Maybe Text
expectedBucketOwner :: Maybe Text
encodingType :: Maybe EncodingType
delimiter :: Maybe Delimiter
$sel:bucket:ListMultipartUploads' :: ListMultipartUploads -> BucketName
$sel:uploadIdMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:prefix:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:maxUploads:ListMultipartUploads' :: ListMultipartUploads -> Maybe Int
$sel:keyMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:expectedBucketOwner:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:encodingType:ListMultipartUploads' :: ListMultipartUploads -> Maybe EncodingType
$sel:delimiter:ListMultipartUploads' :: ListMultipartUploads -> Maybe Delimiter
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Delimiter
delimiter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncodingType
encodingType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expectedBucketOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxUploads
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
uploadIdMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BucketName
bucket

instance Data.ToHeaders ListMultipartUploads where
  toHeaders :: ListMultipartUploads -> ResponseHeaders
toHeaders ListMultipartUploads' {Maybe Delimiter
Maybe Int
Maybe Text
Maybe EncodingType
BucketName
bucket :: BucketName
uploadIdMarker :: Maybe Text
prefix :: Maybe Text
maxUploads :: Maybe Int
keyMarker :: Maybe Text
expectedBucketOwner :: Maybe Text
encodingType :: Maybe EncodingType
delimiter :: Maybe Delimiter
$sel:bucket:ListMultipartUploads' :: ListMultipartUploads -> BucketName
$sel:uploadIdMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:prefix:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:maxUploads:ListMultipartUploads' :: ListMultipartUploads -> Maybe Int
$sel:keyMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:expectedBucketOwner:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:encodingType:ListMultipartUploads' :: ListMultipartUploads -> Maybe EncodingType
$sel:delimiter:ListMultipartUploads' :: ListMultipartUploads -> Maybe Delimiter
..} =
    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
      ]

instance Data.ToPath ListMultipartUploads where
  toPath :: ListMultipartUploads -> ByteString
toPath ListMultipartUploads' {Maybe Delimiter
Maybe Int
Maybe Text
Maybe EncodingType
BucketName
bucket :: BucketName
uploadIdMarker :: Maybe Text
prefix :: Maybe Text
maxUploads :: Maybe Int
keyMarker :: Maybe Text
expectedBucketOwner :: Maybe Text
encodingType :: Maybe EncodingType
delimiter :: Maybe Delimiter
$sel:bucket:ListMultipartUploads' :: ListMultipartUploads -> BucketName
$sel:uploadIdMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:prefix:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:maxUploads:ListMultipartUploads' :: ListMultipartUploads -> Maybe Int
$sel:keyMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:expectedBucketOwner:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:encodingType:ListMultipartUploads' :: ListMultipartUploads -> Maybe EncodingType
$sel:delimiter:ListMultipartUploads' :: ListMultipartUploads -> Maybe Delimiter
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS BucketName
bucket]

instance Data.ToQuery ListMultipartUploads where
  toQuery :: ListMultipartUploads -> QueryString
toQuery ListMultipartUploads' {Maybe Delimiter
Maybe Int
Maybe Text
Maybe EncodingType
BucketName
bucket :: BucketName
uploadIdMarker :: Maybe Text
prefix :: Maybe Text
maxUploads :: Maybe Int
keyMarker :: Maybe Text
expectedBucketOwner :: Maybe Text
encodingType :: Maybe EncodingType
delimiter :: Maybe Delimiter
$sel:bucket:ListMultipartUploads' :: ListMultipartUploads -> BucketName
$sel:uploadIdMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:prefix:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:maxUploads:ListMultipartUploads' :: ListMultipartUploads -> Maybe Int
$sel:keyMarker:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:expectedBucketOwner:ListMultipartUploads' :: ListMultipartUploads -> Maybe Text
$sel:encodingType:ListMultipartUploads' :: ListMultipartUploads -> Maybe EncodingType
$sel:delimiter:ListMultipartUploads' :: ListMultipartUploads -> Maybe Delimiter
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"delimiter" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Delimiter
delimiter,
        ByteString
"encoding-type" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe EncodingType
encodingType,
        ByteString
"key-marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
keyMarker,
        ByteString
"max-uploads" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxUploads,
        ByteString
"prefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
prefix,
        ByteString
"upload-id-marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
uploadIdMarker,
        QueryString
"uploads"
      ]

-- | /See:/ 'newListMultipartUploadsResponse' smart constructor.
data ListMultipartUploadsResponse = ListMultipartUploadsResponse'
  { -- | 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.
    ListMultipartUploadsResponse -> Maybe BucketName
bucket :: Prelude.Maybe BucketName,
    -- | If you specify a delimiter in the request, then the result returns each
    -- distinct key prefix containing the delimiter in a @CommonPrefixes@
    -- element. The distinct key prefixes are returned in the @Prefix@ child
    -- element.
    ListMultipartUploadsResponse -> Maybe [CommonPrefix]
commonPrefixes :: Prelude.Maybe [CommonPrefix],
    -- | Contains the delimiter you specified in the request. If you don\'t
    -- specify a delimiter in your request, this element is absent from the
    -- response.
    ListMultipartUploadsResponse -> Maybe Delimiter
delimiter :: Prelude.Maybe Delimiter,
    -- | Encoding type used by Amazon S3 to encode object keys in the response.
    --
    -- If you specify @encoding-type@ request parameter, Amazon S3 includes
    -- this element in the response, and returns encoded key name values in the
    -- following response elements:
    --
    -- @Delimiter@, @KeyMarker@, @Prefix@, @NextKeyMarker@, @Key@.
    ListMultipartUploadsResponse -> Maybe EncodingType
encodingType :: Prelude.Maybe EncodingType,
    -- | Indicates whether the returned list of multipart uploads is truncated. A
    -- value of true indicates that the list was truncated. The list can be
    -- truncated if the number of multipart uploads exceeds the limit allowed
    -- or specified by max uploads.
    ListMultipartUploadsResponse -> Maybe Bool
isTruncated :: Prelude.Maybe Prelude.Bool,
    -- | The key at or after which the listing began.
    ListMultipartUploadsResponse -> Maybe Text
keyMarker :: Prelude.Maybe Prelude.Text,
    -- | Maximum number of multipart uploads that could have been included in the
    -- response.
    ListMultipartUploadsResponse -> Maybe Int
maxUploads :: Prelude.Maybe Prelude.Int,
    -- | When a list is truncated, this element specifies the value that should
    -- be used for the key-marker request parameter in a subsequent request.
    ListMultipartUploadsResponse -> Maybe Text
nextKeyMarker :: Prelude.Maybe Prelude.Text,
    -- | When a list is truncated, this element specifies the value that should
    -- be used for the @upload-id-marker@ request parameter in a subsequent
    -- request.
    ListMultipartUploadsResponse -> Maybe Text
nextUploadIdMarker :: Prelude.Maybe Prelude.Text,
    -- | When a prefix is provided in the request, this field contains the
    -- specified prefix. The result contains only keys starting with the
    -- specified prefix.
    ListMultipartUploadsResponse -> Maybe Text
prefix :: Prelude.Maybe Prelude.Text,
    -- | Upload ID after which listing began.
    ListMultipartUploadsResponse -> Maybe Text
uploadIdMarker :: Prelude.Maybe Prelude.Text,
    -- | Container for elements related to a particular multipart upload. A
    -- response can contain zero or more @Upload@ elements.
    ListMultipartUploadsResponse -> Maybe [MultipartUpload]
uploads :: Prelude.Maybe [MultipartUpload],
    -- | The response's http status code.
    ListMultipartUploadsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListMultipartUploadsResponse
-> ListMultipartUploadsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMultipartUploadsResponse
-> ListMultipartUploadsResponse -> Bool
$c/= :: ListMultipartUploadsResponse
-> ListMultipartUploadsResponse -> Bool
== :: ListMultipartUploadsResponse
-> ListMultipartUploadsResponse -> Bool
$c== :: ListMultipartUploadsResponse
-> ListMultipartUploadsResponse -> Bool
Prelude.Eq, ReadPrec [ListMultipartUploadsResponse]
ReadPrec ListMultipartUploadsResponse
Int -> ReadS ListMultipartUploadsResponse
ReadS [ListMultipartUploadsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMultipartUploadsResponse]
$creadListPrec :: ReadPrec [ListMultipartUploadsResponse]
readPrec :: ReadPrec ListMultipartUploadsResponse
$creadPrec :: ReadPrec ListMultipartUploadsResponse
readList :: ReadS [ListMultipartUploadsResponse]
$creadList :: ReadS [ListMultipartUploadsResponse]
readsPrec :: Int -> ReadS ListMultipartUploadsResponse
$creadsPrec :: Int -> ReadS ListMultipartUploadsResponse
Prelude.Read, Int -> ListMultipartUploadsResponse -> ShowS
[ListMultipartUploadsResponse] -> ShowS
ListMultipartUploadsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMultipartUploadsResponse] -> ShowS
$cshowList :: [ListMultipartUploadsResponse] -> ShowS
show :: ListMultipartUploadsResponse -> String
$cshow :: ListMultipartUploadsResponse -> String
showsPrec :: Int -> ListMultipartUploadsResponse -> ShowS
$cshowsPrec :: Int -> ListMultipartUploadsResponse -> ShowS
Prelude.Show, forall x.
Rep ListMultipartUploadsResponse x -> ListMultipartUploadsResponse
forall x.
ListMultipartUploadsResponse -> Rep ListMultipartUploadsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListMultipartUploadsResponse x -> ListMultipartUploadsResponse
$cfrom :: forall x.
ListMultipartUploadsResponse -> Rep ListMultipartUploadsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListMultipartUploadsResponse' 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:
--
-- 'bucket', 'listMultipartUploadsResponse_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.
--
-- 'commonPrefixes', 'listMultipartUploadsResponse_commonPrefixes' - If you specify a delimiter in the request, then the result returns each
-- distinct key prefix containing the delimiter in a @CommonPrefixes@
-- element. The distinct key prefixes are returned in the @Prefix@ child
-- element.
--
-- 'delimiter', 'listMultipartUploadsResponse_delimiter' - Contains the delimiter you specified in the request. If you don\'t
-- specify a delimiter in your request, this element is absent from the
-- response.
--
-- 'encodingType', 'listMultipartUploadsResponse_encodingType' - Encoding type used by Amazon S3 to encode object keys in the response.
--
-- If you specify @encoding-type@ request parameter, Amazon S3 includes
-- this element in the response, and returns encoded key name values in the
-- following response elements:
--
-- @Delimiter@, @KeyMarker@, @Prefix@, @NextKeyMarker@, @Key@.
--
-- 'isTruncated', 'listMultipartUploadsResponse_isTruncated' - Indicates whether the returned list of multipart uploads is truncated. A
-- value of true indicates that the list was truncated. The list can be
-- truncated if the number of multipart uploads exceeds the limit allowed
-- or specified by max uploads.
--
-- 'keyMarker', 'listMultipartUploadsResponse_keyMarker' - The key at or after which the listing began.
--
-- 'maxUploads', 'listMultipartUploadsResponse_maxUploads' - Maximum number of multipart uploads that could have been included in the
-- response.
--
-- 'nextKeyMarker', 'listMultipartUploadsResponse_nextKeyMarker' - When a list is truncated, this element specifies the value that should
-- be used for the key-marker request parameter in a subsequent request.
--
-- 'nextUploadIdMarker', 'listMultipartUploadsResponse_nextUploadIdMarker' - When a list is truncated, this element specifies the value that should
-- be used for the @upload-id-marker@ request parameter in a subsequent
-- request.
--
-- 'prefix', 'listMultipartUploadsResponse_prefix' - When a prefix is provided in the request, this field contains the
-- specified prefix. The result contains only keys starting with the
-- specified prefix.
--
-- 'uploadIdMarker', 'listMultipartUploadsResponse_uploadIdMarker' - Upload ID after which listing began.
--
-- 'uploads', 'listMultipartUploadsResponse_uploads' - Container for elements related to a particular multipart upload. A
-- response can contain zero or more @Upload@ elements.
--
-- 'httpStatus', 'listMultipartUploadsResponse_httpStatus' - The response's http status code.
newListMultipartUploadsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListMultipartUploadsResponse
newListMultipartUploadsResponse :: Int -> ListMultipartUploadsResponse
newListMultipartUploadsResponse Int
pHttpStatus_ =
  ListMultipartUploadsResponse'
    { $sel:bucket:ListMultipartUploadsResponse' :: Maybe BucketName
bucket =
        forall a. Maybe a
Prelude.Nothing,
      $sel:commonPrefixes:ListMultipartUploadsResponse' :: Maybe [CommonPrefix]
commonPrefixes = forall a. Maybe a
Prelude.Nothing,
      $sel:delimiter:ListMultipartUploadsResponse' :: Maybe Delimiter
delimiter = forall a. Maybe a
Prelude.Nothing,
      $sel:encodingType:ListMultipartUploadsResponse' :: Maybe EncodingType
encodingType = forall a. Maybe a
Prelude.Nothing,
      $sel:isTruncated:ListMultipartUploadsResponse' :: Maybe Bool
isTruncated = forall a. Maybe a
Prelude.Nothing,
      $sel:keyMarker:ListMultipartUploadsResponse' :: Maybe Text
keyMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxUploads:ListMultipartUploadsResponse' :: Maybe Int
maxUploads = forall a. Maybe a
Prelude.Nothing,
      $sel:nextKeyMarker:ListMultipartUploadsResponse' :: Maybe Text
nextKeyMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:nextUploadIdMarker:ListMultipartUploadsResponse' :: Maybe Text
nextUploadIdMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:prefix:ListMultipartUploadsResponse' :: Maybe Text
prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:uploadIdMarker:ListMultipartUploadsResponse' :: Maybe Text
uploadIdMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:uploads:ListMultipartUploadsResponse' :: Maybe [MultipartUpload]
uploads = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListMultipartUploadsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | 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.
listMultipartUploadsResponse_bucket :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe BucketName)
listMultipartUploadsResponse_bucket :: Lens' ListMultipartUploadsResponse (Maybe BucketName)
listMultipartUploadsResponse_bucket = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe BucketName
bucket :: Maybe BucketName
$sel:bucket:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe BucketName
bucket} -> Maybe BucketName
bucket) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe BucketName
a -> ListMultipartUploadsResponse
s {$sel:bucket:ListMultipartUploadsResponse' :: Maybe BucketName
bucket = Maybe BucketName
a} :: ListMultipartUploadsResponse)

-- | If you specify a delimiter in the request, then the result returns each
-- distinct key prefix containing the delimiter in a @CommonPrefixes@
-- element. The distinct key prefixes are returned in the @Prefix@ child
-- element.
listMultipartUploadsResponse_commonPrefixes :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe [CommonPrefix])
listMultipartUploadsResponse_commonPrefixes :: Lens' ListMultipartUploadsResponse (Maybe [CommonPrefix])
listMultipartUploadsResponse_commonPrefixes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe [CommonPrefix]
commonPrefixes :: Maybe [CommonPrefix]
$sel:commonPrefixes:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe [CommonPrefix]
commonPrefixes} -> Maybe [CommonPrefix]
commonPrefixes) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe [CommonPrefix]
a -> ListMultipartUploadsResponse
s {$sel:commonPrefixes:ListMultipartUploadsResponse' :: Maybe [CommonPrefix]
commonPrefixes = Maybe [CommonPrefix]
a} :: ListMultipartUploadsResponse) 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

-- | Contains the delimiter you specified in the request. If you don\'t
-- specify a delimiter in your request, this element is absent from the
-- response.
listMultipartUploadsResponse_delimiter :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe Delimiter)
listMultipartUploadsResponse_delimiter :: Lens' ListMultipartUploadsResponse (Maybe Delimiter)
listMultipartUploadsResponse_delimiter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe Delimiter
delimiter :: Maybe Delimiter
$sel:delimiter:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Delimiter
delimiter} -> Maybe Delimiter
delimiter) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe Delimiter
a -> ListMultipartUploadsResponse
s {$sel:delimiter:ListMultipartUploadsResponse' :: Maybe Delimiter
delimiter = Maybe Delimiter
a} :: ListMultipartUploadsResponse)

-- | Encoding type used by Amazon S3 to encode object keys in the response.
--
-- If you specify @encoding-type@ request parameter, Amazon S3 includes
-- this element in the response, and returns encoded key name values in the
-- following response elements:
--
-- @Delimiter@, @KeyMarker@, @Prefix@, @NextKeyMarker@, @Key@.
listMultipartUploadsResponse_encodingType :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe EncodingType)
listMultipartUploadsResponse_encodingType :: Lens' ListMultipartUploadsResponse (Maybe EncodingType)
listMultipartUploadsResponse_encodingType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe EncodingType
encodingType :: Maybe EncodingType
$sel:encodingType:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe EncodingType
encodingType} -> Maybe EncodingType
encodingType) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe EncodingType
a -> ListMultipartUploadsResponse
s {$sel:encodingType:ListMultipartUploadsResponse' :: Maybe EncodingType
encodingType = Maybe EncodingType
a} :: ListMultipartUploadsResponse)

-- | Indicates whether the returned list of multipart uploads is truncated. A
-- value of true indicates that the list was truncated. The list can be
-- truncated if the number of multipart uploads exceeds the limit allowed
-- or specified by max uploads.
listMultipartUploadsResponse_isTruncated :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe Prelude.Bool)
listMultipartUploadsResponse_isTruncated :: Lens' ListMultipartUploadsResponse (Maybe Bool)
listMultipartUploadsResponse_isTruncated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe Bool
isTruncated :: Maybe Bool
$sel:isTruncated:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Bool
isTruncated} -> Maybe Bool
isTruncated) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe Bool
a -> ListMultipartUploadsResponse
s {$sel:isTruncated:ListMultipartUploadsResponse' :: Maybe Bool
isTruncated = Maybe Bool
a} :: ListMultipartUploadsResponse)

-- | The key at or after which the listing began.
listMultipartUploadsResponse_keyMarker :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe Prelude.Text)
listMultipartUploadsResponse_keyMarker :: Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_keyMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe Text
keyMarker :: Maybe Text
$sel:keyMarker:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
keyMarker} -> Maybe Text
keyMarker) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe Text
a -> ListMultipartUploadsResponse
s {$sel:keyMarker:ListMultipartUploadsResponse' :: Maybe Text
keyMarker = Maybe Text
a} :: ListMultipartUploadsResponse)

-- | Maximum number of multipart uploads that could have been included in the
-- response.
listMultipartUploadsResponse_maxUploads :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe Prelude.Int)
listMultipartUploadsResponse_maxUploads :: Lens' ListMultipartUploadsResponse (Maybe Int)
listMultipartUploadsResponse_maxUploads = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe Int
maxUploads :: Maybe Int
$sel:maxUploads:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Int
maxUploads} -> Maybe Int
maxUploads) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe Int
a -> ListMultipartUploadsResponse
s {$sel:maxUploads:ListMultipartUploadsResponse' :: Maybe Int
maxUploads = Maybe Int
a} :: ListMultipartUploadsResponse)

-- | When a list is truncated, this element specifies the value that should
-- be used for the key-marker request parameter in a subsequent request.
listMultipartUploadsResponse_nextKeyMarker :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe Prelude.Text)
listMultipartUploadsResponse_nextKeyMarker :: Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_nextKeyMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe Text
nextKeyMarker :: Maybe Text
$sel:nextKeyMarker:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
nextKeyMarker} -> Maybe Text
nextKeyMarker) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe Text
a -> ListMultipartUploadsResponse
s {$sel:nextKeyMarker:ListMultipartUploadsResponse' :: Maybe Text
nextKeyMarker = Maybe Text
a} :: ListMultipartUploadsResponse)

-- | When a list is truncated, this element specifies the value that should
-- be used for the @upload-id-marker@ request parameter in a subsequent
-- request.
listMultipartUploadsResponse_nextUploadIdMarker :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe Prelude.Text)
listMultipartUploadsResponse_nextUploadIdMarker :: Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_nextUploadIdMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe Text
nextUploadIdMarker :: Maybe Text
$sel:nextUploadIdMarker:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
nextUploadIdMarker} -> Maybe Text
nextUploadIdMarker) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe Text
a -> ListMultipartUploadsResponse
s {$sel:nextUploadIdMarker:ListMultipartUploadsResponse' :: Maybe Text
nextUploadIdMarker = Maybe Text
a} :: ListMultipartUploadsResponse)

-- | When a prefix is provided in the request, this field contains the
-- specified prefix. The result contains only keys starting with the
-- specified prefix.
listMultipartUploadsResponse_prefix :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe Prelude.Text)
listMultipartUploadsResponse_prefix :: Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe Text
prefix :: Maybe Text
$sel:prefix:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
prefix} -> Maybe Text
prefix) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe Text
a -> ListMultipartUploadsResponse
s {$sel:prefix:ListMultipartUploadsResponse' :: Maybe Text
prefix = Maybe Text
a} :: ListMultipartUploadsResponse)

-- | Upload ID after which listing began.
listMultipartUploadsResponse_uploadIdMarker :: Lens.Lens' ListMultipartUploadsResponse (Prelude.Maybe Prelude.Text)
listMultipartUploadsResponse_uploadIdMarker :: Lens' ListMultipartUploadsResponse (Maybe Text)
listMultipartUploadsResponse_uploadIdMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMultipartUploadsResponse' {Maybe Text
uploadIdMarker :: Maybe Text
$sel:uploadIdMarker:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
uploadIdMarker} -> Maybe Text
uploadIdMarker) (\s :: ListMultipartUploadsResponse
s@ListMultipartUploadsResponse' {} Maybe Text
a -> ListMultipartUploadsResponse
s {$sel:uploadIdMarker:ListMultipartUploadsResponse' :: Maybe Text
uploadIdMarker = Maybe Text
a} :: ListMultipartUploadsResponse)

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

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

instance Prelude.NFData ListMultipartUploadsResponse where
  rnf :: ListMultipartUploadsResponse -> ()
rnf ListMultipartUploadsResponse' {Int
Maybe Bool
Maybe Delimiter
Maybe Int
Maybe [CommonPrefix]
Maybe [MultipartUpload]
Maybe Text
Maybe BucketName
Maybe EncodingType
httpStatus :: Int
uploads :: Maybe [MultipartUpload]
uploadIdMarker :: Maybe Text
prefix :: Maybe Text
nextUploadIdMarker :: Maybe Text
nextKeyMarker :: Maybe Text
maxUploads :: Maybe Int
keyMarker :: Maybe Text
isTruncated :: Maybe Bool
encodingType :: Maybe EncodingType
delimiter :: Maybe Delimiter
commonPrefixes :: Maybe [CommonPrefix]
bucket :: Maybe BucketName
$sel:httpStatus:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Int
$sel:uploads:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe [MultipartUpload]
$sel:uploadIdMarker:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
$sel:prefix:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
$sel:nextUploadIdMarker:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
$sel:nextKeyMarker:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
$sel:maxUploads:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Int
$sel:keyMarker:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Text
$sel:isTruncated:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Bool
$sel:encodingType:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe EncodingType
$sel:delimiter:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe Delimiter
$sel:commonPrefixes:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe [CommonPrefix]
$sel:bucket:ListMultipartUploadsResponse' :: ListMultipartUploadsResponse -> Maybe BucketName
..} =
    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 [CommonPrefix]
commonPrefixes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Delimiter
delimiter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncodingType
encodingType
      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 Text
keyMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxUploads
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextKeyMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextUploadIdMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
uploadIdMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [MultipartUpload]
uploads
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus