{-# 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.Glacier.UploadMultipartPart
-- 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 operation uploads a part of an archive. You can upload archive
-- parts in any order. You can also upload them in parallel. You can upload
-- up to 10,000 parts for a multipart upload.
--
-- Amazon Glacier rejects your upload part request if any of the following
-- conditions is true:
--
-- -   __SHA256 tree hash does not match__To ensure that part data is not
--     corrupted in transmission, you compute a SHA256 tree hash of the
--     part and include it in your request. Upon receiving the part data,
--     Amazon S3 Glacier also computes a SHA256 tree hash. If these hash
--     values don\'t match, the operation fails. For information about
--     computing a SHA256 tree hash, see
--     <https://docs.aws.amazon.com/amazonglacier/latest/dev/checksum-calculations.html Computing Checksums>.
--
-- -   __Part size does not match__The size of each part except the last
--     must match the size specified in the corresponding
--     InitiateMultipartUpload request. The size of the last part must be
--     the same size as, or smaller than, the specified size.
--
--     If you upload a part whose size is smaller than the part size you
--     specified in your initiate multipart upload request and that part is
--     not the last part, then the upload part request will succeed.
--     However, the subsequent Complete Multipart Upload request will fail.
--
-- -   __Range does not align__The byte range value in the request does not
--     align with the part size specified in the corresponding initiate
--     request. For example, if you specify a part size of 4194304 bytes (4
--     MB), then 0 to 4194303 bytes (4 MB - 1) and 4194304 (4 MB) to
--     8388607 (8 MB - 1) are valid part ranges. However, if you set a
--     range value of 2 MB to 6 MB, the range does not align with the part
--     size and the upload will fail.
--
-- This operation is idempotent. If you upload the same part multiple
-- times, the data included in the most recent request overwrites the
-- previously uploaded data.
--
-- An AWS account has full permission to perform all operations (actions).
-- However, AWS Identity and Access Management (IAM) users don\'t have any
-- permissions by default. You must grant them explicit permission to
-- perform specific actions. For more information, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/using-iam-with-amazon-glacier.html Access Control Using AWS Identity and Access Management (IAM)>.
--
-- For conceptual information and underlying REST API, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/uploading-archive-mpu.html Uploading Large Archives in Parts (Multipart Upload)>
-- and
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/api-upload-part.html Upload Part>
-- in the /Amazon Glacier Developer Guide/.
module Amazonka.Glacier.UploadMultipartPart
  ( -- * Creating a Request
    UploadMultipartPart (..),
    newUploadMultipartPart,

    -- * Request Lenses
    uploadMultipartPart_accountId,
    uploadMultipartPart_vaultName,
    uploadMultipartPart_uploadId,
    uploadMultipartPart_range,
    uploadMultipartPart_checksum,
    uploadMultipartPart_body,

    -- * Destructuring the Response
    UploadMultipartPartResponse (..),
    newUploadMultipartPartResponse,

    -- * Response Lenses
    uploadMultipartPartResponse_checksum,
    uploadMultipartPartResponse_httpStatus,
  )
where

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

-- | Provides options to upload a part of an archive in a multipart upload
-- operation.
--
-- /See:/ 'newUploadMultipartPart' smart constructor.
data UploadMultipartPart = UploadMultipartPart'
  { -- | The @AccountId@ value is the AWS account ID of the account that owns the
    -- vault. You can either specify an AWS account ID or optionally a single
    -- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
    -- ID associated with the credentials used to sign the request. If you use
    -- an account ID, do not include any hyphens (\'-\') in the ID.
    UploadMultipartPart -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    UploadMultipartPart -> Text
vaultName :: Prelude.Text,
    -- | The upload ID of the multipart upload.
    UploadMultipartPart -> Text
uploadId :: Prelude.Text,
    -- | Identifies the range of bytes in the assembled archive that will be
    -- uploaded in this part. Amazon S3 Glacier uses this information to
    -- assemble the archive in the proper sequence. The format of this header
    -- follows RFC 2616. An example header is Content-Range:bytes 0-4194303\/*.
    UploadMultipartPart -> Text
range :: Prelude.Text,
    -- | The SHA256 tree hash of the data being uploaded.
    UploadMultipartPart -> Text
checksum :: Prelude.Text,
    -- | The data to upload.
    UploadMultipartPart -> HashedBody
body :: Data.HashedBody
  }
  deriving (Int -> UploadMultipartPart -> ShowS
[UploadMultipartPart] -> ShowS
UploadMultipartPart -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadMultipartPart] -> ShowS
$cshowList :: [UploadMultipartPart] -> ShowS
show :: UploadMultipartPart -> String
$cshow :: UploadMultipartPart -> String
showsPrec :: Int -> UploadMultipartPart -> ShowS
$cshowsPrec :: Int -> UploadMultipartPart -> ShowS
Prelude.Show, forall x. Rep UploadMultipartPart x -> UploadMultipartPart
forall x. UploadMultipartPart -> Rep UploadMultipartPart x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UploadMultipartPart x -> UploadMultipartPart
$cfrom :: forall x. UploadMultipartPart -> Rep UploadMultipartPart x
Prelude.Generic)

-- |
-- Create a value of 'UploadMultipartPart' 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:
--
-- 'accountId', 'uploadMultipartPart_accountId' - The @AccountId@ value is the AWS account ID of the account that owns the
-- vault. You can either specify an AWS account ID or optionally a single
-- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
-- ID associated with the credentials used to sign the request. If you use
-- an account ID, do not include any hyphens (\'-\') in the ID.
--
-- 'vaultName', 'uploadMultipartPart_vaultName' - The name of the vault.
--
-- 'uploadId', 'uploadMultipartPart_uploadId' - The upload ID of the multipart upload.
--
-- 'range', 'uploadMultipartPart_range' - Identifies the range of bytes in the assembled archive that will be
-- uploaded in this part. Amazon S3 Glacier uses this information to
-- assemble the archive in the proper sequence. The format of this header
-- follows RFC 2616. An example header is Content-Range:bytes 0-4194303\/*.
--
-- 'checksum', 'uploadMultipartPart_checksum' - The SHA256 tree hash of the data being uploaded.
--
-- 'body', 'uploadMultipartPart_body' - The data to upload.
newUploadMultipartPart ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  -- | 'uploadId'
  Prelude.Text ->
  -- | 'range'
  Prelude.Text ->
  -- | 'checksum'
  Prelude.Text ->
  -- | 'body'
  Data.HashedBody ->
  UploadMultipartPart
newUploadMultipartPart :: Text
-> Text
-> Text
-> Text
-> Text
-> HashedBody
-> UploadMultipartPart
newUploadMultipartPart
  Text
pAccountId_
  Text
pVaultName_
  Text
pUploadId_
  Text
pRange_
  Text
pChecksum_
  HashedBody
pBody_ =
    UploadMultipartPart'
      { $sel:accountId:UploadMultipartPart' :: Text
accountId = Text
pAccountId_,
        $sel:vaultName:UploadMultipartPart' :: Text
vaultName = Text
pVaultName_,
        $sel:uploadId:UploadMultipartPart' :: Text
uploadId = Text
pUploadId_,
        $sel:range:UploadMultipartPart' :: Text
range = Text
pRange_,
        $sel:checksum:UploadMultipartPart' :: Text
checksum = Text
pChecksum_,
        $sel:body:UploadMultipartPart' :: HashedBody
body = HashedBody
pBody_
      }

-- | The @AccountId@ value is the AWS account ID of the account that owns the
-- vault. You can either specify an AWS account ID or optionally a single
-- \'@-@\' (hyphen), in which case Amazon S3 Glacier uses the AWS account
-- ID associated with the credentials used to sign the request. If you use
-- an account ID, do not include any hyphens (\'-\') in the ID.
uploadMultipartPart_accountId :: Lens.Lens' UploadMultipartPart Prelude.Text
uploadMultipartPart_accountId :: Lens' UploadMultipartPart Text
uploadMultipartPart_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadMultipartPart' {Text
accountId :: Text
$sel:accountId:UploadMultipartPart' :: UploadMultipartPart -> Text
accountId} -> Text
accountId) (\s :: UploadMultipartPart
s@UploadMultipartPart' {} Text
a -> UploadMultipartPart
s {$sel:accountId:UploadMultipartPart' :: Text
accountId = Text
a} :: UploadMultipartPart)

-- | The name of the vault.
uploadMultipartPart_vaultName :: Lens.Lens' UploadMultipartPart Prelude.Text
uploadMultipartPart_vaultName :: Lens' UploadMultipartPart Text
uploadMultipartPart_vaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadMultipartPart' {Text
vaultName :: Text
$sel:vaultName:UploadMultipartPart' :: UploadMultipartPart -> Text
vaultName} -> Text
vaultName) (\s :: UploadMultipartPart
s@UploadMultipartPart' {} Text
a -> UploadMultipartPart
s {$sel:vaultName:UploadMultipartPart' :: Text
vaultName = Text
a} :: UploadMultipartPart)

-- | The upload ID of the multipart upload.
uploadMultipartPart_uploadId :: Lens.Lens' UploadMultipartPart Prelude.Text
uploadMultipartPart_uploadId :: Lens' UploadMultipartPart Text
uploadMultipartPart_uploadId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadMultipartPart' {Text
uploadId :: Text
$sel:uploadId:UploadMultipartPart' :: UploadMultipartPart -> Text
uploadId} -> Text
uploadId) (\s :: UploadMultipartPart
s@UploadMultipartPart' {} Text
a -> UploadMultipartPart
s {$sel:uploadId:UploadMultipartPart' :: Text
uploadId = Text
a} :: UploadMultipartPart)

-- | Identifies the range of bytes in the assembled archive that will be
-- uploaded in this part. Amazon S3 Glacier uses this information to
-- assemble the archive in the proper sequence. The format of this header
-- follows RFC 2616. An example header is Content-Range:bytes 0-4194303\/*.
uploadMultipartPart_range :: Lens.Lens' UploadMultipartPart Prelude.Text
uploadMultipartPart_range :: Lens' UploadMultipartPart Text
uploadMultipartPart_range = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadMultipartPart' {Text
range :: Text
$sel:range:UploadMultipartPart' :: UploadMultipartPart -> Text
range} -> Text
range) (\s :: UploadMultipartPart
s@UploadMultipartPart' {} Text
a -> UploadMultipartPart
s {$sel:range:UploadMultipartPart' :: Text
range = Text
a} :: UploadMultipartPart)

-- | The SHA256 tree hash of the data being uploaded.
uploadMultipartPart_checksum :: Lens.Lens' UploadMultipartPart Prelude.Text
uploadMultipartPart_checksum :: Lens' UploadMultipartPart Text
uploadMultipartPart_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadMultipartPart' {Text
checksum :: Text
$sel:checksum:UploadMultipartPart' :: UploadMultipartPart -> Text
checksum} -> Text
checksum) (\s :: UploadMultipartPart
s@UploadMultipartPart' {} Text
a -> UploadMultipartPart
s {$sel:checksum:UploadMultipartPart' :: Text
checksum = Text
a} :: UploadMultipartPart)

-- | The data to upload.
uploadMultipartPart_body :: Lens.Lens' UploadMultipartPart Data.HashedBody
uploadMultipartPart_body :: Lens' UploadMultipartPart HashedBody
uploadMultipartPart_body = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadMultipartPart' {HashedBody
body :: HashedBody
$sel:body:UploadMultipartPart' :: UploadMultipartPart -> HashedBody
body} -> HashedBody
body) (\s :: UploadMultipartPart
s@UploadMultipartPart' {} HashedBody
a -> UploadMultipartPart
s {$sel:body:UploadMultipartPart' :: HashedBody
body = HashedBody
a} :: UploadMultipartPart)

instance Core.AWSRequest UploadMultipartPart where
  type
    AWSResponse UploadMultipartPart =
      UploadMultipartPartResponse
  request :: (Service -> Service)
-> UploadMultipartPart -> Request UploadMultipartPart
request Service -> Service
overrides =
    forall a. ByteString -> Request a -> Request a
Request.glacierVersionHeader (Service -> ByteString
Core.version Service
defaultService)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. (ToRequest a, ToBody a) => Service -> a -> Request a
Request.putBody (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UploadMultipartPart
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UploadMultipartPart)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Maybe Text -> Int -> UploadMultipartPartResponse
UploadMultipartPartResponse'
            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-sha256-tree-hash")
            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 Data.ToBody UploadMultipartPart where
  toBody :: UploadMultipartPart -> RequestBody
toBody UploadMultipartPart' {Text
HashedBody
body :: HashedBody
checksum :: Text
range :: Text
uploadId :: Text
vaultName :: Text
accountId :: Text
$sel:body:UploadMultipartPart' :: UploadMultipartPart -> HashedBody
$sel:checksum:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:range:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:uploadId:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:vaultName:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:accountId:UploadMultipartPart' :: UploadMultipartPart -> Text
..} = forall a. ToBody a => a -> RequestBody
Data.toBody HashedBody
body

instance Data.ToHeaders UploadMultipartPart where
  toHeaders :: UploadMultipartPart -> ResponseHeaders
toHeaders UploadMultipartPart' {Text
HashedBody
body :: HashedBody
checksum :: Text
range :: Text
uploadId :: Text
vaultName :: Text
accountId :: Text
$sel:body:UploadMultipartPart' :: UploadMultipartPart -> HashedBody
$sel:checksum:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:range:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:uploadId:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:vaultName:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:accountId:UploadMultipartPart' :: UploadMultipartPart -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"Content-Range" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
range,
        HeaderName
"x-amz-sha256-tree-hash" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
checksum
      ]

instance Data.ToPath UploadMultipartPart where
  toPath :: UploadMultipartPart -> ByteString
toPath UploadMultipartPart' {Text
HashedBody
body :: HashedBody
checksum :: Text
range :: Text
uploadId :: Text
vaultName :: Text
accountId :: Text
$sel:body:UploadMultipartPart' :: UploadMultipartPart -> HashedBody
$sel:checksum:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:range:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:uploadId:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:vaultName:UploadMultipartPart' :: UploadMultipartPart -> Text
$sel:accountId:UploadMultipartPart' :: UploadMultipartPart -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/vaults/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
vaultName,
        ByteString
"/multipart-uploads/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
uploadId
      ]

instance Data.ToQuery UploadMultipartPart where
  toQuery :: UploadMultipartPart -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Contains the Amazon S3 Glacier response to your request.
--
-- /See:/ 'newUploadMultipartPartResponse' smart constructor.
data UploadMultipartPartResponse = UploadMultipartPartResponse'
  { -- | The SHA256 tree hash that Amazon S3 Glacier computed for the uploaded
    -- part.
    UploadMultipartPartResponse -> Maybe Text
checksum :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UploadMultipartPartResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UploadMultipartPartResponse -> UploadMultipartPartResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UploadMultipartPartResponse -> UploadMultipartPartResponse -> Bool
$c/= :: UploadMultipartPartResponse -> UploadMultipartPartResponse -> Bool
== :: UploadMultipartPartResponse -> UploadMultipartPartResponse -> Bool
$c== :: UploadMultipartPartResponse -> UploadMultipartPartResponse -> Bool
Prelude.Eq, ReadPrec [UploadMultipartPartResponse]
ReadPrec UploadMultipartPartResponse
Int -> ReadS UploadMultipartPartResponse
ReadS [UploadMultipartPartResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UploadMultipartPartResponse]
$creadListPrec :: ReadPrec [UploadMultipartPartResponse]
readPrec :: ReadPrec UploadMultipartPartResponse
$creadPrec :: ReadPrec UploadMultipartPartResponse
readList :: ReadS [UploadMultipartPartResponse]
$creadList :: ReadS [UploadMultipartPartResponse]
readsPrec :: Int -> ReadS UploadMultipartPartResponse
$creadsPrec :: Int -> ReadS UploadMultipartPartResponse
Prelude.Read, Int -> UploadMultipartPartResponse -> ShowS
[UploadMultipartPartResponse] -> ShowS
UploadMultipartPartResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UploadMultipartPartResponse] -> ShowS
$cshowList :: [UploadMultipartPartResponse] -> ShowS
show :: UploadMultipartPartResponse -> String
$cshow :: UploadMultipartPartResponse -> String
showsPrec :: Int -> UploadMultipartPartResponse -> ShowS
$cshowsPrec :: Int -> UploadMultipartPartResponse -> ShowS
Prelude.Show, forall x.
Rep UploadMultipartPartResponse x -> UploadMultipartPartResponse
forall x.
UploadMultipartPartResponse -> Rep UploadMultipartPartResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UploadMultipartPartResponse x -> UploadMultipartPartResponse
$cfrom :: forall x.
UploadMultipartPartResponse -> Rep UploadMultipartPartResponse x
Prelude.Generic)

-- |
-- Create a value of 'UploadMultipartPartResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'checksum', 'uploadMultipartPartResponse_checksum' - The SHA256 tree hash that Amazon S3 Glacier computed for the uploaded
-- part.
--
-- 'httpStatus', 'uploadMultipartPartResponse_httpStatus' - The response's http status code.
newUploadMultipartPartResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UploadMultipartPartResponse
newUploadMultipartPartResponse :: Int -> UploadMultipartPartResponse
newUploadMultipartPartResponse Int
pHttpStatus_ =
  UploadMultipartPartResponse'
    { $sel:checksum:UploadMultipartPartResponse' :: Maybe Text
checksum =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UploadMultipartPartResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The SHA256 tree hash that Amazon S3 Glacier computed for the uploaded
-- part.
uploadMultipartPartResponse_checksum :: Lens.Lens' UploadMultipartPartResponse (Prelude.Maybe Prelude.Text)
uploadMultipartPartResponse_checksum :: Lens' UploadMultipartPartResponse (Maybe Text)
uploadMultipartPartResponse_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UploadMultipartPartResponse' {Maybe Text
checksum :: Maybe Text
$sel:checksum:UploadMultipartPartResponse' :: UploadMultipartPartResponse -> Maybe Text
checksum} -> Maybe Text
checksum) (\s :: UploadMultipartPartResponse
s@UploadMultipartPartResponse' {} Maybe Text
a -> UploadMultipartPartResponse
s {$sel:checksum:UploadMultipartPartResponse' :: Maybe Text
checksum = Maybe Text
a} :: UploadMultipartPartResponse)

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

instance Prelude.NFData UploadMultipartPartResponse where
  rnf :: UploadMultipartPartResponse -> ()
rnf UploadMultipartPartResponse' {Int
Maybe Text
httpStatus :: Int
checksum :: Maybe Text
$sel:httpStatus:UploadMultipartPartResponse' :: UploadMultipartPartResponse -> Int
$sel:checksum:UploadMultipartPartResponse' :: UploadMultipartPartResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
checksum
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus