{-# 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.CreateMultipartUpload
-- 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 initiates a multipart upload and returns an upload ID. This
-- upload ID is used to associate all of the parts in the specific
-- multipart upload. You specify this upload ID in each of your subsequent
-- upload part requests (see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPart.html UploadPart>).
-- You also include this upload ID in the final request to either complete
-- or abort the multipart upload request.
--
-- For more information about multipart uploads, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/mpuoverview.html Multipart Upload Overview>.
--
-- If you have configured a lifecycle rule to abort incomplete multipart
-- uploads, the upload must complete within the number of days specified in
-- the bucket lifecycle configuration. Otherwise, the incomplete multipart
-- upload becomes eligible for an abort action and Amazon S3 aborts the
-- multipart upload. 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>.
--
-- For information about the permissions required to use the multipart
-- upload API, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/mpuAndPermissions.html Multipart Upload and Permissions>.
--
-- For request signing, multipart upload is just a series of regular
-- requests. You initiate a multipart upload, send one or more requests to
-- upload parts, and then complete the multipart upload process. You sign
-- each request individually. There is nothing special about signing
-- multipart upload requests. For more information about signing, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/sig-v4-authenticating-requests.html Authenticating Requests (Amazon Web Services Signature Version 4)>.
--
-- After you initiate a multipart upload and upload one or more parts, to
-- stop being charged for storing the uploaded parts, you must either
-- complete or abort the multipart upload. Amazon S3 frees up the space
-- used to store the parts and stop charging you for storing them only
-- after you either complete or abort a multipart upload.
--
-- You can optionally request server-side encryption. For server-side
-- encryption, Amazon S3 encrypts your data as it writes it to disks in its
-- data centers and decrypts it when you access it. You can provide your
-- own encryption key, or use Amazon Web Services KMS keys or Amazon
-- S3-managed encryption keys. If you choose to provide your own encryption
-- key, the request headers you provide in
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPart.html UploadPart>
-- and
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPartCopy.html UploadPartCopy>
-- requests must match the headers you used in the request to initiate the
-- upload by using @CreateMultipartUpload@.
--
-- To perform a multipart upload with encryption using an Amazon Web
-- Services KMS key, the requester must have permission to the
-- @kms:Decrypt@ and @kms:GenerateDataKey*@ actions on the key. These
-- permissions are required because Amazon S3 must decrypt and read data
-- from the encrypted file parts before it completes the multipart upload.
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/mpuoverview.html#mpuAndPermissions Multipart upload API and permissions>
-- in the /Amazon S3 User Guide/.
--
-- If your Identity and Access Management (IAM) user or role is in the same
-- Amazon Web Services account as the KMS key, then you must have these
-- permissions on the key policy. If your IAM user or role belongs to a
-- different account than the key, then you must have the permissions on
-- both the key policy and your IAM user or role.
--
-- For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/serv-side-encryption.html Protecting Data Using Server-Side Encryption>.
--
-- [Access Permissions]
--     When copying an object, you can optionally specify the accounts or
--     groups that should be granted specific permissions on the new
--     object. There are two ways to grant the permissions using the
--     request headers:
--
--     -   Specify a canned ACL with the @x-amz-acl@ request header. For
--         more information, see
--         <https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#CannedACL Canned ACL>.
--
--     -   Specify access permissions explicitly with the
--         @x-amz-grant-read@, @x-amz-grant-read-acp@,
--         @x-amz-grant-write-acp@, and @x-amz-grant-full-control@ headers.
--         These parameters map to the set of permissions that Amazon S3
--         supports in an ACL. For more information, see
--         <https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html Access Control List (ACL) Overview>.
--
--     You can use either a canned ACL or specify access permissions
--     explicitly. You cannot do both.
--
-- [Server-Side- Encryption-Specific Request Headers]
--     You can optionally tell Amazon S3 to encrypt data at rest using
--     server-side encryption. Server-side encryption is for data
--     encryption at rest. Amazon S3 encrypts your data as it writes it to
--     disks in its data centers and decrypts it when you access it. The
--     option you use depends on whether you want to use Amazon Web
--     Services managed encryption keys or provide your own encryption key.
--
--     -   Use encryption keys managed by Amazon S3 or customer managed key
--         stored in Amazon Web Services Key Management Service (Amazon Web
--         Services KMS) – If you want Amazon Web Services to manage the
--         keys used to encrypt data, specify the following headers in the
--         request.
--
--         -   @x-amz-server-side-encryption@
--
--         -   @x-amz-server-side-encryption-aws-kms-key-id@
--
--         -   @x-amz-server-side-encryption-context@
--
--         If you specify @x-amz-server-side-encryption:aws:kms@, but
--         don\'t provide @x-amz-server-side-encryption-aws-kms-key-id@,
--         Amazon S3 uses the Amazon Web Services managed key in Amazon Web
--         Services KMS to protect the data.
--
--         All GET and PUT requests for an object protected by Amazon Web
--         Services KMS fail if you don\'t make them with SSL or by using
--         SigV4.
--
--         For more information about server-side encryption with KMS key
--         (SSE-KMS), see
--         <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingKMSEncryption.html Protecting Data Using Server-Side Encryption with KMS keys>.
--
--     -   Use customer-provided encryption keys – If you want to manage
--         your own encryption keys, provide all the following headers in
--         the request.
--
--         -   @x-amz-server-side-encryption-customer-algorithm@
--
--         -   @x-amz-server-side-encryption-customer-key@
--
--         -   @x-amz-server-side-encryption-customer-key-MD5@
--
--         For more information about server-side encryption with KMS keys
--         (SSE-KMS), see
--         <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingKMSEncryption.html Protecting Data Using Server-Side Encryption with KMS keys>.
--
-- [Access-Control-List (ACL)-Specific Request Headers]
--     You also can use the following access control–related headers with
--     this operation. By default, all objects are private. Only the owner
--     has full access control. When adding a new object, you can grant
--     permissions to individual Amazon Web Services accounts or to
--     predefined groups defined by Amazon S3. These permissions are then
--     added to the access control list (ACL) on the object. For more
--     information, see
--     <https://docs.aws.amazon.com/AmazonS3/latest/dev/S3_ACLs_UsingACLs.html Using ACLs>.
--     With this operation, you can grant access permissions using one of
--     the following two methods:
--
--     -   Specify a canned ACL (@x-amz-acl@) — Amazon S3 supports a set of
--         predefined ACLs, known as /canned ACLs/. Each canned ACL has a
--         predefined set of grantees and permissions. For more
--         information, see
--         <https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html#CannedACL Canned ACL>.
--
--     -   Specify access permissions explicitly — To explicitly grant
--         access permissions to specific Amazon Web Services accounts or
--         groups, use the following headers. Each header maps to specific
--         permissions that Amazon S3 supports in an ACL. For more
--         information, see
--         <https://docs.aws.amazon.com/AmazonS3/latest/dev/acl-overview.html Access Control List (ACL) Overview>.
--         In the header, you specify a list of grantees who get the
--         specific permission. To grant permissions explicitly, use:
--
--         -   @x-amz-grant-read@
--
--         -   @x-amz-grant-write@
--
--         -   @x-amz-grant-read-acp@
--
--         -   @x-amz-grant-write-acp@
--
--         -   @x-amz-grant-full-control@
--
--         You specify each grantee as a type=value pair, where the type is
--         one of the following:
--
--         -   @id@ – if the value specified is the canonical user ID of an
--             Amazon Web Services account
--
--         -   @uri@ – if you are granting permissions to a predefined
--             group
--
--         -   @emailAddress@ – if the value specified is the email address
--             of an Amazon Web Services account
--
--             Using email addresses to specify a grantee is only supported
--             in the following Amazon Web Services Regions:
--
--             -   US East (N. Virginia)
--
--             -   US West (N. California)
--
--             -   US West (Oregon)
--
--             -   Asia Pacific (Singapore)
--
--             -   Asia Pacific (Sydney)
--
--             -   Asia Pacific (Tokyo)
--
--             -   Europe (Ireland)
--
--             -   South America (São Paulo)
--
--             For a list of all the Amazon S3 supported Regions and
--             endpoints, see
--             <https://docs.aws.amazon.com/general/latest/gr/rande.html#s3_region Regions and Endpoints>
--             in the Amazon Web Services General Reference.
--
--         For example, the following @x-amz-grant-read@ header grants the
--         Amazon Web Services accounts identified by account IDs
--         permissions to read object data and its metadata:
--
--         @x-amz-grant-read: id=\"11112222333\", id=\"444455556666\" @
--
-- The following operations are related to @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_ListParts.html ListParts>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_ListMultipartUploads.html ListMultipartUploads>
module Amazonka.S3.CreateMultipartUpload
  ( -- * Creating a Request
    CreateMultipartUpload (..),
    newCreateMultipartUpload,

    -- * Request Lenses
    createMultipartUpload_acl,
    createMultipartUpload_bucketKeyEnabled,
    createMultipartUpload_cacheControl,
    createMultipartUpload_checksumAlgorithm,
    createMultipartUpload_contentDisposition,
    createMultipartUpload_contentEncoding,
    createMultipartUpload_contentLanguage,
    createMultipartUpload_contentType,
    createMultipartUpload_expectedBucketOwner,
    createMultipartUpload_expires,
    createMultipartUpload_grantFullControl,
    createMultipartUpload_grantRead,
    createMultipartUpload_grantReadACP,
    createMultipartUpload_grantWriteACP,
    createMultipartUpload_metadata,
    createMultipartUpload_objectLockLegalHoldStatus,
    createMultipartUpload_objectLockMode,
    createMultipartUpload_objectLockRetainUntilDate,
    createMultipartUpload_requestPayer,
    createMultipartUpload_sSECustomerAlgorithm,
    createMultipartUpload_sSECustomerKey,
    createMultipartUpload_sSECustomerKeyMD5,
    createMultipartUpload_sSEKMSEncryptionContext,
    createMultipartUpload_sSEKMSKeyId,
    createMultipartUpload_serverSideEncryption,
    createMultipartUpload_storageClass,
    createMultipartUpload_tagging,
    createMultipartUpload_websiteRedirectLocation,
    createMultipartUpload_bucket,
    createMultipartUpload_key,

    -- * Destructuring the Response
    CreateMultipartUploadResponse (..),
    newCreateMultipartUploadResponse,

    -- * Response Lenses
    createMultipartUploadResponse_abortDate,
    createMultipartUploadResponse_abortRuleId,
    createMultipartUploadResponse_bucket,
    createMultipartUploadResponse_bucketKeyEnabled,
    createMultipartUploadResponse_checksumAlgorithm,
    createMultipartUploadResponse_key,
    createMultipartUploadResponse_requestCharged,
    createMultipartUploadResponse_sSECustomerAlgorithm,
    createMultipartUploadResponse_sSECustomerKeyMD5,
    createMultipartUploadResponse_sSEKMSEncryptionContext,
    createMultipartUploadResponse_sSEKMSKeyId,
    createMultipartUploadResponse_serverSideEncryption,
    createMultipartUploadResponse_httpStatus,
    createMultipartUploadResponse_uploadId,
  )
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:/ 'newCreateMultipartUpload' smart constructor.
data CreateMultipartUpload = CreateMultipartUpload'
  { -- | The canned ACL to apply to the object.
    --
    -- This action is not supported by Amazon S3 on Outposts.
    CreateMultipartUpload -> Maybe ObjectCannedACL
acl :: Prelude.Maybe ObjectCannedACL,
    -- | Specifies whether Amazon S3 should use an S3 Bucket Key for object
    -- encryption with server-side encryption using AWS KMS (SSE-KMS). Setting
    -- this header to @true@ causes Amazon S3 to use an S3 Bucket Key for
    -- object encryption with SSE-KMS.
    --
    -- Specifying this header with an object action doesn’t affect bucket-level
    -- settings for S3 Bucket Key.
    CreateMultipartUpload -> Maybe Bool
bucketKeyEnabled :: Prelude.Maybe Prelude.Bool,
    -- | Specifies caching behavior along the request\/reply chain.
    CreateMultipartUpload -> Maybe Text
cacheControl :: Prelude.Maybe Prelude.Text,
    -- | Indicates the algorithm you want Amazon S3 to use to create the checksum
    -- for the object. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
    -- in the /Amazon S3 User Guide/.
    CreateMultipartUpload -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | Specifies presentational information for the object.
    CreateMultipartUpload -> Maybe Text
contentDisposition :: Prelude.Maybe Prelude.Text,
    -- | Specifies what content encodings have been applied to the object and
    -- thus what decoding mechanisms must be applied to obtain the media-type
    -- referenced by the Content-Type header field.
    CreateMultipartUpload -> Maybe Text
contentEncoding :: Prelude.Maybe Prelude.Text,
    -- | The language the content is in.
    CreateMultipartUpload -> Maybe Text
contentLanguage :: Prelude.Maybe Prelude.Text,
    -- | A standard MIME type describing the format of the object data.
    CreateMultipartUpload -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The account ID of the expected bucket owner. If the bucket is owned by a
    -- different account, the request fails with the HTTP status code
    -- @403 Forbidden@ (access denied).
    CreateMultipartUpload -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | The date and time at which the object is no longer cacheable.
    CreateMultipartUpload -> Maybe RFC822
expires :: Prelude.Maybe Data.RFC822,
    -- | Gives the grantee READ, READ_ACP, and WRITE_ACP permissions on the
    -- object.
    --
    -- This action is not supported by Amazon S3 on Outposts.
    CreateMultipartUpload -> Maybe Text
grantFullControl :: Prelude.Maybe Prelude.Text,
    -- | Allows grantee to read the object data and its metadata.
    --
    -- This action is not supported by Amazon S3 on Outposts.
    CreateMultipartUpload -> Maybe Text
grantRead :: Prelude.Maybe Prelude.Text,
    -- | Allows grantee to read the object ACL.
    --
    -- This action is not supported by Amazon S3 on Outposts.
    CreateMultipartUpload -> Maybe Text
grantReadACP :: Prelude.Maybe Prelude.Text,
    -- | Allows grantee to write the ACL for the applicable object.
    --
    -- This action is not supported by Amazon S3 on Outposts.
    CreateMultipartUpload -> Maybe Text
grantWriteACP :: Prelude.Maybe Prelude.Text,
    -- | A map of metadata to store with the object in S3.
    CreateMultipartUpload -> HashMap Text Text
metadata :: Prelude.HashMap Prelude.Text Prelude.Text,
    -- | Specifies whether you want to apply a legal hold to the uploaded object.
    CreateMultipartUpload -> Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus :: Prelude.Maybe ObjectLockLegalHoldStatus,
    -- | Specifies the Object Lock mode that you want to apply to the uploaded
    -- object.
    CreateMultipartUpload -> Maybe ObjectLockMode
objectLockMode :: Prelude.Maybe ObjectLockMode,
    -- | Specifies the date and time when you want the Object Lock to expire.
    CreateMultipartUpload -> Maybe ISO8601
objectLockRetainUntilDate :: Prelude.Maybe Data.ISO8601,
    CreateMultipartUpload -> Maybe RequestPayer
requestPayer :: Prelude.Maybe RequestPayer,
    -- | Specifies the algorithm to use to when encrypting the object (for
    -- example, AES256).
    CreateMultipartUpload -> Maybe Text
sSECustomerAlgorithm :: Prelude.Maybe Prelude.Text,
    -- | Specifies the customer-provided encryption key for Amazon S3 to use in
    -- encrypting data. This value is used to store the object and then it is
    -- discarded; Amazon S3 does not store the encryption key. The key must be
    -- appropriate for use with the algorithm specified in the
    -- @x-amz-server-side-encryption-customer-algorithm@ header.
    CreateMultipartUpload -> Maybe (Sensitive Text)
sSECustomerKey :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Specifies the 128-bit MD5 digest of the encryption key according to RFC
    -- 1321. Amazon S3 uses this header for a message integrity check to ensure
    -- that the encryption key was transmitted without error.
    CreateMultipartUpload -> Maybe Text
sSECustomerKeyMD5 :: Prelude.Maybe Prelude.Text,
    -- | Specifies the Amazon Web Services KMS Encryption Context to use for
    -- object encryption. The value of this header is a base64-encoded UTF-8
    -- string holding JSON with the encryption context key-value pairs.
    CreateMultipartUpload -> Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | Specifies the ID of the symmetric customer managed key to use for object
    -- encryption. All GET and PUT requests for an object protected by Amazon
    -- Web Services KMS will fail if not made via SSL or using SigV4. For
    -- information about configuring using any of the officially supported
    -- Amazon Web Services SDKs and Amazon Web Services CLI, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingAWSSDK.html#specify-signature-version Specifying the Signature Version in Request Authentication>
    -- in the /Amazon S3 User Guide/.
    CreateMultipartUpload -> Maybe (Sensitive Text)
sSEKMSKeyId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The server-side encryption algorithm used when storing this object in
    -- Amazon S3 (for example, AES256, aws:kms).
    CreateMultipartUpload -> Maybe ServerSideEncryption
serverSideEncryption :: Prelude.Maybe ServerSideEncryption,
    -- | By default, Amazon S3 uses the STANDARD Storage Class to store newly
    -- created objects. The STANDARD storage class provides high durability and
    -- high availability. Depending on performance needs, you can specify a
    -- different Storage Class. Amazon S3 on Outposts only uses the OUTPOSTS
    -- Storage Class. For more information, see
    -- <https://docs.aws.amazon.com/AmazonS3/latest/dev/storage-class-intro.html Storage Classes>
    -- in the /Amazon S3 User Guide/.
    CreateMultipartUpload -> Maybe StorageClass
storageClass :: Prelude.Maybe StorageClass,
    -- | The tag-set for the object. The tag-set must be encoded as URL Query
    -- parameters.
    CreateMultipartUpload -> Maybe Text
tagging :: Prelude.Maybe Prelude.Text,
    -- | If the bucket is configured as a website, redirects requests for this
    -- object to another object in the same bucket or to an external URL.
    -- Amazon S3 stores the value of this header in the object metadata.
    CreateMultipartUpload -> Maybe Text
websiteRedirectLocation :: Prelude.Maybe Prelude.Text,
    -- | The name of the bucket to which to initiate the upload
    --
    -- 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/.
    CreateMultipartUpload -> BucketName
bucket :: BucketName,
    -- | Object key for which the multipart upload is to be initiated.
    CreateMultipartUpload -> ObjectKey
key :: ObjectKey
  }
  deriving (CreateMultipartUpload -> CreateMultipartUpload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMultipartUpload -> CreateMultipartUpload -> Bool
$c/= :: CreateMultipartUpload -> CreateMultipartUpload -> Bool
== :: CreateMultipartUpload -> CreateMultipartUpload -> Bool
$c== :: CreateMultipartUpload -> CreateMultipartUpload -> Bool
Prelude.Eq, Int -> CreateMultipartUpload -> ShowS
[CreateMultipartUpload] -> ShowS
CreateMultipartUpload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMultipartUpload] -> ShowS
$cshowList :: [CreateMultipartUpload] -> ShowS
show :: CreateMultipartUpload -> String
$cshow :: CreateMultipartUpload -> String
showsPrec :: Int -> CreateMultipartUpload -> ShowS
$cshowsPrec :: Int -> CreateMultipartUpload -> ShowS
Prelude.Show, forall x. Rep CreateMultipartUpload x -> CreateMultipartUpload
forall x. CreateMultipartUpload -> Rep CreateMultipartUpload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMultipartUpload x -> CreateMultipartUpload
$cfrom :: forall x. CreateMultipartUpload -> Rep CreateMultipartUpload x
Prelude.Generic)

-- |
-- Create a value of 'CreateMultipartUpload' 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:
--
-- 'acl', 'createMultipartUpload_acl' - The canned ACL to apply to the object.
--
-- This action is not supported by Amazon S3 on Outposts.
--
-- 'bucketKeyEnabled', 'createMultipartUpload_bucketKeyEnabled' - Specifies whether Amazon S3 should use an S3 Bucket Key for object
-- encryption with server-side encryption using AWS KMS (SSE-KMS). Setting
-- this header to @true@ causes Amazon S3 to use an S3 Bucket Key for
-- object encryption with SSE-KMS.
--
-- Specifying this header with an object action doesn’t affect bucket-level
-- settings for S3 Bucket Key.
--
-- 'cacheControl', 'createMultipartUpload_cacheControl' - Specifies caching behavior along the request\/reply chain.
--
-- 'checksumAlgorithm', 'createMultipartUpload_checksumAlgorithm' - Indicates the algorithm you want Amazon S3 to use to create the checksum
-- for the object. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
-- in the /Amazon S3 User Guide/.
--
-- 'contentDisposition', 'createMultipartUpload_contentDisposition' - Specifies presentational information for the object.
--
-- 'contentEncoding', 'createMultipartUpload_contentEncoding' - Specifies what content encodings have been applied to the object and
-- thus what decoding mechanisms must be applied to obtain the media-type
-- referenced by the Content-Type header field.
--
-- 'contentLanguage', 'createMultipartUpload_contentLanguage' - The language the content is in.
--
-- 'contentType', 'createMultipartUpload_contentType' - A standard MIME type describing the format of the object data.
--
-- 'expectedBucketOwner', 'createMultipartUpload_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).
--
-- 'expires', 'createMultipartUpload_expires' - The date and time at which the object is no longer cacheable.
--
-- 'grantFullControl', 'createMultipartUpload_grantFullControl' - Gives the grantee READ, READ_ACP, and WRITE_ACP permissions on the
-- object.
--
-- This action is not supported by Amazon S3 on Outposts.
--
-- 'grantRead', 'createMultipartUpload_grantRead' - Allows grantee to read the object data and its metadata.
--
-- This action is not supported by Amazon S3 on Outposts.
--
-- 'grantReadACP', 'createMultipartUpload_grantReadACP' - Allows grantee to read the object ACL.
--
-- This action is not supported by Amazon S3 on Outposts.
--
-- 'grantWriteACP', 'createMultipartUpload_grantWriteACP' - Allows grantee to write the ACL for the applicable object.
--
-- This action is not supported by Amazon S3 on Outposts.
--
-- 'metadata', 'createMultipartUpload_metadata' - A map of metadata to store with the object in S3.
--
-- 'objectLockLegalHoldStatus', 'createMultipartUpload_objectLockLegalHoldStatus' - Specifies whether you want to apply a legal hold to the uploaded object.
--
-- 'objectLockMode', 'createMultipartUpload_objectLockMode' - Specifies the Object Lock mode that you want to apply to the uploaded
-- object.
--
-- 'objectLockRetainUntilDate', 'createMultipartUpload_objectLockRetainUntilDate' - Specifies the date and time when you want the Object Lock to expire.
--
-- 'requestPayer', 'createMultipartUpload_requestPayer' - Undocumented member.
--
-- 'sSECustomerAlgorithm', 'createMultipartUpload_sSECustomerAlgorithm' - Specifies the algorithm to use to when encrypting the object (for
-- example, AES256).
--
-- 'sSECustomerKey', 'createMultipartUpload_sSECustomerKey' - Specifies the customer-provided encryption key for Amazon S3 to use in
-- encrypting data. This value is used to store the object and then it is
-- discarded; Amazon S3 does not store the encryption key. The key must be
-- appropriate for use with the algorithm specified in the
-- @x-amz-server-side-encryption-customer-algorithm@ header.
--
-- 'sSECustomerKeyMD5', 'createMultipartUpload_sSECustomerKeyMD5' - Specifies the 128-bit MD5 digest of the encryption key according to RFC
-- 1321. Amazon S3 uses this header for a message integrity check to ensure
-- that the encryption key was transmitted without error.
--
-- 'sSEKMSEncryptionContext', 'createMultipartUpload_sSEKMSEncryptionContext' - Specifies the Amazon Web Services KMS Encryption Context to use for
-- object encryption. The value of this header is a base64-encoded UTF-8
-- string holding JSON with the encryption context key-value pairs.
--
-- 'sSEKMSKeyId', 'createMultipartUpload_sSEKMSKeyId' - Specifies the ID of the symmetric customer managed key to use for object
-- encryption. All GET and PUT requests for an object protected by Amazon
-- Web Services KMS will fail if not made via SSL or using SigV4. For
-- information about configuring using any of the officially supported
-- Amazon Web Services SDKs and Amazon Web Services CLI, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingAWSSDK.html#specify-signature-version Specifying the Signature Version in Request Authentication>
-- in the /Amazon S3 User Guide/.
--
-- 'serverSideEncryption', 'createMultipartUpload_serverSideEncryption' - The server-side encryption algorithm used when storing this object in
-- Amazon S3 (for example, AES256, aws:kms).
--
-- 'storageClass', 'createMultipartUpload_storageClass' - By default, Amazon S3 uses the STANDARD Storage Class to store newly
-- created objects. The STANDARD storage class provides high durability and
-- high availability. Depending on performance needs, you can specify a
-- different Storage Class. Amazon S3 on Outposts only uses the OUTPOSTS
-- Storage Class. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/storage-class-intro.html Storage Classes>
-- in the /Amazon S3 User Guide/.
--
-- 'tagging', 'createMultipartUpload_tagging' - The tag-set for the object. The tag-set must be encoded as URL Query
-- parameters.
--
-- 'websiteRedirectLocation', 'createMultipartUpload_websiteRedirectLocation' - If the bucket is configured as a website, redirects requests for this
-- object to another object in the same bucket or to an external URL.
-- Amazon S3 stores the value of this header in the object metadata.
--
-- 'bucket', 'createMultipartUpload_bucket' - The name of the bucket to which to initiate the upload
--
-- 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', 'createMultipartUpload_key' - Object key for which the multipart upload is to be initiated.
newCreateMultipartUpload ::
  -- | 'bucket'
  BucketName ->
  -- | 'key'
  ObjectKey ->
  CreateMultipartUpload
newCreateMultipartUpload :: BucketName -> ObjectKey -> CreateMultipartUpload
newCreateMultipartUpload BucketName
pBucket_ ObjectKey
pKey_ =
  CreateMultipartUpload'
    { $sel:acl:CreateMultipartUpload' :: Maybe ObjectCannedACL
acl = forall a. Maybe a
Prelude.Nothing,
      $sel:bucketKeyEnabled:CreateMultipartUpload' :: Maybe Bool
bucketKeyEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:cacheControl:CreateMultipartUpload' :: Maybe Text
cacheControl = forall a. Maybe a
Prelude.Nothing,
      $sel:checksumAlgorithm:CreateMultipartUpload' :: Maybe ChecksumAlgorithm
checksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:contentDisposition:CreateMultipartUpload' :: Maybe Text
contentDisposition = forall a. Maybe a
Prelude.Nothing,
      $sel:contentEncoding:CreateMultipartUpload' :: Maybe Text
contentEncoding = forall a. Maybe a
Prelude.Nothing,
      $sel:contentLanguage:CreateMultipartUpload' :: Maybe Text
contentLanguage = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:CreateMultipartUpload' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:expectedBucketOwner:CreateMultipartUpload' :: Maybe Text
expectedBucketOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:expires:CreateMultipartUpload' :: Maybe RFC822
expires = forall a. Maybe a
Prelude.Nothing,
      $sel:grantFullControl:CreateMultipartUpload' :: Maybe Text
grantFullControl = forall a. Maybe a
Prelude.Nothing,
      $sel:grantRead:CreateMultipartUpload' :: Maybe Text
grantRead = forall a. Maybe a
Prelude.Nothing,
      $sel:grantReadACP:CreateMultipartUpload' :: Maybe Text
grantReadACP = forall a. Maybe a
Prelude.Nothing,
      $sel:grantWriteACP:CreateMultipartUpload' :: Maybe Text
grantWriteACP = forall a. Maybe a
Prelude.Nothing,
      $sel:metadata:CreateMultipartUpload' :: HashMap Text Text
metadata = forall a. Monoid a => a
Prelude.mempty,
      $sel:objectLockLegalHoldStatus:CreateMultipartUpload' :: Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:objectLockMode:CreateMultipartUpload' :: Maybe ObjectLockMode
objectLockMode = forall a. Maybe a
Prelude.Nothing,
      $sel:objectLockRetainUntilDate:CreateMultipartUpload' :: Maybe ISO8601
objectLockRetainUntilDate = forall a. Maybe a
Prelude.Nothing,
      $sel:requestPayer:CreateMultipartUpload' :: Maybe RequestPayer
requestPayer = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerAlgorithm:CreateMultipartUpload' :: Maybe Text
sSECustomerAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerKey:CreateMultipartUpload' :: Maybe (Sensitive Text)
sSECustomerKey = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerKeyMD5:CreateMultipartUpload' :: Maybe Text
sSECustomerKeyMD5 = forall a. Maybe a
Prelude.Nothing,
      $sel:sSEKMSEncryptionContext:CreateMultipartUpload' :: Maybe (Sensitive Text)
sSEKMSEncryptionContext = forall a. Maybe a
Prelude.Nothing,
      $sel:sSEKMSKeyId:CreateMultipartUpload' :: Maybe (Sensitive Text)
sSEKMSKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:serverSideEncryption:CreateMultipartUpload' :: Maybe ServerSideEncryption
serverSideEncryption = forall a. Maybe a
Prelude.Nothing,
      $sel:storageClass:CreateMultipartUpload' :: Maybe StorageClass
storageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:tagging:CreateMultipartUpload' :: Maybe Text
tagging = forall a. Maybe a
Prelude.Nothing,
      $sel:websiteRedirectLocation:CreateMultipartUpload' :: Maybe Text
websiteRedirectLocation = forall a. Maybe a
Prelude.Nothing,
      $sel:bucket:CreateMultipartUpload' :: BucketName
bucket = BucketName
pBucket_,
      $sel:key:CreateMultipartUpload' :: ObjectKey
key = ObjectKey
pKey_
    }

-- | The canned ACL to apply to the object.
--
-- This action is not supported by Amazon S3 on Outposts.
createMultipartUpload_acl :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe ObjectCannedACL)
createMultipartUpload_acl :: Lens' CreateMultipartUpload (Maybe ObjectCannedACL)
createMultipartUpload_acl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe ObjectCannedACL
acl :: Maybe ObjectCannedACL
$sel:acl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectCannedACL
acl} -> Maybe ObjectCannedACL
acl) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe ObjectCannedACL
a -> CreateMultipartUpload
s {$sel:acl:CreateMultipartUpload' :: Maybe ObjectCannedACL
acl = Maybe ObjectCannedACL
a} :: CreateMultipartUpload)

-- | Specifies whether Amazon S3 should use an S3 Bucket Key for object
-- encryption with server-side encryption using AWS KMS (SSE-KMS). Setting
-- this header to @true@ causes Amazon S3 to use an S3 Bucket Key for
-- object encryption with SSE-KMS.
--
-- Specifying this header with an object action doesn’t affect bucket-level
-- settings for S3 Bucket Key.
createMultipartUpload_bucketKeyEnabled :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Bool)
createMultipartUpload_bucketKeyEnabled :: Lens' CreateMultipartUpload (Maybe Bool)
createMultipartUpload_bucketKeyEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Bool
bucketKeyEnabled :: Maybe Bool
$sel:bucketKeyEnabled:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Bool
bucketKeyEnabled} -> Maybe Bool
bucketKeyEnabled) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Bool
a -> CreateMultipartUpload
s {$sel:bucketKeyEnabled:CreateMultipartUpload' :: Maybe Bool
bucketKeyEnabled = Maybe Bool
a} :: CreateMultipartUpload)

-- | Specifies caching behavior along the request\/reply chain.
createMultipartUpload_cacheControl :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_cacheControl :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_cacheControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
cacheControl :: Maybe Text
$sel:cacheControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
cacheControl} -> Maybe Text
cacheControl) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:cacheControl:CreateMultipartUpload' :: Maybe Text
cacheControl = Maybe Text
a} :: CreateMultipartUpload)

-- | Indicates the algorithm you want Amazon S3 to use to create the checksum
-- for the object. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/checking-object-integrity.html Checking object integrity>
-- in the /Amazon S3 User Guide/.
createMultipartUpload_checksumAlgorithm :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe ChecksumAlgorithm)
createMultipartUpload_checksumAlgorithm :: Lens' CreateMultipartUpload (Maybe ChecksumAlgorithm)
createMultipartUpload_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe ChecksumAlgorithm
checksumAlgorithm :: Maybe ChecksumAlgorithm
$sel:checksumAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ChecksumAlgorithm
checksumAlgorithm} -> Maybe ChecksumAlgorithm
checksumAlgorithm) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe ChecksumAlgorithm
a -> CreateMultipartUpload
s {$sel:checksumAlgorithm:CreateMultipartUpload' :: Maybe ChecksumAlgorithm
checksumAlgorithm = Maybe ChecksumAlgorithm
a} :: CreateMultipartUpload)

-- | Specifies presentational information for the object.
createMultipartUpload_contentDisposition :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_contentDisposition :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_contentDisposition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
contentDisposition :: Maybe Text
$sel:contentDisposition:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
contentDisposition} -> Maybe Text
contentDisposition) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:contentDisposition:CreateMultipartUpload' :: Maybe Text
contentDisposition = Maybe Text
a} :: CreateMultipartUpload)

-- | Specifies what content encodings have been applied to the object and
-- thus what decoding mechanisms must be applied to obtain the media-type
-- referenced by the Content-Type header field.
createMultipartUpload_contentEncoding :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_contentEncoding :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_contentEncoding = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
contentEncoding :: Maybe Text
$sel:contentEncoding:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
contentEncoding} -> Maybe Text
contentEncoding) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:contentEncoding:CreateMultipartUpload' :: Maybe Text
contentEncoding = Maybe Text
a} :: CreateMultipartUpload)

-- | The language the content is in.
createMultipartUpload_contentLanguage :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_contentLanguage :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_contentLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
contentLanguage :: Maybe Text
$sel:contentLanguage:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
contentLanguage} -> Maybe Text
contentLanguage) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:contentLanguage:CreateMultipartUpload' :: Maybe Text
contentLanguage = Maybe Text
a} :: CreateMultipartUpload)

-- | A standard MIME type describing the format of the object data.
createMultipartUpload_contentType :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_contentType :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
contentType :: Maybe Text
$sel:contentType:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:contentType:CreateMultipartUpload' :: Maybe Text
contentType = Maybe Text
a} :: CreateMultipartUpload)

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

-- | The date and time at which the object is no longer cacheable.
createMultipartUpload_expires :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.UTCTime)
createMultipartUpload_expires :: Lens' CreateMultipartUpload (Maybe UTCTime)
createMultipartUpload_expires = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe RFC822
expires :: Maybe RFC822
$sel:expires:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RFC822
expires} -> Maybe RFC822
expires) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe RFC822
a -> CreateMultipartUpload
s {$sel:expires:CreateMultipartUpload' :: Maybe RFC822
expires = Maybe RFC822
a} :: CreateMultipartUpload) 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

-- | Gives the grantee READ, READ_ACP, and WRITE_ACP permissions on the
-- object.
--
-- This action is not supported by Amazon S3 on Outposts.
createMultipartUpload_grantFullControl :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_grantFullControl :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_grantFullControl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
grantFullControl :: Maybe Text
$sel:grantFullControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
grantFullControl} -> Maybe Text
grantFullControl) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:grantFullControl:CreateMultipartUpload' :: Maybe Text
grantFullControl = Maybe Text
a} :: CreateMultipartUpload)

-- | Allows grantee to read the object data and its metadata.
--
-- This action is not supported by Amazon S3 on Outposts.
createMultipartUpload_grantRead :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_grantRead :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_grantRead = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
grantRead :: Maybe Text
$sel:grantRead:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
grantRead} -> Maybe Text
grantRead) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:grantRead:CreateMultipartUpload' :: Maybe Text
grantRead = Maybe Text
a} :: CreateMultipartUpload)

-- | Allows grantee to read the object ACL.
--
-- This action is not supported by Amazon S3 on Outposts.
createMultipartUpload_grantReadACP :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_grantReadACP :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_grantReadACP = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
grantReadACP :: Maybe Text
$sel:grantReadACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
grantReadACP} -> Maybe Text
grantReadACP) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:grantReadACP:CreateMultipartUpload' :: Maybe Text
grantReadACP = Maybe Text
a} :: CreateMultipartUpload)

-- | Allows grantee to write the ACL for the applicable object.
--
-- This action is not supported by Amazon S3 on Outposts.
createMultipartUpload_grantWriteACP :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_grantWriteACP :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_grantWriteACP = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
grantWriteACP :: Maybe Text
$sel:grantWriteACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
grantWriteACP} -> Maybe Text
grantWriteACP) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:grantWriteACP:CreateMultipartUpload' :: Maybe Text
grantWriteACP = Maybe Text
a} :: CreateMultipartUpload)

-- | A map of metadata to store with the object in S3.
createMultipartUpload_metadata :: Lens.Lens' CreateMultipartUpload (Prelude.HashMap Prelude.Text Prelude.Text)
createMultipartUpload_metadata :: Lens' CreateMultipartUpload (HashMap Text Text)
createMultipartUpload_metadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {HashMap Text Text
metadata :: HashMap Text Text
$sel:metadata:CreateMultipartUpload' :: CreateMultipartUpload -> HashMap Text Text
metadata} -> HashMap Text Text
metadata) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} HashMap Text Text
a -> CreateMultipartUpload
s {$sel:metadata:CreateMultipartUpload' :: HashMap Text Text
metadata = HashMap Text Text
a} :: CreateMultipartUpload) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Specifies whether you want to apply a legal hold to the uploaded object.
createMultipartUpload_objectLockLegalHoldStatus :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe ObjectLockLegalHoldStatus)
createMultipartUpload_objectLockLegalHoldStatus :: Lens' CreateMultipartUpload (Maybe ObjectLockLegalHoldStatus)
createMultipartUpload_objectLockLegalHoldStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus :: Maybe ObjectLockLegalHoldStatus
$sel:objectLockLegalHoldStatus:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus} -> Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe ObjectLockLegalHoldStatus
a -> CreateMultipartUpload
s {$sel:objectLockLegalHoldStatus:CreateMultipartUpload' :: Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus = Maybe ObjectLockLegalHoldStatus
a} :: CreateMultipartUpload)

-- | Specifies the Object Lock mode that you want to apply to the uploaded
-- object.
createMultipartUpload_objectLockMode :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe ObjectLockMode)
createMultipartUpload_objectLockMode :: Lens' CreateMultipartUpload (Maybe ObjectLockMode)
createMultipartUpload_objectLockMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe ObjectLockMode
objectLockMode :: Maybe ObjectLockMode
$sel:objectLockMode:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockMode
objectLockMode} -> Maybe ObjectLockMode
objectLockMode) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe ObjectLockMode
a -> CreateMultipartUpload
s {$sel:objectLockMode:CreateMultipartUpload' :: Maybe ObjectLockMode
objectLockMode = Maybe ObjectLockMode
a} :: CreateMultipartUpload)

-- | Specifies the date and time when you want the Object Lock to expire.
createMultipartUpload_objectLockRetainUntilDate :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.UTCTime)
createMultipartUpload_objectLockRetainUntilDate :: Lens' CreateMultipartUpload (Maybe UTCTime)
createMultipartUpload_objectLockRetainUntilDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe ISO8601
objectLockRetainUntilDate :: Maybe ISO8601
$sel:objectLockRetainUntilDate:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ISO8601
objectLockRetainUntilDate} -> Maybe ISO8601
objectLockRetainUntilDate) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe ISO8601
a -> CreateMultipartUpload
s {$sel:objectLockRetainUntilDate:CreateMultipartUpload' :: Maybe ISO8601
objectLockRetainUntilDate = Maybe ISO8601
a} :: CreateMultipartUpload) 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

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

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

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

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

-- | Specifies the Amazon Web Services KMS Encryption Context to use for
-- object encryption. The value of this header is a base64-encoded UTF-8
-- string holding JSON with the encryption context key-value pairs.
createMultipartUpload_sSEKMSEncryptionContext :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_sSEKMSEncryptionContext :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_sSEKMSEncryptionContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Maybe (Sensitive Text)
$sel:sSEKMSEncryptionContext:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
sSEKMSEncryptionContext} -> Maybe (Sensitive Text)
sSEKMSEncryptionContext) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe (Sensitive Text)
a -> CreateMultipartUpload
s {$sel:sSEKMSEncryptionContext:CreateMultipartUpload' :: Maybe (Sensitive Text)
sSEKMSEncryptionContext = Maybe (Sensitive Text)
a} :: CreateMultipartUpload) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | Specifies the ID of the symmetric customer managed key to use for object
-- encryption. All GET and PUT requests for an object protected by Amazon
-- Web Services KMS will fail if not made via SSL or using SigV4. For
-- information about configuring using any of the officially supported
-- Amazon Web Services SDKs and Amazon Web Services CLI, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/UsingAWSSDK.html#specify-signature-version Specifying the Signature Version in Request Authentication>
-- in the /Amazon S3 User Guide/.
createMultipartUpload_sSEKMSKeyId :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_sSEKMSKeyId :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_sSEKMSKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe (Sensitive Text)
sSEKMSKeyId :: Maybe (Sensitive Text)
$sel:sSEKMSKeyId:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
sSEKMSKeyId} -> Maybe (Sensitive Text)
sSEKMSKeyId) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe (Sensitive Text)
a -> CreateMultipartUpload
s {$sel:sSEKMSKeyId:CreateMultipartUpload' :: Maybe (Sensitive Text)
sSEKMSKeyId = Maybe (Sensitive Text)
a} :: CreateMultipartUpload) 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 server-side encryption algorithm used when storing this object in
-- Amazon S3 (for example, AES256, aws:kms).
createMultipartUpload_serverSideEncryption :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe ServerSideEncryption)
createMultipartUpload_serverSideEncryption :: Lens' CreateMultipartUpload (Maybe ServerSideEncryption)
createMultipartUpload_serverSideEncryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe ServerSideEncryption
serverSideEncryption :: Maybe ServerSideEncryption
$sel:serverSideEncryption:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ServerSideEncryption
serverSideEncryption} -> Maybe ServerSideEncryption
serverSideEncryption) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe ServerSideEncryption
a -> CreateMultipartUpload
s {$sel:serverSideEncryption:CreateMultipartUpload' :: Maybe ServerSideEncryption
serverSideEncryption = Maybe ServerSideEncryption
a} :: CreateMultipartUpload)

-- | By default, Amazon S3 uses the STANDARD Storage Class to store newly
-- created objects. The STANDARD storage class provides high durability and
-- high availability. Depending on performance needs, you can specify a
-- different Storage Class. Amazon S3 on Outposts only uses the OUTPOSTS
-- Storage Class. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/storage-class-intro.html Storage Classes>
-- in the /Amazon S3 User Guide/.
createMultipartUpload_storageClass :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe StorageClass)
createMultipartUpload_storageClass :: Lens' CreateMultipartUpload (Maybe StorageClass)
createMultipartUpload_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe StorageClass
storageClass :: Maybe StorageClass
$sel:storageClass:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe StorageClass
storageClass} -> Maybe StorageClass
storageClass) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe StorageClass
a -> CreateMultipartUpload
s {$sel:storageClass:CreateMultipartUpload' :: Maybe StorageClass
storageClass = Maybe StorageClass
a} :: CreateMultipartUpload)

-- | The tag-set for the object. The tag-set must be encoded as URL Query
-- parameters.
createMultipartUpload_tagging :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_tagging :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_tagging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
tagging :: Maybe Text
$sel:tagging:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
tagging} -> Maybe Text
tagging) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:tagging:CreateMultipartUpload' :: Maybe Text
tagging = Maybe Text
a} :: CreateMultipartUpload)

-- | If the bucket is configured as a website, redirects requests for this
-- object to another object in the same bucket or to an external URL.
-- Amazon S3 stores the value of this header in the object metadata.
createMultipartUpload_websiteRedirectLocation :: Lens.Lens' CreateMultipartUpload (Prelude.Maybe Prelude.Text)
createMultipartUpload_websiteRedirectLocation :: Lens' CreateMultipartUpload (Maybe Text)
createMultipartUpload_websiteRedirectLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {Maybe Text
websiteRedirectLocation :: Maybe Text
$sel:websiteRedirectLocation:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
websiteRedirectLocation} -> Maybe Text
websiteRedirectLocation) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} Maybe Text
a -> CreateMultipartUpload
s {$sel:websiteRedirectLocation:CreateMultipartUpload' :: Maybe Text
websiteRedirectLocation = Maybe Text
a} :: CreateMultipartUpload)

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

-- | Object key for which the multipart upload is to be initiated.
createMultipartUpload_key :: Lens.Lens' CreateMultipartUpload ObjectKey
createMultipartUpload_key :: Lens' CreateMultipartUpload ObjectKey
createMultipartUpload_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUpload' {ObjectKey
key :: ObjectKey
$sel:key:CreateMultipartUpload' :: CreateMultipartUpload -> ObjectKey
key} -> ObjectKey
key) (\s :: CreateMultipartUpload
s@CreateMultipartUpload' {} ObjectKey
a -> CreateMultipartUpload
s {$sel:key:CreateMultipartUpload' :: ObjectKey
key = ObjectKey
a} :: CreateMultipartUpload)

instance Core.AWSRequest CreateMultipartUpload where
  type
    AWSResponse CreateMultipartUpload =
      CreateMultipartUploadResponse
  request :: (Service -> Service)
-> CreateMultipartUpload -> Request CreateMultipartUpload
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.post (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateMultipartUpload
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateMultipartUpload)))
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 Bool
-> Maybe ChecksumAlgorithm
-> Maybe ObjectKey
-> Maybe RequestCharged
-> Maybe Text
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe (Sensitive Text)
-> Maybe ServerSideEncryption
-> Int
-> Text
-> CreateMultipartUploadResponse
CreateMultipartUploadResponse'
            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.<*> ( ResponseHeaders
h
                            forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-server-side-encryption-bucket-key-enabled"
                        )
            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-checksum-algorithm")
            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.<*> (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.<*> ( ResponseHeaders
h
                            forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-server-side-encryption-customer-algorithm"
                        )
            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-server-side-encryption-customer-key-MD5"
                        )
            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-server-side-encryption-context")
            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-server-side-encryption-aws-kms-key-id"
                        )
            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-server-side-encryption")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"UploadId")
      )

instance Prelude.Hashable CreateMultipartUpload where
  hashWithSalt :: Int -> CreateMultipartUpload -> Int
hashWithSalt Int
_salt CreateMultipartUpload' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Maybe ISO8601
Maybe RFC822
Maybe ChecksumAlgorithm
Maybe ObjectCannedACL
Maybe ObjectLockLegalHoldStatus
Maybe ObjectLockMode
Maybe RequestPayer
Maybe ServerSideEncryption
Maybe StorageClass
HashMap Text Text
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
websiteRedirectLocation :: Maybe Text
tagging :: Maybe Text
storageClass :: Maybe StorageClass
serverSideEncryption :: Maybe ServerSideEncryption
sSEKMSKeyId :: Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Maybe (Sensitive Text)
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockRetainUntilDate :: Maybe ISO8601
objectLockMode :: Maybe ObjectLockMode
objectLockLegalHoldStatus :: Maybe ObjectLockLegalHoldStatus
metadata :: HashMap Text Text
grantWriteACP :: Maybe Text
grantReadACP :: Maybe Text
grantRead :: Maybe Text
grantFullControl :: Maybe Text
expires :: Maybe RFC822
expectedBucketOwner :: Maybe Text
contentType :: Maybe Text
contentLanguage :: Maybe Text
contentEncoding :: Maybe Text
contentDisposition :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
cacheControl :: Maybe Text
bucketKeyEnabled :: Maybe Bool
acl :: Maybe ObjectCannedACL
$sel:key:CreateMultipartUpload' :: CreateMultipartUpload -> ObjectKey
$sel:bucket:CreateMultipartUpload' :: CreateMultipartUpload -> BucketName
$sel:websiteRedirectLocation:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:tagging:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:storageClass:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe StorageClass
$sel:serverSideEncryption:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ServerSideEncryption
$sel:sSEKMSKeyId:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSEKMSEncryptionContext:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSECustomerKeyMD5:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:sSECustomerKey:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:requestPayer:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RequestPayer
$sel:objectLockRetainUntilDate:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ISO8601
$sel:objectLockMode:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockMode
$sel:objectLockLegalHoldStatus:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockLegalHoldStatus
$sel:metadata:CreateMultipartUpload' :: CreateMultipartUpload -> HashMap Text Text
$sel:grantWriteACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantReadACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantRead:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantFullControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:expires:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RFC822
$sel:expectedBucketOwner:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentType:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentLanguage:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentEncoding:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentDisposition:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:checksumAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ChecksumAlgorithm
$sel:cacheControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:bucketKeyEnabled:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Bool
$sel:acl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectCannedACL
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ObjectCannedACL
acl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
bucketKeyEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cacheControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChecksumAlgorithm
checksumAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentDisposition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentEncoding
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentLanguage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedBucketOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RFC822
expires
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
grantFullControl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
grantRead
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
grantReadACP
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
grantWriteACP
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap Text Text
metadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ObjectLockMode
objectLockMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
objectLockRetainUntilDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RequestPayer
requestPayer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sSECustomerAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
sSECustomerKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sSECustomerKeyMD5
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
sSEKMSEncryptionContext
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
sSEKMSKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServerSideEncryption
serverSideEncryption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StorageClass
storageClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tagging
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
websiteRedirectLocation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketName
bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectKey
key

instance Prelude.NFData CreateMultipartUpload where
  rnf :: CreateMultipartUpload -> ()
rnf CreateMultipartUpload' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Maybe ISO8601
Maybe RFC822
Maybe ChecksumAlgorithm
Maybe ObjectCannedACL
Maybe ObjectLockLegalHoldStatus
Maybe ObjectLockMode
Maybe RequestPayer
Maybe ServerSideEncryption
Maybe StorageClass
HashMap Text Text
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
websiteRedirectLocation :: Maybe Text
tagging :: Maybe Text
storageClass :: Maybe StorageClass
serverSideEncryption :: Maybe ServerSideEncryption
sSEKMSKeyId :: Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Maybe (Sensitive Text)
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockRetainUntilDate :: Maybe ISO8601
objectLockMode :: Maybe ObjectLockMode
objectLockLegalHoldStatus :: Maybe ObjectLockLegalHoldStatus
metadata :: HashMap Text Text
grantWriteACP :: Maybe Text
grantReadACP :: Maybe Text
grantRead :: Maybe Text
grantFullControl :: Maybe Text
expires :: Maybe RFC822
expectedBucketOwner :: Maybe Text
contentType :: Maybe Text
contentLanguage :: Maybe Text
contentEncoding :: Maybe Text
contentDisposition :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
cacheControl :: Maybe Text
bucketKeyEnabled :: Maybe Bool
acl :: Maybe ObjectCannedACL
$sel:key:CreateMultipartUpload' :: CreateMultipartUpload -> ObjectKey
$sel:bucket:CreateMultipartUpload' :: CreateMultipartUpload -> BucketName
$sel:websiteRedirectLocation:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:tagging:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:storageClass:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe StorageClass
$sel:serverSideEncryption:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ServerSideEncryption
$sel:sSEKMSKeyId:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSEKMSEncryptionContext:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSECustomerKeyMD5:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:sSECustomerKey:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:requestPayer:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RequestPayer
$sel:objectLockRetainUntilDate:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ISO8601
$sel:objectLockMode:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockMode
$sel:objectLockLegalHoldStatus:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockLegalHoldStatus
$sel:metadata:CreateMultipartUpload' :: CreateMultipartUpload -> HashMap Text Text
$sel:grantWriteACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantReadACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantRead:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantFullControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:expires:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RFC822
$sel:expectedBucketOwner:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentType:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentLanguage:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentEncoding:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentDisposition:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:checksumAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ChecksumAlgorithm
$sel:cacheControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:bucketKeyEnabled:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Bool
$sel:acl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectCannedACL
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ObjectCannedACL
acl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
bucketKeyEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cacheControl
      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 Text
contentDisposition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentEncoding
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentLanguage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentType
      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 RFC822
expires
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
grantFullControl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
grantRead
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
grantReadACP
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
grantWriteACP
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap Text Text
metadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ObjectLockMode
objectLockMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ISO8601
objectLockRetainUntilDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestPayer
requestPayer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
sSECustomerAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
sSECustomerKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
sSECustomerKeyMD5
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe (Sensitive Text)
sSEKMSEncryptionContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe (Sensitive Text)
sSEKMSKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe ServerSideEncryption
serverSideEncryption
      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
tagging
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
websiteRedirectLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        BucketName
bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        ObjectKey
key

instance Data.ToHeaders CreateMultipartUpload where
  toHeaders :: CreateMultipartUpload -> ResponseHeaders
toHeaders CreateMultipartUpload' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Maybe ISO8601
Maybe RFC822
Maybe ChecksumAlgorithm
Maybe ObjectCannedACL
Maybe ObjectLockLegalHoldStatus
Maybe ObjectLockMode
Maybe RequestPayer
Maybe ServerSideEncryption
Maybe StorageClass
HashMap Text Text
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
websiteRedirectLocation :: Maybe Text
tagging :: Maybe Text
storageClass :: Maybe StorageClass
serverSideEncryption :: Maybe ServerSideEncryption
sSEKMSKeyId :: Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Maybe (Sensitive Text)
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockRetainUntilDate :: Maybe ISO8601
objectLockMode :: Maybe ObjectLockMode
objectLockLegalHoldStatus :: Maybe ObjectLockLegalHoldStatus
metadata :: HashMap Text Text
grantWriteACP :: Maybe Text
grantReadACP :: Maybe Text
grantRead :: Maybe Text
grantFullControl :: Maybe Text
expires :: Maybe RFC822
expectedBucketOwner :: Maybe Text
contentType :: Maybe Text
contentLanguage :: Maybe Text
contentEncoding :: Maybe Text
contentDisposition :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
cacheControl :: Maybe Text
bucketKeyEnabled :: Maybe Bool
acl :: Maybe ObjectCannedACL
$sel:key:CreateMultipartUpload' :: CreateMultipartUpload -> ObjectKey
$sel:bucket:CreateMultipartUpload' :: CreateMultipartUpload -> BucketName
$sel:websiteRedirectLocation:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:tagging:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:storageClass:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe StorageClass
$sel:serverSideEncryption:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ServerSideEncryption
$sel:sSEKMSKeyId:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSEKMSEncryptionContext:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSECustomerKeyMD5:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:sSECustomerKey:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:requestPayer:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RequestPayer
$sel:objectLockRetainUntilDate:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ISO8601
$sel:objectLockMode:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockMode
$sel:objectLockLegalHoldStatus:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockLegalHoldStatus
$sel:metadata:CreateMultipartUpload' :: CreateMultipartUpload -> HashMap Text Text
$sel:grantWriteACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantReadACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantRead:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantFullControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:expires:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RFC822
$sel:expectedBucketOwner:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentType:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentLanguage:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentEncoding:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentDisposition:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:checksumAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ChecksumAlgorithm
$sel:cacheControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:bucketKeyEnabled:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Bool
$sel:acl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectCannedACL
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-acl" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ObjectCannedACL
acl,
        HeaderName
"x-amz-server-side-encryption-bucket-key-enabled"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Bool
bucketKeyEnabled,
        HeaderName
"Cache-Control" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
cacheControl,
        HeaderName
"x-amz-checksum-algorithm" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ChecksumAlgorithm
checksumAlgorithm,
        HeaderName
"Content-Disposition" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
contentDisposition,
        HeaderName
"Content-Encoding" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
contentEncoding,
        HeaderName
"Content-Language" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
contentLanguage,
        HeaderName
"Content-Type" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
contentType,
        HeaderName
"x-amz-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
expectedBucketOwner,
        HeaderName
"Expires" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe RFC822
expires,
        HeaderName
"x-amz-grant-full-control" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
grantFullControl,
        HeaderName
"x-amz-grant-read" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
grantRead,
        HeaderName
"x-amz-grant-read-acp" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
grantReadACP,
        HeaderName
"x-amz-grant-write-acp" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
grantWriteACP,
        HeaderName
"x-amz-meta-" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# HashMap Text Text
metadata,
        HeaderName
"x-amz-object-lock-legal-hold"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ObjectLockLegalHoldStatus
objectLockLegalHoldStatus,
        HeaderName
"x-amz-object-lock-mode" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ObjectLockMode
objectLockMode,
        HeaderName
"x-amz-object-lock-retain-until-date"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ISO8601
objectLockRetainUntilDate,
        HeaderName
"x-amz-request-payer" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe RequestPayer
requestPayer,
        HeaderName
"x-amz-server-side-encryption-customer-algorithm"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
sSECustomerAlgorithm,
        HeaderName
"x-amz-server-side-encryption-customer-key"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
sSECustomerKey,
        HeaderName
"x-amz-server-side-encryption-customer-key-MD5"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
sSECustomerKeyMD5,
        HeaderName
"x-amz-server-side-encryption-context"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
sSEKMSEncryptionContext,
        HeaderName
"x-amz-server-side-encryption-aws-kms-key-id"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
sSEKMSKeyId,
        HeaderName
"x-amz-server-side-encryption"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe ServerSideEncryption
serverSideEncryption,
        HeaderName
"x-amz-storage-class" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe StorageClass
storageClass,
        HeaderName
"x-amz-tagging" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
tagging,
        HeaderName
"x-amz-website-redirect-location"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
websiteRedirectLocation
      ]

instance Data.ToPath CreateMultipartUpload where
  toPath :: CreateMultipartUpload -> ByteString
toPath CreateMultipartUpload' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Maybe ISO8601
Maybe RFC822
Maybe ChecksumAlgorithm
Maybe ObjectCannedACL
Maybe ObjectLockLegalHoldStatus
Maybe ObjectLockMode
Maybe RequestPayer
Maybe ServerSideEncryption
Maybe StorageClass
HashMap Text Text
ObjectKey
BucketName
key :: ObjectKey
bucket :: BucketName
websiteRedirectLocation :: Maybe Text
tagging :: Maybe Text
storageClass :: Maybe StorageClass
serverSideEncryption :: Maybe ServerSideEncryption
sSEKMSKeyId :: Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Maybe (Sensitive Text)
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
objectLockRetainUntilDate :: Maybe ISO8601
objectLockMode :: Maybe ObjectLockMode
objectLockLegalHoldStatus :: Maybe ObjectLockLegalHoldStatus
metadata :: HashMap Text Text
grantWriteACP :: Maybe Text
grantReadACP :: Maybe Text
grantRead :: Maybe Text
grantFullControl :: Maybe Text
expires :: Maybe RFC822
expectedBucketOwner :: Maybe Text
contentType :: Maybe Text
contentLanguage :: Maybe Text
contentEncoding :: Maybe Text
contentDisposition :: Maybe Text
checksumAlgorithm :: Maybe ChecksumAlgorithm
cacheControl :: Maybe Text
bucketKeyEnabled :: Maybe Bool
acl :: Maybe ObjectCannedACL
$sel:key:CreateMultipartUpload' :: CreateMultipartUpload -> ObjectKey
$sel:bucket:CreateMultipartUpload' :: CreateMultipartUpload -> BucketName
$sel:websiteRedirectLocation:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:tagging:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:storageClass:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe StorageClass
$sel:serverSideEncryption:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ServerSideEncryption
$sel:sSEKMSKeyId:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSEKMSEncryptionContext:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSECustomerKeyMD5:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:sSECustomerKey:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:requestPayer:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RequestPayer
$sel:objectLockRetainUntilDate:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ISO8601
$sel:objectLockMode:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockMode
$sel:objectLockLegalHoldStatus:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectLockLegalHoldStatus
$sel:metadata:CreateMultipartUpload' :: CreateMultipartUpload -> HashMap Text Text
$sel:grantWriteACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantReadACP:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantRead:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:grantFullControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:expires:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe RFC822
$sel:expectedBucketOwner:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentType:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentLanguage:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentEncoding:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:contentDisposition:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:checksumAlgorithm:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ChecksumAlgorithm
$sel:cacheControl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Text
$sel:bucketKeyEnabled:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe Bool
$sel:acl:CreateMultipartUpload' :: CreateMultipartUpload -> Maybe ObjectCannedACL
..} =
    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 CreateMultipartUpload where
  toQuery :: CreateMultipartUpload -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const (forall a. Monoid a => [a] -> a
Prelude.mconcat [QueryString
"uploads"])

-- | /See:/ 'newCreateMultipartUploadResponse' smart constructor.
data CreateMultipartUploadResponse = CreateMultipartUploadResponse'
  { -- | 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, the response includes this
    -- header. The header indicates when the initiated multipart upload becomes
    -- eligible for an 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 also includes the @x-amz-abort-rule-id@ header that
    -- provides the ID of the lifecycle configuration rule that defines this
    -- action.
    CreateMultipartUploadResponse -> Maybe RFC822
abortDate :: Prelude.Maybe Data.RFC822,
    -- | This header is returned along with the @x-amz-abort-date@ header. It
    -- identifies the applicable lifecycle configuration rule that defines the
    -- action to abort incomplete multipart uploads.
    CreateMultipartUploadResponse -> 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.
    --
    -- 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/.
    CreateMultipartUploadResponse -> Maybe BucketName
bucket :: Prelude.Maybe BucketName,
    -- | Indicates whether the multipart upload uses an S3 Bucket Key for
    -- server-side encryption with Amazon Web Services KMS (SSE-KMS).
    CreateMultipartUploadResponse -> Maybe Bool
bucketKeyEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The algorithm that was used to create a checksum of the object.
    CreateMultipartUploadResponse -> Maybe ChecksumAlgorithm
checksumAlgorithm :: Prelude.Maybe ChecksumAlgorithm,
    -- | Object key for which the multipart upload was initiated.
    CreateMultipartUploadResponse -> Maybe ObjectKey
key :: Prelude.Maybe ObjectKey,
    CreateMultipartUploadResponse -> Maybe RequestCharged
requestCharged :: Prelude.Maybe RequestCharged,
    -- | If server-side encryption with a customer-provided encryption key was
    -- requested, the response will include this header confirming the
    -- encryption algorithm used.
    CreateMultipartUploadResponse -> Maybe Text
sSECustomerAlgorithm :: Prelude.Maybe Prelude.Text,
    -- | If server-side encryption with a customer-provided encryption key was
    -- requested, the response will include this header to provide round-trip
    -- message integrity verification of the customer-provided encryption key.
    CreateMultipartUploadResponse -> Maybe Text
sSECustomerKeyMD5 :: Prelude.Maybe Prelude.Text,
    -- | If present, specifies the Amazon Web Services KMS Encryption Context to
    -- use for object encryption. The value of this header is a base64-encoded
    -- UTF-8 string holding JSON with the encryption context key-value pairs.
    CreateMultipartUploadResponse -> Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | If present, specifies the ID of the Amazon Web Services Key Management
    -- Service (Amazon Web Services KMS) symmetric customer managed key that
    -- was used for the object.
    CreateMultipartUploadResponse -> Maybe (Sensitive Text)
sSEKMSKeyId :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The server-side encryption algorithm used when storing this object in
    -- Amazon S3 (for example, AES256, aws:kms).
    CreateMultipartUploadResponse -> Maybe ServerSideEncryption
serverSideEncryption :: Prelude.Maybe ServerSideEncryption,
    -- | The response's http status code.
    CreateMultipartUploadResponse -> Int
httpStatus :: Prelude.Int,
    -- | ID for the initiated multipart upload.
    CreateMultipartUploadResponse -> Text
uploadId :: Prelude.Text
  }
  deriving (CreateMultipartUploadResponse
-> CreateMultipartUploadResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMultipartUploadResponse
-> CreateMultipartUploadResponse -> Bool
$c/= :: CreateMultipartUploadResponse
-> CreateMultipartUploadResponse -> Bool
== :: CreateMultipartUploadResponse
-> CreateMultipartUploadResponse -> Bool
$c== :: CreateMultipartUploadResponse
-> CreateMultipartUploadResponse -> Bool
Prelude.Eq, Int -> CreateMultipartUploadResponse -> ShowS
[CreateMultipartUploadResponse] -> ShowS
CreateMultipartUploadResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMultipartUploadResponse] -> ShowS
$cshowList :: [CreateMultipartUploadResponse] -> ShowS
show :: CreateMultipartUploadResponse -> String
$cshow :: CreateMultipartUploadResponse -> String
showsPrec :: Int -> CreateMultipartUploadResponse -> ShowS
$cshowsPrec :: Int -> CreateMultipartUploadResponse -> ShowS
Prelude.Show, forall x.
Rep CreateMultipartUploadResponse x
-> CreateMultipartUploadResponse
forall x.
CreateMultipartUploadResponse
-> Rep CreateMultipartUploadResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateMultipartUploadResponse x
-> CreateMultipartUploadResponse
$cfrom :: forall x.
CreateMultipartUploadResponse
-> Rep CreateMultipartUploadResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateMultipartUploadResponse' 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', 'createMultipartUploadResponse_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, the response includes this
-- header. The header indicates when the initiated multipart upload becomes
-- eligible for an 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 also includes the @x-amz-abort-rule-id@ header that
-- provides the ID of the lifecycle configuration rule that defines this
-- action.
--
-- 'abortRuleId', 'createMultipartUploadResponse_abortRuleId' - This header is returned along with the @x-amz-abort-date@ header. It
-- identifies the applicable lifecycle configuration rule that defines the
-- action to abort incomplete multipart uploads.
--
-- 'bucket', 'createMultipartUploadResponse_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.
--
-- 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/.
--
-- 'bucketKeyEnabled', 'createMultipartUploadResponse_bucketKeyEnabled' - Indicates whether the multipart upload uses an S3 Bucket Key for
-- server-side encryption with Amazon Web Services KMS (SSE-KMS).
--
-- 'checksumAlgorithm', 'createMultipartUploadResponse_checksumAlgorithm' - The algorithm that was used to create a checksum of the object.
--
-- 'key', 'createMultipartUploadResponse_key' - Object key for which the multipart upload was initiated.
--
-- 'requestCharged', 'createMultipartUploadResponse_requestCharged' - Undocumented member.
--
-- 'sSECustomerAlgorithm', 'createMultipartUploadResponse_sSECustomerAlgorithm' - If server-side encryption with a customer-provided encryption key was
-- requested, the response will include this header confirming the
-- encryption algorithm used.
--
-- 'sSECustomerKeyMD5', 'createMultipartUploadResponse_sSECustomerKeyMD5' - If server-side encryption with a customer-provided encryption key was
-- requested, the response will include this header to provide round-trip
-- message integrity verification of the customer-provided encryption key.
--
-- 'sSEKMSEncryptionContext', 'createMultipartUploadResponse_sSEKMSEncryptionContext' - If present, specifies the Amazon Web Services KMS Encryption Context to
-- use for object encryption. The value of this header is a base64-encoded
-- UTF-8 string holding JSON with the encryption context key-value pairs.
--
-- 'sSEKMSKeyId', 'createMultipartUploadResponse_sSEKMSKeyId' - If present, specifies the ID of the Amazon Web Services Key Management
-- Service (Amazon Web Services KMS) symmetric customer managed key that
-- was used for the object.
--
-- 'serverSideEncryption', 'createMultipartUploadResponse_serverSideEncryption' - The server-side encryption algorithm used when storing this object in
-- Amazon S3 (for example, AES256, aws:kms).
--
-- 'httpStatus', 'createMultipartUploadResponse_httpStatus' - The response's http status code.
--
-- 'uploadId', 'createMultipartUploadResponse_uploadId' - ID for the initiated multipart upload.
newCreateMultipartUploadResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'uploadId'
  Prelude.Text ->
  CreateMultipartUploadResponse
newCreateMultipartUploadResponse :: Int -> Text -> CreateMultipartUploadResponse
newCreateMultipartUploadResponse
  Int
pHttpStatus_
  Text
pUploadId_ =
    CreateMultipartUploadResponse'
      { $sel:abortDate:CreateMultipartUploadResponse' :: Maybe RFC822
abortDate =
          forall a. Maybe a
Prelude.Nothing,
        $sel:abortRuleId:CreateMultipartUploadResponse' :: Maybe Text
abortRuleId = forall a. Maybe a
Prelude.Nothing,
        $sel:bucket:CreateMultipartUploadResponse' :: Maybe BucketName
bucket = forall a. Maybe a
Prelude.Nothing,
        $sel:bucketKeyEnabled:CreateMultipartUploadResponse' :: Maybe Bool
bucketKeyEnabled = forall a. Maybe a
Prelude.Nothing,
        $sel:checksumAlgorithm:CreateMultipartUploadResponse' :: Maybe ChecksumAlgorithm
checksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
        $sel:key:CreateMultipartUploadResponse' :: Maybe ObjectKey
key = forall a. Maybe a
Prelude.Nothing,
        $sel:requestCharged:CreateMultipartUploadResponse' :: Maybe RequestCharged
requestCharged = forall a. Maybe a
Prelude.Nothing,
        $sel:sSECustomerAlgorithm:CreateMultipartUploadResponse' :: Maybe Text
sSECustomerAlgorithm = forall a. Maybe a
Prelude.Nothing,
        $sel:sSECustomerKeyMD5:CreateMultipartUploadResponse' :: Maybe Text
sSECustomerKeyMD5 = forall a. Maybe a
Prelude.Nothing,
        $sel:sSEKMSEncryptionContext:CreateMultipartUploadResponse' :: Maybe (Sensitive Text)
sSEKMSEncryptionContext = forall a. Maybe a
Prelude.Nothing,
        $sel:sSEKMSKeyId:CreateMultipartUploadResponse' :: Maybe (Sensitive Text)
sSEKMSKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:serverSideEncryption:CreateMultipartUploadResponse' :: Maybe ServerSideEncryption
serverSideEncryption = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateMultipartUploadResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:uploadId:CreateMultipartUploadResponse' :: Text
uploadId = Text
pUploadId_
      }

-- | 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, the response includes this
-- header. The header indicates when the initiated multipart upload becomes
-- eligible for an 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 also includes the @x-amz-abort-rule-id@ header that
-- provides the ID of the lifecycle configuration rule that defines this
-- action.
createMultipartUploadResponse_abortDate :: Lens.Lens' CreateMultipartUploadResponse (Prelude.Maybe Prelude.UTCTime)
createMultipartUploadResponse_abortDate :: Lens' CreateMultipartUploadResponse (Maybe UTCTime)
createMultipartUploadResponse_abortDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Maybe RFC822
abortDate :: Maybe RFC822
$sel:abortDate:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe RFC822
abortDate} -> Maybe RFC822
abortDate) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Maybe RFC822
a -> CreateMultipartUploadResponse
s {$sel:abortDate:CreateMultipartUploadResponse' :: Maybe RFC822
abortDate = Maybe RFC822
a} :: CreateMultipartUploadResponse) 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 the applicable lifecycle configuration rule that defines the
-- action to abort incomplete multipart uploads.
createMultipartUploadResponse_abortRuleId :: Lens.Lens' CreateMultipartUploadResponse (Prelude.Maybe Prelude.Text)
createMultipartUploadResponse_abortRuleId :: Lens' CreateMultipartUploadResponse (Maybe Text)
createMultipartUploadResponse_abortRuleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Maybe Text
abortRuleId :: Maybe Text
$sel:abortRuleId:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe Text
abortRuleId} -> Maybe Text
abortRuleId) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Maybe Text
a -> CreateMultipartUploadResponse
s {$sel:abortRuleId:CreateMultipartUploadResponse' :: Maybe Text
abortRuleId = Maybe Text
a} :: CreateMultipartUploadResponse)

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

-- | Indicates whether the multipart upload uses an S3 Bucket Key for
-- server-side encryption with Amazon Web Services KMS (SSE-KMS).
createMultipartUploadResponse_bucketKeyEnabled :: Lens.Lens' CreateMultipartUploadResponse (Prelude.Maybe Prelude.Bool)
createMultipartUploadResponse_bucketKeyEnabled :: Lens' CreateMultipartUploadResponse (Maybe Bool)
createMultipartUploadResponse_bucketKeyEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Maybe Bool
bucketKeyEnabled :: Maybe Bool
$sel:bucketKeyEnabled:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe Bool
bucketKeyEnabled} -> Maybe Bool
bucketKeyEnabled) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Maybe Bool
a -> CreateMultipartUploadResponse
s {$sel:bucketKeyEnabled:CreateMultipartUploadResponse' :: Maybe Bool
bucketKeyEnabled = Maybe Bool
a} :: CreateMultipartUploadResponse)

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

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

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

-- | If server-side encryption with a customer-provided encryption key was
-- requested, the response will include this header confirming the
-- encryption algorithm used.
createMultipartUploadResponse_sSECustomerAlgorithm :: Lens.Lens' CreateMultipartUploadResponse (Prelude.Maybe Prelude.Text)
createMultipartUploadResponse_sSECustomerAlgorithm :: Lens' CreateMultipartUploadResponse (Maybe Text)
createMultipartUploadResponse_sSECustomerAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Maybe Text
sSECustomerAlgorithm :: Maybe Text
$sel:sSECustomerAlgorithm:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe Text
sSECustomerAlgorithm} -> Maybe Text
sSECustomerAlgorithm) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Maybe Text
a -> CreateMultipartUploadResponse
s {$sel:sSECustomerAlgorithm:CreateMultipartUploadResponse' :: Maybe Text
sSECustomerAlgorithm = Maybe Text
a} :: CreateMultipartUploadResponse)

-- | If server-side encryption with a customer-provided encryption key was
-- requested, the response will include this header to provide round-trip
-- message integrity verification of the customer-provided encryption key.
createMultipartUploadResponse_sSECustomerKeyMD5 :: Lens.Lens' CreateMultipartUploadResponse (Prelude.Maybe Prelude.Text)
createMultipartUploadResponse_sSECustomerKeyMD5 :: Lens' CreateMultipartUploadResponse (Maybe Text)
createMultipartUploadResponse_sSECustomerKeyMD5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Maybe Text
sSECustomerKeyMD5 :: Maybe Text
$sel:sSECustomerKeyMD5:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe Text
sSECustomerKeyMD5} -> Maybe Text
sSECustomerKeyMD5) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Maybe Text
a -> CreateMultipartUploadResponse
s {$sel:sSECustomerKeyMD5:CreateMultipartUploadResponse' :: Maybe Text
sSECustomerKeyMD5 = Maybe Text
a} :: CreateMultipartUploadResponse)

-- | If present, specifies the Amazon Web Services KMS Encryption Context to
-- use for object encryption. The value of this header is a base64-encoded
-- UTF-8 string holding JSON with the encryption context key-value pairs.
createMultipartUploadResponse_sSEKMSEncryptionContext :: Lens.Lens' CreateMultipartUploadResponse (Prelude.Maybe Prelude.Text)
createMultipartUploadResponse_sSEKMSEncryptionContext :: Lens' CreateMultipartUploadResponse (Maybe Text)
createMultipartUploadResponse_sSEKMSEncryptionContext = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Maybe (Sensitive Text)
$sel:sSEKMSEncryptionContext:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe (Sensitive Text)
sSEKMSEncryptionContext} -> Maybe (Sensitive Text)
sSEKMSEncryptionContext) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Maybe (Sensitive Text)
a -> CreateMultipartUploadResponse
s {$sel:sSEKMSEncryptionContext:CreateMultipartUploadResponse' :: Maybe (Sensitive Text)
sSEKMSEncryptionContext = Maybe (Sensitive Text)
a} :: CreateMultipartUploadResponse) 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

-- | If present, specifies the ID of the Amazon Web Services Key Management
-- Service (Amazon Web Services KMS) symmetric customer managed key that
-- was used for the object.
createMultipartUploadResponse_sSEKMSKeyId :: Lens.Lens' CreateMultipartUploadResponse (Prelude.Maybe Prelude.Text)
createMultipartUploadResponse_sSEKMSKeyId :: Lens' CreateMultipartUploadResponse (Maybe Text)
createMultipartUploadResponse_sSEKMSKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Maybe (Sensitive Text)
sSEKMSKeyId :: Maybe (Sensitive Text)
$sel:sSEKMSKeyId:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe (Sensitive Text)
sSEKMSKeyId} -> Maybe (Sensitive Text)
sSEKMSKeyId) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Maybe (Sensitive Text)
a -> CreateMultipartUploadResponse
s {$sel:sSEKMSKeyId:CreateMultipartUploadResponse' :: Maybe (Sensitive Text)
sSEKMSKeyId = Maybe (Sensitive Text)
a} :: CreateMultipartUploadResponse) 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 server-side encryption algorithm used when storing this object in
-- Amazon S3 (for example, AES256, aws:kms).
createMultipartUploadResponse_serverSideEncryption :: Lens.Lens' CreateMultipartUploadResponse (Prelude.Maybe ServerSideEncryption)
createMultipartUploadResponse_serverSideEncryption :: Lens' CreateMultipartUploadResponse (Maybe ServerSideEncryption)
createMultipartUploadResponse_serverSideEncryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Maybe ServerSideEncryption
serverSideEncryption :: Maybe ServerSideEncryption
$sel:serverSideEncryption:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe ServerSideEncryption
serverSideEncryption} -> Maybe ServerSideEncryption
serverSideEncryption) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Maybe ServerSideEncryption
a -> CreateMultipartUploadResponse
s {$sel:serverSideEncryption:CreateMultipartUploadResponse' :: Maybe ServerSideEncryption
serverSideEncryption = Maybe ServerSideEncryption
a} :: CreateMultipartUploadResponse)

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

-- | ID for the initiated multipart upload.
createMultipartUploadResponse_uploadId :: Lens.Lens' CreateMultipartUploadResponse Prelude.Text
createMultipartUploadResponse_uploadId :: Lens' CreateMultipartUploadResponse Text
createMultipartUploadResponse_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMultipartUploadResponse' {Text
uploadId :: Text
$sel:uploadId:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Text
uploadId} -> Text
uploadId) (\s :: CreateMultipartUploadResponse
s@CreateMultipartUploadResponse' {} Text
a -> CreateMultipartUploadResponse
s {$sel:uploadId:CreateMultipartUploadResponse' :: Text
uploadId = Text
a} :: CreateMultipartUploadResponse)

instance Prelude.NFData CreateMultipartUploadResponse where
  rnf :: CreateMultipartUploadResponse -> ()
rnf CreateMultipartUploadResponse' {Int
Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Maybe RFC822
Maybe ObjectKey
Maybe BucketName
Maybe ChecksumAlgorithm
Maybe RequestCharged
Maybe ServerSideEncryption
Text
uploadId :: Text
httpStatus :: Int
serverSideEncryption :: Maybe ServerSideEncryption
sSEKMSKeyId :: Maybe (Sensitive Text)
sSEKMSEncryptionContext :: Maybe (Sensitive Text)
sSECustomerKeyMD5 :: Maybe Text
sSECustomerAlgorithm :: Maybe Text
requestCharged :: Maybe RequestCharged
key :: Maybe ObjectKey
checksumAlgorithm :: Maybe ChecksumAlgorithm
bucketKeyEnabled :: Maybe Bool
bucket :: Maybe BucketName
abortRuleId :: Maybe Text
abortDate :: Maybe RFC822
$sel:uploadId:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Text
$sel:httpStatus:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Int
$sel:serverSideEncryption:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe ServerSideEncryption
$sel:sSEKMSKeyId:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe (Sensitive Text)
$sel:sSEKMSEncryptionContext:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe (Sensitive Text)
$sel:sSECustomerKeyMD5:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe Text
$sel:sSECustomerAlgorithm:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe Text
$sel:requestCharged:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe RequestCharged
$sel:key:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe ObjectKey
$sel:checksumAlgorithm:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe ChecksumAlgorithm
$sel:bucketKeyEnabled:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe Bool
$sel:bucket:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe BucketName
$sel:abortRuleId:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> Maybe Text
$sel:abortDate:CreateMultipartUploadResponse' :: CreateMultipartUploadResponse -> 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 Bool
bucketKeyEnabled
      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 ObjectKey
key
      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 Text
sSECustomerAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sSECustomerKeyMD5
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
sSEKMSEncryptionContext
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
sSEKMSKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServerSideEncryption
serverSideEncryption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
uploadId