{-# 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.UploadPartCopy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Uploads a part by copying data from an existing object as data source.
-- You specify the data source by adding the request header
-- @x-amz-copy-source@ in your request and a byte range by adding the
-- request header @x-amz-copy-source-range@ in your request.
--
-- For information about maximum and minimum part sizes and other multipart
-- upload specifications, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/qfacts.html Multipart upload limits>
-- in the /Amazon S3 User Guide/.
--
-- Instead of using an existing object as part data, you might use the
-- <https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPart.html UploadPart>
-- action and provide data in your request.
--
-- You must initiate a multipart upload before you can upload any part. In
-- response to your initiate request. Amazon S3 returns a unique
-- identifier, the upload ID, that you must include in your upload part
-- request.
--
-- For more information about using the @UploadPartCopy@ operation, see the
-- following:
--
-- -   For conceptual information about multipart uploads, see
--     <https://docs.aws.amazon.com/AmazonS3/latest/dev/uploadobjusingmpu.html Uploading Objects Using Multipart Upload>
--     in the /Amazon S3 User Guide/.
--
-- -   For information about permissions required to use the multipart
--     upload API, see
--     <https://docs.aws.amazon.com/AmazonS3/latest/dev/mpuAndPermissions.html Multipart Upload and Permissions>
--     in the /Amazon S3 User Guide/.
--
-- -   For information about copying objects using a single atomic action
--     vs. a multipart upload, see
--     <https://docs.aws.amazon.com/AmazonS3/latest/dev/ObjectOperations.html Operations on Objects>
--     in the /Amazon S3 User Guide/.
--
-- -   For information about using server-side encryption with
--     customer-provided encryption keys with the @UploadPartCopy@
--     operation, see
--     <https://docs.aws.amazon.com/AmazonS3/latest/API/API_CopyObject.html CopyObject>
--     and
--     <https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPart.html UploadPart>.
--
-- Note the following additional considerations about the request headers
-- @x-amz-copy-source-if-match@, @x-amz-copy-source-if-none-match@,
-- @x-amz-copy-source-if-unmodified-since@, and
-- @x-amz-copy-source-if-modified-since@:
--
-- -   __Consideration 1__ - If both of the @x-amz-copy-source-if-match@
--     and @x-amz-copy-source-if-unmodified-since@ headers are present in
--     the request as follows:
--
--     @x-amz-copy-source-if-match@ condition evaluates to @true@, and;
--
--     @x-amz-copy-source-if-unmodified-since@ condition evaluates to
--     @false@;
--
--     Amazon S3 returns @200 OK@ and copies the data.
--
-- -   __Consideration 2__ - If both of the
--     @x-amz-copy-source-if-none-match@ and
--     @x-amz-copy-source-if-modified-since@ headers are present in the
--     request as follows:
--
--     @x-amz-copy-source-if-none-match@ condition evaluates to @false@,
--     and;
--
--     @x-amz-copy-source-if-modified-since@ condition evaluates to @true@;
--
--     Amazon S3 returns @412 Precondition Failed@ response code.
--
-- __Versioning__
--
-- If your bucket has versioning enabled, you could have multiple versions
-- of the same object. By default, @x-amz-copy-source@ identifies the
-- current version of the object to copy. If the current version is a
-- delete marker and you don\'t specify a versionId in the
-- @x-amz-copy-source@, Amazon S3 returns a 404 error, because the object
-- does not exist. If you specify versionId in the @x-amz-copy-source@ and
-- the versionId is a delete marker, Amazon S3 returns an HTTP 400 error,
-- because you are not allowed to specify a delete marker as a version for
-- the @x-amz-copy-source@.
--
-- You can optionally specify a specific version of the source object to
-- copy by adding the @versionId@ subresource as shown in the following
-- example:
--
-- @x-amz-copy-source: \/bucket\/object?versionId=version id@
--
-- __Special Errors__
--
-- -   -   /Code: NoSuchUpload/
--
--     -   /Cause: The specified multipart upload does not exist. The
--         upload ID might be invalid, or the multipart upload might have
--         been aborted or completed./
--
--     -   /HTTP Status Code: 404 Not Found/
--
-- -   -   /Code: InvalidRequest/
--
--     -   /Cause: The specified copy source is not supported as a
--         byte-range copy source./
--
--     -   /HTTP Status Code: 400 Bad Request/
--
-- __Related Resources__
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_CreateMultipartUpload.html CreateMultipartUpload>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_UploadPart.html UploadPart>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_CompleteMultipartUpload.html CompleteMultipartUpload>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_AbortMultipartUpload.html AbortMultipartUpload>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_ListParts.html ListParts>
--
-- -   <https://docs.aws.amazon.com/AmazonS3/latest/API/API_ListMultipartUploads.html ListMultipartUploads>
module Amazonka.S3.UploadPartCopy
  ( -- * Creating a Request
    UploadPartCopy (..),
    newUploadPartCopy,

    -- * Request Lenses
    uploadPartCopy_copySourceIfMatch,
    uploadPartCopy_copySourceIfModifiedSince,
    uploadPartCopy_copySourceIfNoneMatch,
    uploadPartCopy_copySourceIfUnmodifiedSince,
    uploadPartCopy_copySourceRange,
    uploadPartCopy_copySourceSSECustomerAlgorithm,
    uploadPartCopy_copySourceSSECustomerKey,
    uploadPartCopy_copySourceSSECustomerKeyMD5,
    uploadPartCopy_expectedBucketOwner,
    uploadPartCopy_expectedSourceBucketOwner,
    uploadPartCopy_requestPayer,
    uploadPartCopy_sSECustomerAlgorithm,
    uploadPartCopy_sSECustomerKey,
    uploadPartCopy_sSECustomerKeyMD5,
    uploadPartCopy_bucket,
    uploadPartCopy_copySource,
    uploadPartCopy_key,
    uploadPartCopy_partNumber,
    uploadPartCopy_uploadId,

    -- * Destructuring the Response
    UploadPartCopyResponse (..),
    newUploadPartCopyResponse,

    -- * Response Lenses
    uploadPartCopyResponse_bucketKeyEnabled,
    uploadPartCopyResponse_copyPartResult,
    uploadPartCopyResponse_copySourceVersionId,
    uploadPartCopyResponse_requestCharged,
    uploadPartCopyResponse_sSECustomerAlgorithm,
    uploadPartCopyResponse_sSECustomerKeyMD5,
    uploadPartCopyResponse_sSEKMSKeyId,
    uploadPartCopyResponse_serverSideEncryption,
    uploadPartCopyResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.S3.Types

-- | /See:/ 'newUploadPartCopy' smart constructor.
data UploadPartCopy = UploadPartCopy'
  { -- | Copies the object if its entity tag (ETag) matches the specified tag.
    UploadPartCopy -> Maybe Text
copySourceIfMatch :: Prelude.Maybe Prelude.Text,
    -- | Copies the object if it has been modified since the specified time.
    UploadPartCopy -> Maybe RFC822
copySourceIfModifiedSince :: Prelude.Maybe Data.RFC822,
    -- | Copies the object if its entity tag (ETag) is different than the
    -- specified ETag.
    UploadPartCopy -> Maybe Text
copySourceIfNoneMatch :: Prelude.Maybe Prelude.Text,
    -- | Copies the object if it hasn\'t been modified since the specified time.
    UploadPartCopy -> Maybe RFC822
copySourceIfUnmodifiedSince :: Prelude.Maybe Data.RFC822,
    -- | The range of bytes to copy from the source object. The range value must
    -- use the form bytes=first-last, where the first and last are the
    -- zero-based byte offsets to copy. For example, bytes=0-9 indicates that
    -- you want to copy the first 10 bytes of the source. You can copy a range
    -- only if the source object is greater than 5 MB.
    UploadPartCopy -> Maybe Text
copySourceRange :: Prelude.Maybe Prelude.Text,
    -- | Specifies the algorithm to use when decrypting the source object (for
    -- example, AES256).
    UploadPartCopy -> Maybe Text
copySourceSSECustomerAlgorithm :: Prelude.Maybe Prelude.Text,
    -- | Specifies the customer-provided encryption key for Amazon S3 to use to
    -- decrypt the source object. The encryption key provided in this header
    -- must be one that was used when the source object was created.
    UploadPartCopy -> Maybe (Sensitive Text)
copySourceSSECustomerKey :: 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.
    UploadPartCopy -> Maybe Text
copySourceSSECustomerKeyMD5 :: Prelude.Maybe Prelude.Text,
    -- | The account ID of the expected destination bucket owner. If the
    -- destination bucket is owned by a different account, the request fails
    -- with the HTTP status code @403 Forbidden@ (access denied).
    UploadPartCopy -> Maybe Text
expectedBucketOwner :: Prelude.Maybe Prelude.Text,
    -- | The account ID of the expected source bucket owner. If the source bucket
    -- is owned by a different account, the request fails with the HTTP status
    -- code @403 Forbidden@ (access denied).
    UploadPartCopy -> Maybe Text
expectedSourceBucketOwner :: Prelude.Maybe Prelude.Text,
    UploadPartCopy -> Maybe RequestPayer
requestPayer :: Prelude.Maybe RequestPayer,
    -- | Specifies the algorithm to use to when encrypting the object (for
    -- example, AES256).
    UploadPartCopy -> 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. This must be
    -- the same encryption key specified in the initiate multipart upload
    -- request.
    UploadPartCopy -> 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.
    UploadPartCopy -> Maybe Text
sSECustomerKeyMD5 :: Prelude.Maybe Prelude.Text,
    -- | The bucket name.
    --
    -- 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/.
    UploadPartCopy -> BucketName
bucket :: BucketName,
    -- | Specifies the source object for the copy operation. You specify the
    -- value in one of two formats, depending on whether you want to access the
    -- source object through an
    -- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/access-points.html access point>:
    --
    -- -   For objects not accessed through an access point, specify the name
    --     of the source bucket and key of the source object, separated by a
    --     slash (\/). For example, to copy the object @reports\/january.pdf@
    --     from the bucket @awsexamplebucket@, use
    --     @awsexamplebucket\/reports\/january.pdf@. The value must be
    --     URL-encoded.
    --
    -- -   For objects accessed through access points, specify the Amazon
    --     Resource Name (ARN) of the object as accessed through the access
    --     point, in the format
    --     @arn:aws:s3:\<Region>:\<account-id>:accesspoint\/\<access-point-name>\/object\/\<key>@.
    --     For example, to copy the object @reports\/january.pdf@ through
    --     access point @my-access-point@ owned by account @123456789012@ in
    --     Region @us-west-2@, use the URL encoding of
    --     @arn:aws:s3:us-west-2:123456789012:accesspoint\/my-access-point\/object\/reports\/january.pdf@.
    --     The value must be URL encoded.
    --
    --     Amazon S3 supports copy operations using access points only when the
    --     source and destination buckets are in the same Amazon Web Services
    --     Region.
    --
    --     Alternatively, for objects accessed through Amazon S3 on Outposts,
    --     specify the ARN of the object as accessed in the format
    --     @arn:aws:s3-outposts:\<Region>:\<account-id>:outpost\/\<outpost-id>\/object\/\<key>@.
    --     For example, to copy the object @reports\/january.pdf@ through
    --     outpost @my-outpost@ owned by account @123456789012@ in Region
    --     @us-west-2@, use the URL encoding of
    --     @arn:aws:s3-outposts:us-west-2:123456789012:outpost\/my-outpost\/object\/reports\/january.pdf@.
    --     The value must be URL-encoded.
    --
    -- To copy a specific version of an object, append
    -- @?versionId=\<version-id>@ to the value (for example,
    -- @awsexamplebucket\/reports\/january.pdf?versionId=QUpfdndhfd8438MNFDN93jdnJFkdmqnh893@).
    -- If you don\'t specify a version ID, Amazon S3 copies the latest version
    -- of the source object.
    UploadPartCopy -> Text
copySource :: Prelude.Text,
    -- | Object key for which the multipart upload was initiated.
    UploadPartCopy -> ObjectKey
key :: ObjectKey,
    -- | Part number of part being copied. This is a positive integer between 1
    -- and 10,000.
    UploadPartCopy -> Int
partNumber :: Prelude.Int,
    -- | Upload ID identifying the multipart upload whose part is being copied.
    UploadPartCopy -> Text
uploadId :: Prelude.Text
  }
  deriving (UploadPartCopy -> UploadPartCopy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadPartCopy -> UploadPartCopy -> Bool
$c/= :: UploadPartCopy -> UploadPartCopy -> Bool
== :: UploadPartCopy -> UploadPartCopy -> Bool
$c== :: UploadPartCopy -> UploadPartCopy -> Bool
Prelude.Eq, Int -> UploadPartCopy -> ShowS
[UploadPartCopy] -> ShowS
UploadPartCopy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadPartCopy] -> ShowS
$cshowList :: [UploadPartCopy] -> ShowS
show :: UploadPartCopy -> String
$cshow :: UploadPartCopy -> String
showsPrec :: Int -> UploadPartCopy -> ShowS
$cshowsPrec :: Int -> UploadPartCopy -> ShowS
Prelude.Show, forall x. Rep UploadPartCopy x -> UploadPartCopy
forall x. UploadPartCopy -> Rep UploadPartCopy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadPartCopy x -> UploadPartCopy
$cfrom :: forall x. UploadPartCopy -> Rep UploadPartCopy x
Prelude.Generic)

-- |
-- Create a value of 'UploadPartCopy' 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:
--
-- 'copySourceIfMatch', 'uploadPartCopy_copySourceIfMatch' - Copies the object if its entity tag (ETag) matches the specified tag.
--
-- 'copySourceIfModifiedSince', 'uploadPartCopy_copySourceIfModifiedSince' - Copies the object if it has been modified since the specified time.
--
-- 'copySourceIfNoneMatch', 'uploadPartCopy_copySourceIfNoneMatch' - Copies the object if its entity tag (ETag) is different than the
-- specified ETag.
--
-- 'copySourceIfUnmodifiedSince', 'uploadPartCopy_copySourceIfUnmodifiedSince' - Copies the object if it hasn\'t been modified since the specified time.
--
-- 'copySourceRange', 'uploadPartCopy_copySourceRange' - The range of bytes to copy from the source object. The range value must
-- use the form bytes=first-last, where the first and last are the
-- zero-based byte offsets to copy. For example, bytes=0-9 indicates that
-- you want to copy the first 10 bytes of the source. You can copy a range
-- only if the source object is greater than 5 MB.
--
-- 'copySourceSSECustomerAlgorithm', 'uploadPartCopy_copySourceSSECustomerAlgorithm' - Specifies the algorithm to use when decrypting the source object (for
-- example, AES256).
--
-- 'copySourceSSECustomerKey', 'uploadPartCopy_copySourceSSECustomerKey' - Specifies the customer-provided encryption key for Amazon S3 to use to
-- decrypt the source object. The encryption key provided in this header
-- must be one that was used when the source object was created.
--
-- 'copySourceSSECustomerKeyMD5', 'uploadPartCopy_copySourceSSECustomerKeyMD5' - 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.
--
-- 'expectedBucketOwner', 'uploadPartCopy_expectedBucketOwner' - The account ID of the expected destination bucket owner. If the
-- destination bucket is owned by a different account, the request fails
-- with the HTTP status code @403 Forbidden@ (access denied).
--
-- 'expectedSourceBucketOwner', 'uploadPartCopy_expectedSourceBucketOwner' - The account ID of the expected source bucket owner. If the source bucket
-- is owned by a different account, the request fails with the HTTP status
-- code @403 Forbidden@ (access denied).
--
-- 'requestPayer', 'uploadPartCopy_requestPayer' - Undocumented member.
--
-- 'sSECustomerAlgorithm', 'uploadPartCopy_sSECustomerAlgorithm' - Specifies the algorithm to use to when encrypting the object (for
-- example, AES256).
--
-- 'sSECustomerKey', 'uploadPartCopy_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. This must be
-- the same encryption key specified in the initiate multipart upload
-- request.
--
-- 'sSECustomerKeyMD5', 'uploadPartCopy_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.
--
-- 'bucket', 'uploadPartCopy_bucket' - The bucket name.
--
-- 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/.
--
-- 'copySource', 'uploadPartCopy_copySource' - Specifies the source object for the copy operation. You specify the
-- value in one of two formats, depending on whether you want to access the
-- source object through an
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/access-points.html access point>:
--
-- -   For objects not accessed through an access point, specify the name
--     of the source bucket and key of the source object, separated by a
--     slash (\/). For example, to copy the object @reports\/january.pdf@
--     from the bucket @awsexamplebucket@, use
--     @awsexamplebucket\/reports\/january.pdf@. The value must be
--     URL-encoded.
--
-- -   For objects accessed through access points, specify the Amazon
--     Resource Name (ARN) of the object as accessed through the access
--     point, in the format
--     @arn:aws:s3:\<Region>:\<account-id>:accesspoint\/\<access-point-name>\/object\/\<key>@.
--     For example, to copy the object @reports\/january.pdf@ through
--     access point @my-access-point@ owned by account @123456789012@ in
--     Region @us-west-2@, use the URL encoding of
--     @arn:aws:s3:us-west-2:123456789012:accesspoint\/my-access-point\/object\/reports\/january.pdf@.
--     The value must be URL encoded.
--
--     Amazon S3 supports copy operations using access points only when the
--     source and destination buckets are in the same Amazon Web Services
--     Region.
--
--     Alternatively, for objects accessed through Amazon S3 on Outposts,
--     specify the ARN of the object as accessed in the format
--     @arn:aws:s3-outposts:\<Region>:\<account-id>:outpost\/\<outpost-id>\/object\/\<key>@.
--     For example, to copy the object @reports\/january.pdf@ through
--     outpost @my-outpost@ owned by account @123456789012@ in Region
--     @us-west-2@, use the URL encoding of
--     @arn:aws:s3-outposts:us-west-2:123456789012:outpost\/my-outpost\/object\/reports\/january.pdf@.
--     The value must be URL-encoded.
--
-- To copy a specific version of an object, append
-- @?versionId=\<version-id>@ to the value (for example,
-- @awsexamplebucket\/reports\/january.pdf?versionId=QUpfdndhfd8438MNFDN93jdnJFkdmqnh893@).
-- If you don\'t specify a version ID, Amazon S3 copies the latest version
-- of the source object.
--
-- 'key', 'uploadPartCopy_key' - Object key for which the multipart upload was initiated.
--
-- 'partNumber', 'uploadPartCopy_partNumber' - Part number of part being copied. This is a positive integer between 1
-- and 10,000.
--
-- 'uploadId', 'uploadPartCopy_uploadId' - Upload ID identifying the multipart upload whose part is being copied.
newUploadPartCopy ::
  -- | 'bucket'
  BucketName ->
  -- | 'copySource'
  Prelude.Text ->
  -- | 'key'
  ObjectKey ->
  -- | 'partNumber'
  Prelude.Int ->
  -- | 'uploadId'
  Prelude.Text ->
  UploadPartCopy
newUploadPartCopy :: BucketName -> Text -> ObjectKey -> Int -> Text -> UploadPartCopy
newUploadPartCopy
  BucketName
pBucket_
  Text
pCopySource_
  ObjectKey
pKey_
  Int
pPartNumber_
  Text
pUploadId_ =
    UploadPartCopy'
      { $sel:copySourceIfMatch:UploadPartCopy' :: Maybe Text
copySourceIfMatch =
          forall a. Maybe a
Prelude.Nothing,
        $sel:copySourceIfModifiedSince:UploadPartCopy' :: Maybe RFC822
copySourceIfModifiedSince = forall a. Maybe a
Prelude.Nothing,
        $sel:copySourceIfNoneMatch:UploadPartCopy' :: Maybe Text
copySourceIfNoneMatch = forall a. Maybe a
Prelude.Nothing,
        $sel:copySourceIfUnmodifiedSince:UploadPartCopy' :: Maybe RFC822
copySourceIfUnmodifiedSince = forall a. Maybe a
Prelude.Nothing,
        $sel:copySourceRange:UploadPartCopy' :: Maybe Text
copySourceRange = forall a. Maybe a
Prelude.Nothing,
        $sel:copySourceSSECustomerAlgorithm:UploadPartCopy' :: Maybe Text
copySourceSSECustomerAlgorithm = forall a. Maybe a
Prelude.Nothing,
        $sel:copySourceSSECustomerKey:UploadPartCopy' :: Maybe (Sensitive Text)
copySourceSSECustomerKey = forall a. Maybe a
Prelude.Nothing,
        $sel:copySourceSSECustomerKeyMD5:UploadPartCopy' :: Maybe Text
copySourceSSECustomerKeyMD5 = forall a. Maybe a
Prelude.Nothing,
        $sel:expectedBucketOwner:UploadPartCopy' :: Maybe Text
expectedBucketOwner = forall a. Maybe a
Prelude.Nothing,
        $sel:expectedSourceBucketOwner:UploadPartCopy' :: Maybe Text
expectedSourceBucketOwner = forall a. Maybe a
Prelude.Nothing,
        $sel:requestPayer:UploadPartCopy' :: Maybe RequestPayer
requestPayer = forall a. Maybe a
Prelude.Nothing,
        $sel:sSECustomerAlgorithm:UploadPartCopy' :: Maybe Text
sSECustomerAlgorithm = forall a. Maybe a
Prelude.Nothing,
        $sel:sSECustomerKey:UploadPartCopy' :: Maybe (Sensitive Text)
sSECustomerKey = forall a. Maybe a
Prelude.Nothing,
        $sel:sSECustomerKeyMD5:UploadPartCopy' :: Maybe Text
sSECustomerKeyMD5 = forall a. Maybe a
Prelude.Nothing,
        $sel:bucket:UploadPartCopy' :: BucketName
bucket = BucketName
pBucket_,
        $sel:copySource:UploadPartCopy' :: Text
copySource = Text
pCopySource_,
        $sel:key:UploadPartCopy' :: ObjectKey
key = ObjectKey
pKey_,
        $sel:partNumber:UploadPartCopy' :: Int
partNumber = Int
pPartNumber_,
        $sel:uploadId:UploadPartCopy' :: Text
uploadId = Text
pUploadId_
      }

-- | Copies the object if its entity tag (ETag) matches the specified tag.
uploadPartCopy_copySourceIfMatch :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_copySourceIfMatch :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_copySourceIfMatch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe Text
copySourceIfMatch :: Maybe Text
$sel:copySourceIfMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
copySourceIfMatch} -> Maybe Text
copySourceIfMatch) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe Text
a -> UploadPartCopy
s {$sel:copySourceIfMatch:UploadPartCopy' :: Maybe Text
copySourceIfMatch = Maybe Text
a} :: UploadPartCopy)

-- | Copies the object if it has been modified since the specified time.
uploadPartCopy_copySourceIfModifiedSince :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.UTCTime)
uploadPartCopy_copySourceIfModifiedSince :: Lens' UploadPartCopy (Maybe UTCTime)
uploadPartCopy_copySourceIfModifiedSince = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe RFC822
copySourceIfModifiedSince :: Maybe RFC822
$sel:copySourceIfModifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
copySourceIfModifiedSince} -> Maybe RFC822
copySourceIfModifiedSince) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe RFC822
a -> UploadPartCopy
s {$sel:copySourceIfModifiedSince:UploadPartCopy' :: Maybe RFC822
copySourceIfModifiedSince = Maybe RFC822
a} :: UploadPartCopy) 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

-- | Copies the object if its entity tag (ETag) is different than the
-- specified ETag.
uploadPartCopy_copySourceIfNoneMatch :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_copySourceIfNoneMatch :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_copySourceIfNoneMatch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe Text
copySourceIfNoneMatch :: Maybe Text
$sel:copySourceIfNoneMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
copySourceIfNoneMatch} -> Maybe Text
copySourceIfNoneMatch) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe Text
a -> UploadPartCopy
s {$sel:copySourceIfNoneMatch:UploadPartCopy' :: Maybe Text
copySourceIfNoneMatch = Maybe Text
a} :: UploadPartCopy)

-- | Copies the object if it hasn\'t been modified since the specified time.
uploadPartCopy_copySourceIfUnmodifiedSince :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.UTCTime)
uploadPartCopy_copySourceIfUnmodifiedSince :: Lens' UploadPartCopy (Maybe UTCTime)
uploadPartCopy_copySourceIfUnmodifiedSince = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe RFC822
copySourceIfUnmodifiedSince :: Maybe RFC822
$sel:copySourceIfUnmodifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
copySourceIfUnmodifiedSince} -> Maybe RFC822
copySourceIfUnmodifiedSince) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe RFC822
a -> UploadPartCopy
s {$sel:copySourceIfUnmodifiedSince:UploadPartCopy' :: Maybe RFC822
copySourceIfUnmodifiedSince = Maybe RFC822
a} :: UploadPartCopy) 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

-- | The range of bytes to copy from the source object. The range value must
-- use the form bytes=first-last, where the first and last are the
-- zero-based byte offsets to copy. For example, bytes=0-9 indicates that
-- you want to copy the first 10 bytes of the source. You can copy a range
-- only if the source object is greater than 5 MB.
uploadPartCopy_copySourceRange :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_copySourceRange :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_copySourceRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe Text
copySourceRange :: Maybe Text
$sel:copySourceRange:UploadPartCopy' :: UploadPartCopy -> Maybe Text
copySourceRange} -> Maybe Text
copySourceRange) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe Text
a -> UploadPartCopy
s {$sel:copySourceRange:UploadPartCopy' :: Maybe Text
copySourceRange = Maybe Text
a} :: UploadPartCopy)

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

-- | Specifies the customer-provided encryption key for Amazon S3 to use to
-- decrypt the source object. The encryption key provided in this header
-- must be one that was used when the source object was created.
uploadPartCopy_copySourceSSECustomerKey :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_copySourceSSECustomerKey :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_copySourceSSECustomerKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe (Sensitive Text)
copySourceSSECustomerKey :: Maybe (Sensitive Text)
$sel:copySourceSSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
copySourceSSECustomerKey} -> Maybe (Sensitive Text)
copySourceSSECustomerKey) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe (Sensitive Text)
a -> UploadPartCopy
s {$sel:copySourceSSECustomerKey:UploadPartCopy' :: Maybe (Sensitive Text)
copySourceSSECustomerKey = Maybe (Sensitive Text)
a} :: UploadPartCopy) 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.
uploadPartCopy_copySourceSSECustomerKeyMD5 :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_copySourceSSECustomerKeyMD5 :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_copySourceSSECustomerKeyMD5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe Text
copySourceSSECustomerKeyMD5 :: Maybe Text
$sel:copySourceSSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
copySourceSSECustomerKeyMD5} -> Maybe Text
copySourceSSECustomerKeyMD5) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe Text
a -> UploadPartCopy
s {$sel:copySourceSSECustomerKeyMD5:UploadPartCopy' :: Maybe Text
copySourceSSECustomerKeyMD5 = Maybe Text
a} :: UploadPartCopy)

-- | The account ID of the expected destination bucket owner. If the
-- destination bucket is owned by a different account, the request fails
-- with the HTTP status code @403 Forbidden@ (access denied).
uploadPartCopy_expectedBucketOwner :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_expectedBucketOwner :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_expectedBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe Text
expectedBucketOwner :: Maybe Text
$sel:expectedBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
expectedBucketOwner} -> Maybe Text
expectedBucketOwner) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe Text
a -> UploadPartCopy
s {$sel:expectedBucketOwner:UploadPartCopy' :: Maybe Text
expectedBucketOwner = Maybe Text
a} :: UploadPartCopy)

-- | The account ID of the expected source bucket owner. If the source bucket
-- is owned by a different account, the request fails with the HTTP status
-- code @403 Forbidden@ (access denied).
uploadPartCopy_expectedSourceBucketOwner :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_expectedSourceBucketOwner :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_expectedSourceBucketOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe Text
expectedSourceBucketOwner :: Maybe Text
$sel:expectedSourceBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
expectedSourceBucketOwner} -> Maybe Text
expectedSourceBucketOwner) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe Text
a -> UploadPartCopy
s {$sel:expectedSourceBucketOwner:UploadPartCopy' :: Maybe Text
expectedSourceBucketOwner = Maybe Text
a} :: UploadPartCopy)

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

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

-- | 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. This must be
-- the same encryption key specified in the initiate multipart upload
-- request.
uploadPartCopy_sSECustomerKey :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_sSECustomerKey :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_sSECustomerKey = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe (Sensitive Text)
sSECustomerKey :: Maybe (Sensitive Text)
$sel:sSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
sSECustomerKey} -> Maybe (Sensitive Text)
sSECustomerKey) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe (Sensitive Text)
a -> UploadPartCopy
s {$sel:sSECustomerKey:UploadPartCopy' :: Maybe (Sensitive Text)
sSECustomerKey = Maybe (Sensitive Text)
a} :: UploadPartCopy) 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.
uploadPartCopy_sSECustomerKeyMD5 :: Lens.Lens' UploadPartCopy (Prelude.Maybe Prelude.Text)
uploadPartCopy_sSECustomerKeyMD5 :: Lens' UploadPartCopy (Maybe Text)
uploadPartCopy_sSECustomerKeyMD5 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Maybe Text
sSECustomerKeyMD5 :: Maybe Text
$sel:sSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
sSECustomerKeyMD5} -> Maybe Text
sSECustomerKeyMD5) (\s :: UploadPartCopy
s@UploadPartCopy' {} Maybe Text
a -> UploadPartCopy
s {$sel:sSECustomerKeyMD5:UploadPartCopy' :: Maybe Text
sSECustomerKeyMD5 = Maybe Text
a} :: UploadPartCopy)

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

-- | Specifies the source object for the copy operation. You specify the
-- value in one of two formats, depending on whether you want to access the
-- source object through an
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/access-points.html access point>:
--
-- -   For objects not accessed through an access point, specify the name
--     of the source bucket and key of the source object, separated by a
--     slash (\/). For example, to copy the object @reports\/january.pdf@
--     from the bucket @awsexamplebucket@, use
--     @awsexamplebucket\/reports\/january.pdf@. The value must be
--     URL-encoded.
--
-- -   For objects accessed through access points, specify the Amazon
--     Resource Name (ARN) of the object as accessed through the access
--     point, in the format
--     @arn:aws:s3:\<Region>:\<account-id>:accesspoint\/\<access-point-name>\/object\/\<key>@.
--     For example, to copy the object @reports\/january.pdf@ through
--     access point @my-access-point@ owned by account @123456789012@ in
--     Region @us-west-2@, use the URL encoding of
--     @arn:aws:s3:us-west-2:123456789012:accesspoint\/my-access-point\/object\/reports\/january.pdf@.
--     The value must be URL encoded.
--
--     Amazon S3 supports copy operations using access points only when the
--     source and destination buckets are in the same Amazon Web Services
--     Region.
--
--     Alternatively, for objects accessed through Amazon S3 on Outposts,
--     specify the ARN of the object as accessed in the format
--     @arn:aws:s3-outposts:\<Region>:\<account-id>:outpost\/\<outpost-id>\/object\/\<key>@.
--     For example, to copy the object @reports\/january.pdf@ through
--     outpost @my-outpost@ owned by account @123456789012@ in Region
--     @us-west-2@, use the URL encoding of
--     @arn:aws:s3-outposts:us-west-2:123456789012:outpost\/my-outpost\/object\/reports\/january.pdf@.
--     The value must be URL-encoded.
--
-- To copy a specific version of an object, append
-- @?versionId=\<version-id>@ to the value (for example,
-- @awsexamplebucket\/reports\/january.pdf?versionId=QUpfdndhfd8438MNFDN93jdnJFkdmqnh893@).
-- If you don\'t specify a version ID, Amazon S3 copies the latest version
-- of the source object.
uploadPartCopy_copySource :: Lens.Lens' UploadPartCopy Prelude.Text
uploadPartCopy_copySource :: Lens' UploadPartCopy Text
uploadPartCopy_copySource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Text
copySource :: Text
$sel:copySource:UploadPartCopy' :: UploadPartCopy -> Text
copySource} -> Text
copySource) (\s :: UploadPartCopy
s@UploadPartCopy' {} Text
a -> UploadPartCopy
s {$sel:copySource:UploadPartCopy' :: Text
copySource = Text
a} :: UploadPartCopy)

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

-- | Part number of part being copied. This is a positive integer between 1
-- and 10,000.
uploadPartCopy_partNumber :: Lens.Lens' UploadPartCopy Prelude.Int
uploadPartCopy_partNumber :: Lens' UploadPartCopy Int
uploadPartCopy_partNumber = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Int
partNumber :: Int
$sel:partNumber:UploadPartCopy' :: UploadPartCopy -> Int
partNumber} -> Int
partNumber) (\s :: UploadPartCopy
s@UploadPartCopy' {} Int
a -> UploadPartCopy
s {$sel:partNumber:UploadPartCopy' :: Int
partNumber = Int
a} :: UploadPartCopy)

-- | Upload ID identifying the multipart upload whose part is being copied.
uploadPartCopy_uploadId :: Lens.Lens' UploadPartCopy Prelude.Text
uploadPartCopy_uploadId :: Lens' UploadPartCopy Text
uploadPartCopy_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopy' {Text
uploadId :: Text
$sel:uploadId:UploadPartCopy' :: UploadPartCopy -> Text
uploadId} -> Text
uploadId) (\s :: UploadPartCopy
s@UploadPartCopy' {} Text
a -> UploadPartCopy
s {$sel:uploadId:UploadPartCopy' :: Text
uploadId = Text
a} :: UploadPartCopy)

instance Core.AWSRequest UploadPartCopy where
  type
    AWSResponse UploadPartCopy =
      UploadPartCopyResponse
  request :: (Service -> Service) -> UploadPartCopy -> Request UploadPartCopy
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.put (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UploadPartCopy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UploadPartCopy)))
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 Bool
-> Maybe CopyPartResult
-> Maybe Text
-> Maybe RequestCharged
-> Maybe Text
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe ServerSideEncryption
-> Int
-> UploadPartCopyResponse
UploadPartCopyResponse'
            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-server-side-encryption-bucket-key-enabled"
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-copy-source-version-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-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-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))
      )

instance Prelude.Hashable UploadPartCopy where
  hashWithSalt :: Int -> UploadPartCopy -> Int
hashWithSalt Int
_salt UploadPartCopy' {Int
Maybe Text
Maybe (Sensitive Text)
Maybe RFC822
Maybe RequestPayer
Text
ObjectKey
BucketName
uploadId :: Text
partNumber :: Int
key :: ObjectKey
copySource :: Text
bucket :: BucketName
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
expectedSourceBucketOwner :: Maybe Text
expectedBucketOwner :: Maybe Text
copySourceSSECustomerKeyMD5 :: Maybe Text
copySourceSSECustomerKey :: Maybe (Sensitive Text)
copySourceSSECustomerAlgorithm :: Maybe Text
copySourceRange :: Maybe Text
copySourceIfUnmodifiedSince :: Maybe RFC822
copySourceIfNoneMatch :: Maybe Text
copySourceIfModifiedSince :: Maybe RFC822
copySourceIfMatch :: Maybe Text
$sel:uploadId:UploadPartCopy' :: UploadPartCopy -> Text
$sel:partNumber:UploadPartCopy' :: UploadPartCopy -> Int
$sel:key:UploadPartCopy' :: UploadPartCopy -> ObjectKey
$sel:copySource:UploadPartCopy' :: UploadPartCopy -> Text
$sel:bucket:UploadPartCopy' :: UploadPartCopy -> BucketName
$sel:sSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:sSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:requestPayer:UploadPartCopy' :: UploadPartCopy -> Maybe RequestPayer
$sel:expectedSourceBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:expectedBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:copySourceSSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceRange:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfUnmodifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfNoneMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfModifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
copySourceIfMatch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RFC822
copySourceIfModifiedSince
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
copySourceIfNoneMatch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RFC822
copySourceIfUnmodifiedSince
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
copySourceRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
copySourceSSECustomerAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
copySourceSSECustomerKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
copySourceSSECustomerKeyMD5
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedBucketOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
expectedSourceBucketOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RequestPayer
requestPayer
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sSECustomerAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
sSECustomerKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sSECustomerKeyMD5
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` BucketName
bucket
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
copySource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectKey
key
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
partNumber
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
uploadId

instance Prelude.NFData UploadPartCopy where
  rnf :: UploadPartCopy -> ()
rnf UploadPartCopy' {Int
Maybe Text
Maybe (Sensitive Text)
Maybe RFC822
Maybe RequestPayer
Text
ObjectKey
BucketName
uploadId :: Text
partNumber :: Int
key :: ObjectKey
copySource :: Text
bucket :: BucketName
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
expectedSourceBucketOwner :: Maybe Text
expectedBucketOwner :: Maybe Text
copySourceSSECustomerKeyMD5 :: Maybe Text
copySourceSSECustomerKey :: Maybe (Sensitive Text)
copySourceSSECustomerAlgorithm :: Maybe Text
copySourceRange :: Maybe Text
copySourceIfUnmodifiedSince :: Maybe RFC822
copySourceIfNoneMatch :: Maybe Text
copySourceIfModifiedSince :: Maybe RFC822
copySourceIfMatch :: Maybe Text
$sel:uploadId:UploadPartCopy' :: UploadPartCopy -> Text
$sel:partNumber:UploadPartCopy' :: UploadPartCopy -> Int
$sel:key:UploadPartCopy' :: UploadPartCopy -> ObjectKey
$sel:copySource:UploadPartCopy' :: UploadPartCopy -> Text
$sel:bucket:UploadPartCopy' :: UploadPartCopy -> BucketName
$sel:sSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:sSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:requestPayer:UploadPartCopy' :: UploadPartCopy -> Maybe RequestPayer
$sel:expectedSourceBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:expectedBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:copySourceSSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceRange:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfUnmodifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfNoneMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfModifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
copySourceIfMatch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RFC822
copySourceIfModifiedSince
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
copySourceIfNoneMatch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RFC822
copySourceIfUnmodifiedSince
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
copySourceRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
copySourceSSECustomerAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
copySourceSSECustomerKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
copySourceSSECustomerKeyMD5
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expectedBucketOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
expectedSourceBucketOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestPayer
requestPayer
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sSECustomerAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
sSECustomerKey
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sSECustomerKeyMD5
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf BucketName
bucket
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
copySource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ObjectKey
key
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
partNumber
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
uploadId

instance Data.ToHeaders UploadPartCopy where
  toHeaders :: UploadPartCopy -> ResponseHeaders
toHeaders UploadPartCopy' {Int
Maybe Text
Maybe (Sensitive Text)
Maybe RFC822
Maybe RequestPayer
Text
ObjectKey
BucketName
uploadId :: Text
partNumber :: Int
key :: ObjectKey
copySource :: Text
bucket :: BucketName
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
expectedSourceBucketOwner :: Maybe Text
expectedBucketOwner :: Maybe Text
copySourceSSECustomerKeyMD5 :: Maybe Text
copySourceSSECustomerKey :: Maybe (Sensitive Text)
copySourceSSECustomerAlgorithm :: Maybe Text
copySourceRange :: Maybe Text
copySourceIfUnmodifiedSince :: Maybe RFC822
copySourceIfNoneMatch :: Maybe Text
copySourceIfModifiedSince :: Maybe RFC822
copySourceIfMatch :: Maybe Text
$sel:uploadId:UploadPartCopy' :: UploadPartCopy -> Text
$sel:partNumber:UploadPartCopy' :: UploadPartCopy -> Int
$sel:key:UploadPartCopy' :: UploadPartCopy -> ObjectKey
$sel:copySource:UploadPartCopy' :: UploadPartCopy -> Text
$sel:bucket:UploadPartCopy' :: UploadPartCopy -> BucketName
$sel:sSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:sSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:requestPayer:UploadPartCopy' :: UploadPartCopy -> Maybe RequestPayer
$sel:expectedSourceBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:expectedBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:copySourceSSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceRange:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfUnmodifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfNoneMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfModifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-copy-source-if-match"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
copySourceIfMatch,
        HeaderName
"x-amz-copy-source-if-modified-since"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe RFC822
copySourceIfModifiedSince,
        HeaderName
"x-amz-copy-source-if-none-match"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
copySourceIfNoneMatch,
        HeaderName
"x-amz-copy-source-if-unmodified-since"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe RFC822
copySourceIfUnmodifiedSince,
        HeaderName
"x-amz-copy-source-range" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
copySourceRange,
        HeaderName
"x-amz-copy-source-server-side-encryption-customer-algorithm"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
copySourceSSECustomerAlgorithm,
        HeaderName
"x-amz-copy-source-server-side-encryption-customer-key"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe (Sensitive Text)
copySourceSSECustomerKey,
        HeaderName
"x-amz-copy-source-server-side-encryption-customer-key-MD5"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
copySourceSSECustomerKeyMD5,
        HeaderName
"x-amz-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
expectedBucketOwner,
        HeaderName
"x-amz-source-expected-bucket-owner"
          forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Maybe Text
expectedSourceBucketOwner,
        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-copy-source" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
copySource
      ]

instance Data.ToPath UploadPartCopy where
  toPath :: UploadPartCopy -> ByteString
toPath UploadPartCopy' {Int
Maybe Text
Maybe (Sensitive Text)
Maybe RFC822
Maybe RequestPayer
Text
ObjectKey
BucketName
uploadId :: Text
partNumber :: Int
key :: ObjectKey
copySource :: Text
bucket :: BucketName
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
expectedSourceBucketOwner :: Maybe Text
expectedBucketOwner :: Maybe Text
copySourceSSECustomerKeyMD5 :: Maybe Text
copySourceSSECustomerKey :: Maybe (Sensitive Text)
copySourceSSECustomerAlgorithm :: Maybe Text
copySourceRange :: Maybe Text
copySourceIfUnmodifiedSince :: Maybe RFC822
copySourceIfNoneMatch :: Maybe Text
copySourceIfModifiedSince :: Maybe RFC822
copySourceIfMatch :: Maybe Text
$sel:uploadId:UploadPartCopy' :: UploadPartCopy -> Text
$sel:partNumber:UploadPartCopy' :: UploadPartCopy -> Int
$sel:key:UploadPartCopy' :: UploadPartCopy -> ObjectKey
$sel:copySource:UploadPartCopy' :: UploadPartCopy -> Text
$sel:bucket:UploadPartCopy' :: UploadPartCopy -> BucketName
$sel:sSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:sSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:requestPayer:UploadPartCopy' :: UploadPartCopy -> Maybe RequestPayer
$sel:expectedSourceBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:expectedBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:copySourceSSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceRange:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfUnmodifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfNoneMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfModifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS BucketName
bucket, ByteString
"/", forall a. ToByteString a => a -> ByteString
Data.toBS ObjectKey
key]

instance Data.ToQuery UploadPartCopy where
  toQuery :: UploadPartCopy -> QueryString
toQuery UploadPartCopy' {Int
Maybe Text
Maybe (Sensitive Text)
Maybe RFC822
Maybe RequestPayer
Text
ObjectKey
BucketName
uploadId :: Text
partNumber :: Int
key :: ObjectKey
copySource :: Text
bucket :: BucketName
sSECustomerKeyMD5 :: Maybe Text
sSECustomerKey :: Maybe (Sensitive Text)
sSECustomerAlgorithm :: Maybe Text
requestPayer :: Maybe RequestPayer
expectedSourceBucketOwner :: Maybe Text
expectedBucketOwner :: Maybe Text
copySourceSSECustomerKeyMD5 :: Maybe Text
copySourceSSECustomerKey :: Maybe (Sensitive Text)
copySourceSSECustomerAlgorithm :: Maybe Text
copySourceRange :: Maybe Text
copySourceIfUnmodifiedSince :: Maybe RFC822
copySourceIfNoneMatch :: Maybe Text
copySourceIfModifiedSince :: Maybe RFC822
copySourceIfMatch :: Maybe Text
$sel:uploadId:UploadPartCopy' :: UploadPartCopy -> Text
$sel:partNumber:UploadPartCopy' :: UploadPartCopy -> Int
$sel:key:UploadPartCopy' :: UploadPartCopy -> ObjectKey
$sel:copySource:UploadPartCopy' :: UploadPartCopy -> Text
$sel:bucket:UploadPartCopy' :: UploadPartCopy -> BucketName
$sel:sSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:sSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:sSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:requestPayer:UploadPartCopy' :: UploadPartCopy -> Maybe RequestPayer
$sel:expectedSourceBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:expectedBucketOwner:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKeyMD5:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceSSECustomerKey:UploadPartCopy' :: UploadPartCopy -> Maybe (Sensitive Text)
$sel:copySourceSSECustomerAlgorithm:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceRange:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfUnmodifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfNoneMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
$sel:copySourceIfModifiedSince:UploadPartCopy' :: UploadPartCopy -> Maybe RFC822
$sel:copySourceIfMatch:UploadPartCopy' :: UploadPartCopy -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"partNumber" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Int
partNumber,
        ByteString
"uploadId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
uploadId
      ]

-- | /See:/ 'newUploadPartCopyResponse' smart constructor.
data UploadPartCopyResponse = UploadPartCopyResponse'
  { -- | Indicates whether the multipart upload uses an S3 Bucket Key for
    -- server-side encryption with Amazon Web Services KMS (SSE-KMS).
    UploadPartCopyResponse -> Maybe Bool
bucketKeyEnabled :: Prelude.Maybe Prelude.Bool,
    -- | Container for all response elements.
    UploadPartCopyResponse -> Maybe CopyPartResult
copyPartResult :: Prelude.Maybe CopyPartResult,
    -- | The version of the source object that was copied, if you have enabled
    -- versioning on the source bucket.
    UploadPartCopyResponse -> Maybe Text
copySourceVersionId :: Prelude.Maybe Prelude.Text,
    UploadPartCopyResponse -> 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.
    UploadPartCopyResponse -> 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.
    UploadPartCopyResponse -> Maybe Text
sSECustomerKeyMD5 :: Prelude.Maybe 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.
    UploadPartCopyResponse -> 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).
    UploadPartCopyResponse -> Maybe ServerSideEncryption
serverSideEncryption :: Prelude.Maybe ServerSideEncryption,
    -- | The response's http status code.
    UploadPartCopyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UploadPartCopyResponse -> UploadPartCopyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadPartCopyResponse -> UploadPartCopyResponse -> Bool
$c/= :: UploadPartCopyResponse -> UploadPartCopyResponse -> Bool
== :: UploadPartCopyResponse -> UploadPartCopyResponse -> Bool
$c== :: UploadPartCopyResponse -> UploadPartCopyResponse -> Bool
Prelude.Eq, Int -> UploadPartCopyResponse -> ShowS
[UploadPartCopyResponse] -> ShowS
UploadPartCopyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadPartCopyResponse] -> ShowS
$cshowList :: [UploadPartCopyResponse] -> ShowS
show :: UploadPartCopyResponse -> String
$cshow :: UploadPartCopyResponse -> String
showsPrec :: Int -> UploadPartCopyResponse -> ShowS
$cshowsPrec :: Int -> UploadPartCopyResponse -> ShowS
Prelude.Show, forall x. Rep UploadPartCopyResponse x -> UploadPartCopyResponse
forall x. UploadPartCopyResponse -> Rep UploadPartCopyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadPartCopyResponse x -> UploadPartCopyResponse
$cfrom :: forall x. UploadPartCopyResponse -> Rep UploadPartCopyResponse x
Prelude.Generic)

-- |
-- Create a value of 'UploadPartCopyResponse' 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:
--
-- 'bucketKeyEnabled', 'uploadPartCopyResponse_bucketKeyEnabled' - Indicates whether the multipart upload uses an S3 Bucket Key for
-- server-side encryption with Amazon Web Services KMS (SSE-KMS).
--
-- 'copyPartResult', 'uploadPartCopyResponse_copyPartResult' - Container for all response elements.
--
-- 'copySourceVersionId', 'uploadPartCopyResponse_copySourceVersionId' - The version of the source object that was copied, if you have enabled
-- versioning on the source bucket.
--
-- 'requestCharged', 'uploadPartCopyResponse_requestCharged' - Undocumented member.
--
-- 'sSECustomerAlgorithm', 'uploadPartCopyResponse_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', 'uploadPartCopyResponse_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.
--
-- 'sSEKMSKeyId', 'uploadPartCopyResponse_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', 'uploadPartCopyResponse_serverSideEncryption' - The server-side encryption algorithm used when storing this object in
-- Amazon S3 (for example, AES256, aws:kms).
--
-- 'httpStatus', 'uploadPartCopyResponse_httpStatus' - The response's http status code.
newUploadPartCopyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UploadPartCopyResponse
newUploadPartCopyResponse :: Int -> UploadPartCopyResponse
newUploadPartCopyResponse Int
pHttpStatus_ =
  UploadPartCopyResponse'
    { $sel:bucketKeyEnabled:UploadPartCopyResponse' :: Maybe Bool
bucketKeyEnabled =
        forall a. Maybe a
Prelude.Nothing,
      $sel:copyPartResult:UploadPartCopyResponse' :: Maybe CopyPartResult
copyPartResult = forall a. Maybe a
Prelude.Nothing,
      $sel:copySourceVersionId:UploadPartCopyResponse' :: Maybe Text
copySourceVersionId = forall a. Maybe a
Prelude.Nothing,
      $sel:requestCharged:UploadPartCopyResponse' :: Maybe RequestCharged
requestCharged = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerAlgorithm:UploadPartCopyResponse' :: Maybe Text
sSECustomerAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:sSECustomerKeyMD5:UploadPartCopyResponse' :: Maybe Text
sSECustomerKeyMD5 = forall a. Maybe a
Prelude.Nothing,
      $sel:sSEKMSKeyId:UploadPartCopyResponse' :: Maybe (Sensitive Text)
sSEKMSKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:serverSideEncryption:UploadPartCopyResponse' :: Maybe ServerSideEncryption
serverSideEncryption = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UploadPartCopyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | Container for all response elements.
uploadPartCopyResponse_copyPartResult :: Lens.Lens' UploadPartCopyResponse (Prelude.Maybe CopyPartResult)
uploadPartCopyResponse_copyPartResult :: Lens' UploadPartCopyResponse (Maybe CopyPartResult)
uploadPartCopyResponse_copyPartResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopyResponse' {Maybe CopyPartResult
copyPartResult :: Maybe CopyPartResult
$sel:copyPartResult:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe CopyPartResult
copyPartResult} -> Maybe CopyPartResult
copyPartResult) (\s :: UploadPartCopyResponse
s@UploadPartCopyResponse' {} Maybe CopyPartResult
a -> UploadPartCopyResponse
s {$sel:copyPartResult:UploadPartCopyResponse' :: Maybe CopyPartResult
copyPartResult = Maybe CopyPartResult
a} :: UploadPartCopyResponse)

-- | The version of the source object that was copied, if you have enabled
-- versioning on the source bucket.
uploadPartCopyResponse_copySourceVersionId :: Lens.Lens' UploadPartCopyResponse (Prelude.Maybe Prelude.Text)
uploadPartCopyResponse_copySourceVersionId :: Lens' UploadPartCopyResponse (Maybe Text)
uploadPartCopyResponse_copySourceVersionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopyResponse' {Maybe Text
copySourceVersionId :: Maybe Text
$sel:copySourceVersionId:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe Text
copySourceVersionId} -> Maybe Text
copySourceVersionId) (\s :: UploadPartCopyResponse
s@UploadPartCopyResponse' {} Maybe Text
a -> UploadPartCopyResponse
s {$sel:copySourceVersionId:UploadPartCopyResponse' :: Maybe Text
copySourceVersionId = Maybe Text
a} :: UploadPartCopyResponse)

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

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

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

-- | 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.
uploadPartCopyResponse_sSEKMSKeyId :: Lens.Lens' UploadPartCopyResponse (Prelude.Maybe Prelude.Text)
uploadPartCopyResponse_sSEKMSKeyId :: Lens' UploadPartCopyResponse (Maybe Text)
uploadPartCopyResponse_sSEKMSKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopyResponse' {Maybe (Sensitive Text)
sSEKMSKeyId :: Maybe (Sensitive Text)
$sel:sSEKMSKeyId:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe (Sensitive Text)
sSEKMSKeyId} -> Maybe (Sensitive Text)
sSEKMSKeyId) (\s :: UploadPartCopyResponse
s@UploadPartCopyResponse' {} Maybe (Sensitive Text)
a -> UploadPartCopyResponse
s {$sel:sSEKMSKeyId:UploadPartCopyResponse' :: Maybe (Sensitive Text)
sSEKMSKeyId = Maybe (Sensitive Text)
a} :: UploadPartCopyResponse) 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).
uploadPartCopyResponse_serverSideEncryption :: Lens.Lens' UploadPartCopyResponse (Prelude.Maybe ServerSideEncryption)
uploadPartCopyResponse_serverSideEncryption :: Lens' UploadPartCopyResponse (Maybe ServerSideEncryption)
uploadPartCopyResponse_serverSideEncryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadPartCopyResponse' {Maybe ServerSideEncryption
serverSideEncryption :: Maybe ServerSideEncryption
$sel:serverSideEncryption:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe ServerSideEncryption
serverSideEncryption} -> Maybe ServerSideEncryption
serverSideEncryption) (\s :: UploadPartCopyResponse
s@UploadPartCopyResponse' {} Maybe ServerSideEncryption
a -> UploadPartCopyResponse
s {$sel:serverSideEncryption:UploadPartCopyResponse' :: Maybe ServerSideEncryption
serverSideEncryption = Maybe ServerSideEncryption
a} :: UploadPartCopyResponse)

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

instance Prelude.NFData UploadPartCopyResponse where
  rnf :: UploadPartCopyResponse -> ()
rnf UploadPartCopyResponse' {Int
Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Maybe CopyPartResult
Maybe RequestCharged
Maybe ServerSideEncryption
httpStatus :: Int
serverSideEncryption :: Maybe ServerSideEncryption
sSEKMSKeyId :: Maybe (Sensitive Text)
sSECustomerKeyMD5 :: Maybe Text
sSECustomerAlgorithm :: Maybe Text
requestCharged :: Maybe RequestCharged
copySourceVersionId :: Maybe Text
copyPartResult :: Maybe CopyPartResult
bucketKeyEnabled :: Maybe Bool
$sel:httpStatus:UploadPartCopyResponse' :: UploadPartCopyResponse -> Int
$sel:serverSideEncryption:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe ServerSideEncryption
$sel:sSEKMSKeyId:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe (Sensitive Text)
$sel:sSECustomerKeyMD5:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe Text
$sel:sSECustomerAlgorithm:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe Text
$sel:requestCharged:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe RequestCharged
$sel:copySourceVersionId:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe Text
$sel:copyPartResult:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe CopyPartResult
$sel:bucketKeyEnabled:UploadPartCopyResponse' :: UploadPartCopyResponse -> Maybe Bool
..} =
    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 CopyPartResult
copyPartResult
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
copySourceVersionId
      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)
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