{-# 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.BackupStorage.GetObjectMetadata
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get metadata associated with an Object.
module Amazonka.BackupStorage.GetObjectMetadata
  ( -- * Creating a Request
    GetObjectMetadata (..),
    newGetObjectMetadata,

    -- * Request Lenses
    getObjectMetadata_storageJobId,
    getObjectMetadata_objectToken,

    -- * Destructuring the Response
    GetObjectMetadataResponse (..),
    newGetObjectMetadataResponse,

    -- * Response Lenses
    getObjectMetadataResponse_metadataBlobChecksum,
    getObjectMetadataResponse_metadataBlobChecksumAlgorithm,
    getObjectMetadataResponse_metadataBlobLength,
    getObjectMetadataResponse_metadataString,
    getObjectMetadataResponse_httpStatus,
    getObjectMetadataResponse_metadataBlob,
  )
where

import Amazonka.BackupStorage.Types
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

-- | /See:/ 'newGetObjectMetadata' smart constructor.
data GetObjectMetadata = GetObjectMetadata'
  { -- | Backup job id for the in-progress backup.
    GetObjectMetadata -> Text
storageJobId :: Prelude.Text,
    -- | Object token.
    GetObjectMetadata -> Text
objectToken :: Prelude.Text
  }
  deriving (GetObjectMetadata -> GetObjectMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetObjectMetadata -> GetObjectMetadata -> Bool
$c/= :: GetObjectMetadata -> GetObjectMetadata -> Bool
== :: GetObjectMetadata -> GetObjectMetadata -> Bool
$c== :: GetObjectMetadata -> GetObjectMetadata -> Bool
Prelude.Eq, ReadPrec [GetObjectMetadata]
ReadPrec GetObjectMetadata
Int -> ReadS GetObjectMetadata
ReadS [GetObjectMetadata]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetObjectMetadata]
$creadListPrec :: ReadPrec [GetObjectMetadata]
readPrec :: ReadPrec GetObjectMetadata
$creadPrec :: ReadPrec GetObjectMetadata
readList :: ReadS [GetObjectMetadata]
$creadList :: ReadS [GetObjectMetadata]
readsPrec :: Int -> ReadS GetObjectMetadata
$creadsPrec :: Int -> ReadS GetObjectMetadata
Prelude.Read, Int -> GetObjectMetadata -> ShowS
[GetObjectMetadata] -> ShowS
GetObjectMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectMetadata] -> ShowS
$cshowList :: [GetObjectMetadata] -> ShowS
show :: GetObjectMetadata -> String
$cshow :: GetObjectMetadata -> String
showsPrec :: Int -> GetObjectMetadata -> ShowS
$cshowsPrec :: Int -> GetObjectMetadata -> ShowS
Prelude.Show, forall x. Rep GetObjectMetadata x -> GetObjectMetadata
forall x. GetObjectMetadata -> Rep GetObjectMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetObjectMetadata x -> GetObjectMetadata
$cfrom :: forall x. GetObjectMetadata -> Rep GetObjectMetadata x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectMetadata' 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:
--
-- 'storageJobId', 'getObjectMetadata_storageJobId' - Backup job id for the in-progress backup.
--
-- 'objectToken', 'getObjectMetadata_objectToken' - Object token.
newGetObjectMetadata ::
  -- | 'storageJobId'
  Prelude.Text ->
  -- | 'objectToken'
  Prelude.Text ->
  GetObjectMetadata
newGetObjectMetadata :: Text -> Text -> GetObjectMetadata
newGetObjectMetadata Text
pStorageJobId_ Text
pObjectToken_ =
  GetObjectMetadata'
    { $sel:storageJobId:GetObjectMetadata' :: Text
storageJobId = Text
pStorageJobId_,
      $sel:objectToken:GetObjectMetadata' :: Text
objectToken = Text
pObjectToken_
    }

-- | Backup job id for the in-progress backup.
getObjectMetadata_storageJobId :: Lens.Lens' GetObjectMetadata Prelude.Text
getObjectMetadata_storageJobId :: Lens' GetObjectMetadata Text
getObjectMetadata_storageJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectMetadata' {Text
storageJobId :: Text
$sel:storageJobId:GetObjectMetadata' :: GetObjectMetadata -> Text
storageJobId} -> Text
storageJobId) (\s :: GetObjectMetadata
s@GetObjectMetadata' {} Text
a -> GetObjectMetadata
s {$sel:storageJobId:GetObjectMetadata' :: Text
storageJobId = Text
a} :: GetObjectMetadata)

-- | Object token.
getObjectMetadata_objectToken :: Lens.Lens' GetObjectMetadata Prelude.Text
getObjectMetadata_objectToken :: Lens' GetObjectMetadata Text
getObjectMetadata_objectToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectMetadata' {Text
objectToken :: Text
$sel:objectToken:GetObjectMetadata' :: GetObjectMetadata -> Text
objectToken} -> Text
objectToken) (\s :: GetObjectMetadata
s@GetObjectMetadata' {} Text
a -> GetObjectMetadata
s {$sel:objectToken:GetObjectMetadata' :: Text
objectToken = Text
a} :: GetObjectMetadata)

instance Core.AWSRequest GetObjectMetadata where
  type
    AWSResponse GetObjectMetadata =
      GetObjectMetadataResponse
  request :: (Service -> Service)
-> GetObjectMetadata -> Request GetObjectMetadata
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetObjectMetadata
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetObjectMetadata)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders
 -> ResponseBody
 -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBody
      ( \Int
s ResponseHeaders
h ResponseBody
x ->
          Maybe Text
-> Maybe DataChecksumAlgorithm
-> Maybe Integer
-> Maybe Text
-> Int
-> ResponseBody
-> GetObjectMetadataResponse
GetObjectMetadataResponse'
            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-checksum")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-checksum-algorithm")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"x-amz-data-length")
            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-metadata-string")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ResponseBody
x)
      )

instance Prelude.Hashable GetObjectMetadata where
  hashWithSalt :: Int -> GetObjectMetadata -> Int
hashWithSalt Int
_salt GetObjectMetadata' {Text
objectToken :: Text
storageJobId :: Text
$sel:objectToken:GetObjectMetadata' :: GetObjectMetadata -> Text
$sel:storageJobId:GetObjectMetadata' :: GetObjectMetadata -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
storageJobId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
objectToken

instance Prelude.NFData GetObjectMetadata where
  rnf :: GetObjectMetadata -> ()
rnf GetObjectMetadata' {Text
objectToken :: Text
storageJobId :: Text
$sel:objectToken:GetObjectMetadata' :: GetObjectMetadata -> Text
$sel:storageJobId:GetObjectMetadata' :: GetObjectMetadata -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
storageJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
objectToken

instance Data.ToHeaders GetObjectMetadata where
  toHeaders :: GetObjectMetadata -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetObjectMetadata where
  toPath :: GetObjectMetadata -> ByteString
toPath GetObjectMetadata' {Text
objectToken :: Text
storageJobId :: Text
$sel:objectToken:GetObjectMetadata' :: GetObjectMetadata -> Text
$sel:storageJobId:GetObjectMetadata' :: GetObjectMetadata -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/restore-jobs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
storageJobId,
        ByteString
"/object/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
objectToken,
        ByteString
"/metadata"
      ]

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

-- | /See:/ 'newGetObjectMetadataResponse' smart constructor.
data GetObjectMetadataResponse = GetObjectMetadataResponse'
  { -- | MetadataBlob checksum.
    GetObjectMetadataResponse -> Maybe Text
metadataBlobChecksum :: Prelude.Maybe Prelude.Text,
    -- | Checksum algorithm.
    GetObjectMetadataResponse -> Maybe DataChecksumAlgorithm
metadataBlobChecksumAlgorithm :: Prelude.Maybe DataChecksumAlgorithm,
    -- | The size of MetadataBlob.
    GetObjectMetadataResponse -> Maybe Integer
metadataBlobLength :: Prelude.Maybe Prelude.Integer,
    -- | Metadata string.
    GetObjectMetadataResponse -> Maybe Text
metadataString :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetObjectMetadataResponse -> Int
httpStatus :: Prelude.Int,
    -- | Metadata blob.
    GetObjectMetadataResponse -> ResponseBody
metadataBlob :: Data.ResponseBody
  }
  deriving (Int -> GetObjectMetadataResponse -> ShowS
[GetObjectMetadataResponse] -> ShowS
GetObjectMetadataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetObjectMetadataResponse] -> ShowS
$cshowList :: [GetObjectMetadataResponse] -> ShowS
show :: GetObjectMetadataResponse -> String
$cshow :: GetObjectMetadataResponse -> String
showsPrec :: Int -> GetObjectMetadataResponse -> ShowS
$cshowsPrec :: Int -> GetObjectMetadataResponse -> ShowS
Prelude.Show, forall x.
Rep GetObjectMetadataResponse x -> GetObjectMetadataResponse
forall x.
GetObjectMetadataResponse -> Rep GetObjectMetadataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetObjectMetadataResponse x -> GetObjectMetadataResponse
$cfrom :: forall x.
GetObjectMetadataResponse -> Rep GetObjectMetadataResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetObjectMetadataResponse' 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:
--
-- 'metadataBlobChecksum', 'getObjectMetadataResponse_metadataBlobChecksum' - MetadataBlob checksum.
--
-- 'metadataBlobChecksumAlgorithm', 'getObjectMetadataResponse_metadataBlobChecksumAlgorithm' - Checksum algorithm.
--
-- 'metadataBlobLength', 'getObjectMetadataResponse_metadataBlobLength' - The size of MetadataBlob.
--
-- 'metadataString', 'getObjectMetadataResponse_metadataString' - Metadata string.
--
-- 'httpStatus', 'getObjectMetadataResponse_httpStatus' - The response's http status code.
--
-- 'metadataBlob', 'getObjectMetadataResponse_metadataBlob' - Metadata blob.
newGetObjectMetadataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'metadataBlob'
  Data.ResponseBody ->
  GetObjectMetadataResponse
newGetObjectMetadataResponse :: Int -> ResponseBody -> GetObjectMetadataResponse
newGetObjectMetadataResponse
  Int
pHttpStatus_
  ResponseBody
pMetadataBlob_ =
    GetObjectMetadataResponse'
      { $sel:metadataBlobChecksum:GetObjectMetadataResponse' :: Maybe Text
metadataBlobChecksum =
          forall a. Maybe a
Prelude.Nothing,
        $sel:metadataBlobChecksumAlgorithm:GetObjectMetadataResponse' :: Maybe DataChecksumAlgorithm
metadataBlobChecksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
        $sel:metadataBlobLength:GetObjectMetadataResponse' :: Maybe Integer
metadataBlobLength = forall a. Maybe a
Prelude.Nothing,
        $sel:metadataString:GetObjectMetadataResponse' :: Maybe Text
metadataString = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetObjectMetadataResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:metadataBlob:GetObjectMetadataResponse' :: ResponseBody
metadataBlob = ResponseBody
pMetadataBlob_
      }

-- | MetadataBlob checksum.
getObjectMetadataResponse_metadataBlobChecksum :: Lens.Lens' GetObjectMetadataResponse (Prelude.Maybe Prelude.Text)
getObjectMetadataResponse_metadataBlobChecksum :: Lens' GetObjectMetadataResponse (Maybe Text)
getObjectMetadataResponse_metadataBlobChecksum = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectMetadataResponse' {Maybe Text
metadataBlobChecksum :: Maybe Text
$sel:metadataBlobChecksum:GetObjectMetadataResponse' :: GetObjectMetadataResponse -> Maybe Text
metadataBlobChecksum} -> Maybe Text
metadataBlobChecksum) (\s :: GetObjectMetadataResponse
s@GetObjectMetadataResponse' {} Maybe Text
a -> GetObjectMetadataResponse
s {$sel:metadataBlobChecksum:GetObjectMetadataResponse' :: Maybe Text
metadataBlobChecksum = Maybe Text
a} :: GetObjectMetadataResponse)

-- | Checksum algorithm.
getObjectMetadataResponse_metadataBlobChecksumAlgorithm :: Lens.Lens' GetObjectMetadataResponse (Prelude.Maybe DataChecksumAlgorithm)
getObjectMetadataResponse_metadataBlobChecksumAlgorithm :: Lens' GetObjectMetadataResponse (Maybe DataChecksumAlgorithm)
getObjectMetadataResponse_metadataBlobChecksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectMetadataResponse' {Maybe DataChecksumAlgorithm
metadataBlobChecksumAlgorithm :: Maybe DataChecksumAlgorithm
$sel:metadataBlobChecksumAlgorithm:GetObjectMetadataResponse' :: GetObjectMetadataResponse -> Maybe DataChecksumAlgorithm
metadataBlobChecksumAlgorithm} -> Maybe DataChecksumAlgorithm
metadataBlobChecksumAlgorithm) (\s :: GetObjectMetadataResponse
s@GetObjectMetadataResponse' {} Maybe DataChecksumAlgorithm
a -> GetObjectMetadataResponse
s {$sel:metadataBlobChecksumAlgorithm:GetObjectMetadataResponse' :: Maybe DataChecksumAlgorithm
metadataBlobChecksumAlgorithm = Maybe DataChecksumAlgorithm
a} :: GetObjectMetadataResponse)

-- | The size of MetadataBlob.
getObjectMetadataResponse_metadataBlobLength :: Lens.Lens' GetObjectMetadataResponse (Prelude.Maybe Prelude.Integer)
getObjectMetadataResponse_metadataBlobLength :: Lens' GetObjectMetadataResponse (Maybe Integer)
getObjectMetadataResponse_metadataBlobLength = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectMetadataResponse' {Maybe Integer
metadataBlobLength :: Maybe Integer
$sel:metadataBlobLength:GetObjectMetadataResponse' :: GetObjectMetadataResponse -> Maybe Integer
metadataBlobLength} -> Maybe Integer
metadataBlobLength) (\s :: GetObjectMetadataResponse
s@GetObjectMetadataResponse' {} Maybe Integer
a -> GetObjectMetadataResponse
s {$sel:metadataBlobLength:GetObjectMetadataResponse' :: Maybe Integer
metadataBlobLength = Maybe Integer
a} :: GetObjectMetadataResponse)

-- | Metadata string.
getObjectMetadataResponse_metadataString :: Lens.Lens' GetObjectMetadataResponse (Prelude.Maybe Prelude.Text)
getObjectMetadataResponse_metadataString :: Lens' GetObjectMetadataResponse (Maybe Text)
getObjectMetadataResponse_metadataString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectMetadataResponse' {Maybe Text
metadataString :: Maybe Text
$sel:metadataString:GetObjectMetadataResponse' :: GetObjectMetadataResponse -> Maybe Text
metadataString} -> Maybe Text
metadataString) (\s :: GetObjectMetadataResponse
s@GetObjectMetadataResponse' {} Maybe Text
a -> GetObjectMetadataResponse
s {$sel:metadataString:GetObjectMetadataResponse' :: Maybe Text
metadataString = Maybe Text
a} :: GetObjectMetadataResponse)

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

-- | Metadata blob.
getObjectMetadataResponse_metadataBlob :: Lens.Lens' GetObjectMetadataResponse Data.ResponseBody
getObjectMetadataResponse_metadataBlob :: Lens' GetObjectMetadataResponse ResponseBody
getObjectMetadataResponse_metadataBlob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetObjectMetadataResponse' {ResponseBody
metadataBlob :: ResponseBody
$sel:metadataBlob:GetObjectMetadataResponse' :: GetObjectMetadataResponse -> ResponseBody
metadataBlob} -> ResponseBody
metadataBlob) (\s :: GetObjectMetadataResponse
s@GetObjectMetadataResponse' {} ResponseBody
a -> GetObjectMetadataResponse
s {$sel:metadataBlob:GetObjectMetadataResponse' :: ResponseBody
metadataBlob = ResponseBody
a} :: GetObjectMetadataResponse)