{-# 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.CompleteMultipartUpload
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- You call this operation to inform Amazon S3 Glacier (Glacier) that all
-- the archive parts have been uploaded and that Glacier can now assemble
-- the archive from the uploaded parts. After assembling and saving the
-- archive to the vault, Glacier returns the URI path of the newly created
-- archive resource. Using the URI path, you can then access the archive.
-- After you upload an archive, you should save the archive ID returned to
-- retrieve the archive at a later point. You can also get the vault
-- inventory to obtain a list of archive IDs in a vault. For more
-- information, see InitiateJob.
--
-- In the request, you must include the computed SHA256 tree hash of the
-- entire archive you have uploaded. For information about computing a
-- SHA256 tree hash, see
-- <https://docs.aws.amazon.com/amazonglacier/latest/dev/checksum-calculations.html Computing Checksums>.
-- On the server side, Glacier also constructs the SHA256 tree hash of the
-- assembled archive. If the values match, Glacier saves the archive to the
-- vault; otherwise, it returns an error, and the operation fails. The
-- ListParts operation returns a list of parts uploaded for a specific
-- multipart upload. It includes checksum information for each uploaded
-- part that can be used to debug a bad checksum issue.
--
-- Additionally, Glacier also checks for any missing content ranges when
-- assembling the archive, if missing content ranges are found, Glacier
-- returns an error and the operation fails.
--
-- Complete Multipart Upload is an idempotent operation. After your first
-- successful complete multipart upload, if you call the operation again
-- within a short period, the operation will succeed and return the same
-- archive ID. This is useful in the event you experience a network issue
-- that causes an aborted connection or receive a 500 server error, in
-- which case you can repeat your Complete Multipart Upload request and get
-- the same archive ID without creating duplicate archives. Note, however,
-- that after the multipart upload completes, you cannot call the List
-- Parts operation and the multipart upload will not appear in List
-- Multipart Uploads response, even if idempotent complete is possible.
--
-- 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-multipart-complete-upload.html Complete Multipart Upload>
-- in the /Amazon Glacier Developer Guide/.
module Amazonka.Glacier.CompleteMultipartUpload
  ( -- * Creating a Request
    CompleteMultipartUpload (..),
    newCompleteMultipartUpload,

    -- * Request Lenses
    completeMultipartUpload_accountId,
    completeMultipartUpload_vaultName,
    completeMultipartUpload_uploadId,
    completeMultipartUpload_archiveSize,
    completeMultipartUpload_checksum,

    -- * Destructuring the Response
    ArchiveCreationOutput (..),
    newArchiveCreationOutput,

    -- * Response Lenses
    archiveCreationOutput_archiveId,
    archiveCreationOutput_checksum,
    archiveCreationOutput_location,
  )
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 complete a multipart upload operation. This informs
-- Amazon Glacier that all the archive parts have been uploaded and Amazon
-- S3 Glacier (Glacier) can now assemble the archive from the uploaded
-- parts. After assembling and saving the archive to the vault, Glacier
-- returns the URI path of the newly created archive resource.
--
-- /See:/ 'newCompleteMultipartUpload' smart constructor.
data CompleteMultipartUpload = CompleteMultipartUpload'
  { -- | 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.
    CompleteMultipartUpload -> Text
accountId :: Prelude.Text,
    -- | The name of the vault.
    CompleteMultipartUpload -> Text
vaultName :: Prelude.Text,
    -- | The upload ID of the multipart upload.
    CompleteMultipartUpload -> Text
uploadId :: Prelude.Text,
    -- | The total size, in bytes, of the entire archive. This value should be
    -- the sum of all the sizes of the individual parts that you uploaded.
    CompleteMultipartUpload -> Text
archiveSize :: Prelude.Text,
    -- | The SHA256 tree hash of the entire archive. It is the tree hash of
    -- SHA256 tree hash of the individual parts. If the value you specify in
    -- the request does not match the SHA256 tree hash of the final assembled
    -- archive as computed by Amazon S3 Glacier (Glacier), Glacier returns an
    -- error and the request fails.
    CompleteMultipartUpload -> Text
checksum :: Prelude.Text
  }
  deriving (CompleteMultipartUpload -> CompleteMultipartUpload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteMultipartUpload -> CompleteMultipartUpload -> Bool
$c/= :: CompleteMultipartUpload -> CompleteMultipartUpload -> Bool
== :: CompleteMultipartUpload -> CompleteMultipartUpload -> Bool
$c== :: CompleteMultipartUpload -> CompleteMultipartUpload -> Bool
Prelude.Eq, ReadPrec [CompleteMultipartUpload]
ReadPrec CompleteMultipartUpload
Int -> ReadS CompleteMultipartUpload
ReadS [CompleteMultipartUpload]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompleteMultipartUpload]
$creadListPrec :: ReadPrec [CompleteMultipartUpload]
readPrec :: ReadPrec CompleteMultipartUpload
$creadPrec :: ReadPrec CompleteMultipartUpload
readList :: ReadS [CompleteMultipartUpload]
$creadList :: ReadS [CompleteMultipartUpload]
readsPrec :: Int -> ReadS CompleteMultipartUpload
$creadsPrec :: Int -> ReadS CompleteMultipartUpload
Prelude.Read, Int -> CompleteMultipartUpload -> ShowS
[CompleteMultipartUpload] -> ShowS
CompleteMultipartUpload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteMultipartUpload] -> ShowS
$cshowList :: [CompleteMultipartUpload] -> ShowS
show :: CompleteMultipartUpload -> String
$cshow :: CompleteMultipartUpload -> String
showsPrec :: Int -> CompleteMultipartUpload -> ShowS
$cshowsPrec :: Int -> CompleteMultipartUpload -> ShowS
Prelude.Show, forall x. Rep CompleteMultipartUpload x -> CompleteMultipartUpload
forall x. CompleteMultipartUpload -> Rep CompleteMultipartUpload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompleteMultipartUpload x -> CompleteMultipartUpload
$cfrom :: forall x. CompleteMultipartUpload -> Rep CompleteMultipartUpload x
Prelude.Generic)

-- |
-- Create a value of 'CompleteMultipartUpload' 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', 'completeMultipartUpload_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', 'completeMultipartUpload_vaultName' - The name of the vault.
--
-- 'uploadId', 'completeMultipartUpload_uploadId' - The upload ID of the multipart upload.
--
-- 'archiveSize', 'completeMultipartUpload_archiveSize' - The total size, in bytes, of the entire archive. This value should be
-- the sum of all the sizes of the individual parts that you uploaded.
--
-- 'checksum', 'completeMultipartUpload_checksum' - The SHA256 tree hash of the entire archive. It is the tree hash of
-- SHA256 tree hash of the individual parts. If the value you specify in
-- the request does not match the SHA256 tree hash of the final assembled
-- archive as computed by Amazon S3 Glacier (Glacier), Glacier returns an
-- error and the request fails.
newCompleteMultipartUpload ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'vaultName'
  Prelude.Text ->
  -- | 'uploadId'
  Prelude.Text ->
  -- | 'archiveSize'
  Prelude.Text ->
  -- | 'checksum'
  Prelude.Text ->
  CompleteMultipartUpload
newCompleteMultipartUpload :: Text -> Text -> Text -> Text -> Text -> CompleteMultipartUpload
newCompleteMultipartUpload
  Text
pAccountId_
  Text
pVaultName_
  Text
pUploadId_
  Text
pArchiveSize_
  Text
pChecksum_ =
    CompleteMultipartUpload'
      { $sel:accountId:CompleteMultipartUpload' :: Text
accountId = Text
pAccountId_,
        $sel:vaultName:CompleteMultipartUpload' :: Text
vaultName = Text
pVaultName_,
        $sel:uploadId:CompleteMultipartUpload' :: Text
uploadId = Text
pUploadId_,
        $sel:archiveSize:CompleteMultipartUpload' :: Text
archiveSize = Text
pArchiveSize_,
        $sel:checksum:CompleteMultipartUpload' :: Text
checksum = Text
pChecksum_
      }

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

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

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

-- | The total size, in bytes, of the entire archive. This value should be
-- the sum of all the sizes of the individual parts that you uploaded.
completeMultipartUpload_archiveSize :: Lens.Lens' CompleteMultipartUpload Prelude.Text
completeMultipartUpload_archiveSize :: Lens' CompleteMultipartUpload Text
completeMultipartUpload_archiveSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteMultipartUpload' {Text
archiveSize :: Text
$sel:archiveSize:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
archiveSize} -> Text
archiveSize) (\s :: CompleteMultipartUpload
s@CompleteMultipartUpload' {} Text
a -> CompleteMultipartUpload
s {$sel:archiveSize:CompleteMultipartUpload' :: Text
archiveSize = Text
a} :: CompleteMultipartUpload)

-- | The SHA256 tree hash of the entire archive. It is the tree hash of
-- SHA256 tree hash of the individual parts. If the value you specify in
-- the request does not match the SHA256 tree hash of the final assembled
-- archive as computed by Amazon S3 Glacier (Glacier), Glacier returns an
-- error and the request fails.
completeMultipartUpload_checksum :: Lens.Lens' CompleteMultipartUpload Prelude.Text
completeMultipartUpload_checksum :: Lens' CompleteMultipartUpload Text
completeMultipartUpload_checksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteMultipartUpload' {Text
checksum :: Text
$sel:checksum:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
checksum} -> Text
checksum) (\s :: CompleteMultipartUpload
s@CompleteMultipartUpload' {} Text
a -> CompleteMultipartUpload
s {$sel:checksum:CompleteMultipartUpload' :: Text
checksum = Text
a} :: CompleteMultipartUpload)

instance Core.AWSRequest CompleteMultipartUpload where
  type
    AWSResponse CompleteMultipartUpload =
      ArchiveCreationOutput
  request :: (Service -> Service)
-> CompleteMultipartUpload -> Request CompleteMultipartUpload
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, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CompleteMultipartUpload
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CompleteMultipartUpload)))
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 -> Maybe Text -> Maybe Text -> ArchiveCreationOutput
ArchiveCreationOutput'
            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-archive-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-sha256-tree-hash")
            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
"Location")
      )

instance Prelude.Hashable CompleteMultipartUpload where
  hashWithSalt :: Int -> CompleteMultipartUpload -> Int
hashWithSalt Int
_salt CompleteMultipartUpload' {Text
checksum :: Text
archiveSize :: Text
uploadId :: Text
vaultName :: Text
accountId :: Text
$sel:checksum:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:archiveSize:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:uploadId:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:vaultName:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:accountId:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
vaultName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
uploadId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
archiveSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
checksum

instance Prelude.NFData CompleteMultipartUpload where
  rnf :: CompleteMultipartUpload -> ()
rnf CompleteMultipartUpload' {Text
checksum :: Text
archiveSize :: Text
uploadId :: Text
vaultName :: Text
accountId :: Text
$sel:checksum:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:archiveSize:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:uploadId:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:vaultName:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:accountId:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
vaultName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
uploadId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
archiveSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
checksum

instance Data.ToHeaders CompleteMultipartUpload where
  toHeaders :: CompleteMultipartUpload -> ResponseHeaders
toHeaders CompleteMultipartUpload' {Text
checksum :: Text
archiveSize :: Text
uploadId :: Text
vaultName :: Text
accountId :: Text
$sel:checksum:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:archiveSize:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:uploadId:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:vaultName:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:accountId:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ HeaderName
"x-amz-archive-size" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
archiveSize,
        HeaderName
"x-amz-sha256-tree-hash" forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# Text
checksum
      ]

instance Data.ToJSON CompleteMultipartUpload where
  toJSON :: CompleteMultipartUpload -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath CompleteMultipartUpload where
  toPath :: CompleteMultipartUpload -> ByteString
toPath CompleteMultipartUpload' {Text
checksum :: Text
archiveSize :: Text
uploadId :: Text
vaultName :: Text
accountId :: Text
$sel:checksum:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:archiveSize:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:uploadId:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:vaultName:CompleteMultipartUpload' :: CompleteMultipartUpload -> Text
$sel:accountId:CompleteMultipartUpload' :: CompleteMultipartUpload -> 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 CompleteMultipartUpload where
  toQuery :: CompleteMultipartUpload -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty