{-# 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.Backup.GetRecoveryPointRestoreMetadata
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a set of metadata key-value pairs that were used to create the
-- backup.
module Amazonka.Backup.GetRecoveryPointRestoreMetadata
  ( -- * Creating a Request
    GetRecoveryPointRestoreMetadata (..),
    newGetRecoveryPointRestoreMetadata,

    -- * Request Lenses
    getRecoveryPointRestoreMetadata_backupVaultName,
    getRecoveryPointRestoreMetadata_recoveryPointArn,

    -- * Destructuring the Response
    GetRecoveryPointRestoreMetadataResponse (..),
    newGetRecoveryPointRestoreMetadataResponse,

    -- * Response Lenses
    getRecoveryPointRestoreMetadataResponse_backupVaultArn,
    getRecoveryPointRestoreMetadataResponse_recoveryPointArn,
    getRecoveryPointRestoreMetadataResponse_restoreMetadata,
    getRecoveryPointRestoreMetadataResponse_httpStatus,
  )
where

import Amazonka.Backup.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:/ 'newGetRecoveryPointRestoreMetadata' smart constructor.
data GetRecoveryPointRestoreMetadata = GetRecoveryPointRestoreMetadata'
  { -- | The name of a logical container where backups are stored. Backup vaults
    -- are identified by names that are unique to the account used to create
    -- them and the Amazon Web Services Region where they are created. They
    -- consist of lowercase letters, numbers, and hyphens.
    GetRecoveryPointRestoreMetadata -> Text
backupVaultName :: Prelude.Text,
    -- | An Amazon Resource Name (ARN) that uniquely identifies a recovery point;
    -- for example,
    -- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
    GetRecoveryPointRestoreMetadata -> Text
recoveryPointArn :: Prelude.Text
  }
  deriving (GetRecoveryPointRestoreMetadata
-> GetRecoveryPointRestoreMetadata -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRecoveryPointRestoreMetadata
-> GetRecoveryPointRestoreMetadata -> Bool
$c/= :: GetRecoveryPointRestoreMetadata
-> GetRecoveryPointRestoreMetadata -> Bool
== :: GetRecoveryPointRestoreMetadata
-> GetRecoveryPointRestoreMetadata -> Bool
$c== :: GetRecoveryPointRestoreMetadata
-> GetRecoveryPointRestoreMetadata -> Bool
Prelude.Eq, ReadPrec [GetRecoveryPointRestoreMetadata]
ReadPrec GetRecoveryPointRestoreMetadata
Int -> ReadS GetRecoveryPointRestoreMetadata
ReadS [GetRecoveryPointRestoreMetadata]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetRecoveryPointRestoreMetadata]
$creadListPrec :: ReadPrec [GetRecoveryPointRestoreMetadata]
readPrec :: ReadPrec GetRecoveryPointRestoreMetadata
$creadPrec :: ReadPrec GetRecoveryPointRestoreMetadata
readList :: ReadS [GetRecoveryPointRestoreMetadata]
$creadList :: ReadS [GetRecoveryPointRestoreMetadata]
readsPrec :: Int -> ReadS GetRecoveryPointRestoreMetadata
$creadsPrec :: Int -> ReadS GetRecoveryPointRestoreMetadata
Prelude.Read, Int -> GetRecoveryPointRestoreMetadata -> ShowS
[GetRecoveryPointRestoreMetadata] -> ShowS
GetRecoveryPointRestoreMetadata -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRecoveryPointRestoreMetadata] -> ShowS
$cshowList :: [GetRecoveryPointRestoreMetadata] -> ShowS
show :: GetRecoveryPointRestoreMetadata -> String
$cshow :: GetRecoveryPointRestoreMetadata -> String
showsPrec :: Int -> GetRecoveryPointRestoreMetadata -> ShowS
$cshowsPrec :: Int -> GetRecoveryPointRestoreMetadata -> ShowS
Prelude.Show, forall x.
Rep GetRecoveryPointRestoreMetadata x
-> GetRecoveryPointRestoreMetadata
forall x.
GetRecoveryPointRestoreMetadata
-> Rep GetRecoveryPointRestoreMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRecoveryPointRestoreMetadata x
-> GetRecoveryPointRestoreMetadata
$cfrom :: forall x.
GetRecoveryPointRestoreMetadata
-> Rep GetRecoveryPointRestoreMetadata x
Prelude.Generic)

-- |
-- Create a value of 'GetRecoveryPointRestoreMetadata' 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:
--
-- 'backupVaultName', 'getRecoveryPointRestoreMetadata_backupVaultName' - The name of a logical container where backups are stored. Backup vaults
-- are identified by names that are unique to the account used to create
-- them and the Amazon Web Services Region where they are created. They
-- consist of lowercase letters, numbers, and hyphens.
--
-- 'recoveryPointArn', 'getRecoveryPointRestoreMetadata_recoveryPointArn' - An Amazon Resource Name (ARN) that uniquely identifies a recovery point;
-- for example,
-- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
newGetRecoveryPointRestoreMetadata ::
  -- | 'backupVaultName'
  Prelude.Text ->
  -- | 'recoveryPointArn'
  Prelude.Text ->
  GetRecoveryPointRestoreMetadata
newGetRecoveryPointRestoreMetadata :: Text -> Text -> GetRecoveryPointRestoreMetadata
newGetRecoveryPointRestoreMetadata
  Text
pBackupVaultName_
  Text
pRecoveryPointArn_ =
    GetRecoveryPointRestoreMetadata'
      { $sel:backupVaultName:GetRecoveryPointRestoreMetadata' :: Text
backupVaultName =
          Text
pBackupVaultName_,
        $sel:recoveryPointArn:GetRecoveryPointRestoreMetadata' :: Text
recoveryPointArn = Text
pRecoveryPointArn_
      }

-- | The name of a logical container where backups are stored. Backup vaults
-- are identified by names that are unique to the account used to create
-- them and the Amazon Web Services Region where they are created. They
-- consist of lowercase letters, numbers, and hyphens.
getRecoveryPointRestoreMetadata_backupVaultName :: Lens.Lens' GetRecoveryPointRestoreMetadata Prelude.Text
getRecoveryPointRestoreMetadata_backupVaultName :: Lens' GetRecoveryPointRestoreMetadata Text
getRecoveryPointRestoreMetadata_backupVaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRecoveryPointRestoreMetadata' {Text
backupVaultName :: Text
$sel:backupVaultName:GetRecoveryPointRestoreMetadata' :: GetRecoveryPointRestoreMetadata -> Text
backupVaultName} -> Text
backupVaultName) (\s :: GetRecoveryPointRestoreMetadata
s@GetRecoveryPointRestoreMetadata' {} Text
a -> GetRecoveryPointRestoreMetadata
s {$sel:backupVaultName:GetRecoveryPointRestoreMetadata' :: Text
backupVaultName = Text
a} :: GetRecoveryPointRestoreMetadata)

-- | An Amazon Resource Name (ARN) that uniquely identifies a recovery point;
-- for example,
-- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
getRecoveryPointRestoreMetadata_recoveryPointArn :: Lens.Lens' GetRecoveryPointRestoreMetadata Prelude.Text
getRecoveryPointRestoreMetadata_recoveryPointArn :: Lens' GetRecoveryPointRestoreMetadata Text
getRecoveryPointRestoreMetadata_recoveryPointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRecoveryPointRestoreMetadata' {Text
recoveryPointArn :: Text
$sel:recoveryPointArn:GetRecoveryPointRestoreMetadata' :: GetRecoveryPointRestoreMetadata -> Text
recoveryPointArn} -> Text
recoveryPointArn) (\s :: GetRecoveryPointRestoreMetadata
s@GetRecoveryPointRestoreMetadata' {} Text
a -> GetRecoveryPointRestoreMetadata
s {$sel:recoveryPointArn:GetRecoveryPointRestoreMetadata' :: Text
recoveryPointArn = Text
a} :: GetRecoveryPointRestoreMetadata)

instance
  Core.AWSRequest
    GetRecoveryPointRestoreMetadata
  where
  type
    AWSResponse GetRecoveryPointRestoreMetadata =
      GetRecoveryPointRestoreMetadataResponse
  request :: (Service -> Service)
-> GetRecoveryPointRestoreMetadata
-> Request GetRecoveryPointRestoreMetadata
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 GetRecoveryPointRestoreMetadata
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetRecoveryPointRestoreMetadata)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe (Sensitive (HashMap Text Text))
-> Int
-> GetRecoveryPointRestoreMetadataResponse
GetRecoveryPointRestoreMetadataResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"BackupVaultArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RecoveryPointArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RestoreMetadata"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            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
    GetRecoveryPointRestoreMetadata
  where
  hashWithSalt :: Int -> GetRecoveryPointRestoreMetadata -> Int
hashWithSalt
    Int
_salt
    GetRecoveryPointRestoreMetadata' {Text
recoveryPointArn :: Text
backupVaultName :: Text
$sel:recoveryPointArn:GetRecoveryPointRestoreMetadata' :: GetRecoveryPointRestoreMetadata -> Text
$sel:backupVaultName:GetRecoveryPointRestoreMetadata' :: GetRecoveryPointRestoreMetadata -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupVaultName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
recoveryPointArn

instance
  Prelude.NFData
    GetRecoveryPointRestoreMetadata
  where
  rnf :: GetRecoveryPointRestoreMetadata -> ()
rnf GetRecoveryPointRestoreMetadata' {Text
recoveryPointArn :: Text
backupVaultName :: Text
$sel:recoveryPointArn:GetRecoveryPointRestoreMetadata' :: GetRecoveryPointRestoreMetadata -> Text
$sel:backupVaultName:GetRecoveryPointRestoreMetadata' :: GetRecoveryPointRestoreMetadata -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
backupVaultName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
recoveryPointArn

instance
  Data.ToHeaders
    GetRecoveryPointRestoreMetadata
  where
  toHeaders :: GetRecoveryPointRestoreMetadata -> 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 GetRecoveryPointRestoreMetadata where
  toPath :: GetRecoveryPointRestoreMetadata -> ByteString
toPath GetRecoveryPointRestoreMetadata' {Text
recoveryPointArn :: Text
backupVaultName :: Text
$sel:recoveryPointArn:GetRecoveryPointRestoreMetadata' :: GetRecoveryPointRestoreMetadata -> Text
$sel:backupVaultName:GetRecoveryPointRestoreMetadata' :: GetRecoveryPointRestoreMetadata -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/backup-vaults/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupVaultName,
        ByteString
"/recovery-points/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
recoveryPointArn,
        ByteString
"/restore-metadata"
      ]

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

-- | /See:/ 'newGetRecoveryPointRestoreMetadataResponse' smart constructor.
data GetRecoveryPointRestoreMetadataResponse = GetRecoveryPointRestoreMetadataResponse'
  { -- | An ARN that uniquely identifies a backup vault; for example,
    -- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
    GetRecoveryPointRestoreMetadataResponse -> Maybe Text
backupVaultArn :: Prelude.Maybe Prelude.Text,
    -- | An ARN that uniquely identifies a recovery point; for example,
    -- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
    GetRecoveryPointRestoreMetadataResponse -> Maybe Text
recoveryPointArn :: Prelude.Maybe Prelude.Text,
    -- | The set of metadata key-value pairs that describe the original
    -- configuration of the backed-up resource. These values vary depending on
    -- the service that is being restored.
    GetRecoveryPointRestoreMetadataResponse
-> Maybe (Sensitive (HashMap Text Text))
restoreMetadata :: Prelude.Maybe (Data.Sensitive (Prelude.HashMap Prelude.Text Prelude.Text)),
    -- | The response's http status code.
    GetRecoveryPointRestoreMetadataResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetRecoveryPointRestoreMetadataResponse
-> GetRecoveryPointRestoreMetadataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetRecoveryPointRestoreMetadataResponse
-> GetRecoveryPointRestoreMetadataResponse -> Bool
$c/= :: GetRecoveryPointRestoreMetadataResponse
-> GetRecoveryPointRestoreMetadataResponse -> Bool
== :: GetRecoveryPointRestoreMetadataResponse
-> GetRecoveryPointRestoreMetadataResponse -> Bool
$c== :: GetRecoveryPointRestoreMetadataResponse
-> GetRecoveryPointRestoreMetadataResponse -> Bool
Prelude.Eq, Int -> GetRecoveryPointRestoreMetadataResponse -> ShowS
[GetRecoveryPointRestoreMetadataResponse] -> ShowS
GetRecoveryPointRestoreMetadataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetRecoveryPointRestoreMetadataResponse] -> ShowS
$cshowList :: [GetRecoveryPointRestoreMetadataResponse] -> ShowS
show :: GetRecoveryPointRestoreMetadataResponse -> String
$cshow :: GetRecoveryPointRestoreMetadataResponse -> String
showsPrec :: Int -> GetRecoveryPointRestoreMetadataResponse -> ShowS
$cshowsPrec :: Int -> GetRecoveryPointRestoreMetadataResponse -> ShowS
Prelude.Show, forall x.
Rep GetRecoveryPointRestoreMetadataResponse x
-> GetRecoveryPointRestoreMetadataResponse
forall x.
GetRecoveryPointRestoreMetadataResponse
-> Rep GetRecoveryPointRestoreMetadataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetRecoveryPointRestoreMetadataResponse x
-> GetRecoveryPointRestoreMetadataResponse
$cfrom :: forall x.
GetRecoveryPointRestoreMetadataResponse
-> Rep GetRecoveryPointRestoreMetadataResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetRecoveryPointRestoreMetadataResponse' 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:
--
-- 'backupVaultArn', 'getRecoveryPointRestoreMetadataResponse_backupVaultArn' - An ARN that uniquely identifies a backup vault; for example,
-- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
--
-- 'recoveryPointArn', 'getRecoveryPointRestoreMetadataResponse_recoveryPointArn' - An ARN that uniquely identifies a recovery point; for example,
-- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
--
-- 'restoreMetadata', 'getRecoveryPointRestoreMetadataResponse_restoreMetadata' - The set of metadata key-value pairs that describe the original
-- configuration of the backed-up resource. These values vary depending on
-- the service that is being restored.
--
-- 'httpStatus', 'getRecoveryPointRestoreMetadataResponse_httpStatus' - The response's http status code.
newGetRecoveryPointRestoreMetadataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetRecoveryPointRestoreMetadataResponse
newGetRecoveryPointRestoreMetadataResponse :: Int -> GetRecoveryPointRestoreMetadataResponse
newGetRecoveryPointRestoreMetadataResponse
  Int
pHttpStatus_ =
    GetRecoveryPointRestoreMetadataResponse'
      { $sel:backupVaultArn:GetRecoveryPointRestoreMetadataResponse' :: Maybe Text
backupVaultArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:recoveryPointArn:GetRecoveryPointRestoreMetadataResponse' :: Maybe Text
recoveryPointArn = forall a. Maybe a
Prelude.Nothing,
        $sel:restoreMetadata:GetRecoveryPointRestoreMetadataResponse' :: Maybe (Sensitive (HashMap Text Text))
restoreMetadata = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetRecoveryPointRestoreMetadataResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | An ARN that uniquely identifies a backup vault; for example,
-- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
getRecoveryPointRestoreMetadataResponse_backupVaultArn :: Lens.Lens' GetRecoveryPointRestoreMetadataResponse (Prelude.Maybe Prelude.Text)
getRecoveryPointRestoreMetadataResponse_backupVaultArn :: Lens' GetRecoveryPointRestoreMetadataResponse (Maybe Text)
getRecoveryPointRestoreMetadataResponse_backupVaultArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRecoveryPointRestoreMetadataResponse' {Maybe Text
backupVaultArn :: Maybe Text
$sel:backupVaultArn:GetRecoveryPointRestoreMetadataResponse' :: GetRecoveryPointRestoreMetadataResponse -> Maybe Text
backupVaultArn} -> Maybe Text
backupVaultArn) (\s :: GetRecoveryPointRestoreMetadataResponse
s@GetRecoveryPointRestoreMetadataResponse' {} Maybe Text
a -> GetRecoveryPointRestoreMetadataResponse
s {$sel:backupVaultArn:GetRecoveryPointRestoreMetadataResponse' :: Maybe Text
backupVaultArn = Maybe Text
a} :: GetRecoveryPointRestoreMetadataResponse)

-- | An ARN that uniquely identifies a recovery point; for example,
-- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
getRecoveryPointRestoreMetadataResponse_recoveryPointArn :: Lens.Lens' GetRecoveryPointRestoreMetadataResponse (Prelude.Maybe Prelude.Text)
getRecoveryPointRestoreMetadataResponse_recoveryPointArn :: Lens' GetRecoveryPointRestoreMetadataResponse (Maybe Text)
getRecoveryPointRestoreMetadataResponse_recoveryPointArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRecoveryPointRestoreMetadataResponse' {Maybe Text
recoveryPointArn :: Maybe Text
$sel:recoveryPointArn:GetRecoveryPointRestoreMetadataResponse' :: GetRecoveryPointRestoreMetadataResponse -> Maybe Text
recoveryPointArn} -> Maybe Text
recoveryPointArn) (\s :: GetRecoveryPointRestoreMetadataResponse
s@GetRecoveryPointRestoreMetadataResponse' {} Maybe Text
a -> GetRecoveryPointRestoreMetadataResponse
s {$sel:recoveryPointArn:GetRecoveryPointRestoreMetadataResponse' :: Maybe Text
recoveryPointArn = Maybe Text
a} :: GetRecoveryPointRestoreMetadataResponse)

-- | The set of metadata key-value pairs that describe the original
-- configuration of the backed-up resource. These values vary depending on
-- the service that is being restored.
getRecoveryPointRestoreMetadataResponse_restoreMetadata :: Lens.Lens' GetRecoveryPointRestoreMetadataResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getRecoveryPointRestoreMetadataResponse_restoreMetadata :: Lens'
  GetRecoveryPointRestoreMetadataResponse (Maybe (HashMap Text Text))
getRecoveryPointRestoreMetadataResponse_restoreMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetRecoveryPointRestoreMetadataResponse' {Maybe (Sensitive (HashMap Text Text))
restoreMetadata :: Maybe (Sensitive (HashMap Text Text))
$sel:restoreMetadata:GetRecoveryPointRestoreMetadataResponse' :: GetRecoveryPointRestoreMetadataResponse
-> Maybe (Sensitive (HashMap Text Text))
restoreMetadata} -> Maybe (Sensitive (HashMap Text Text))
restoreMetadata) (\s :: GetRecoveryPointRestoreMetadataResponse
s@GetRecoveryPointRestoreMetadataResponse' {} Maybe (Sensitive (HashMap Text Text))
a -> GetRecoveryPointRestoreMetadataResponse
s {$sel:restoreMetadata:GetRecoveryPointRestoreMetadataResponse' :: Maybe (Sensitive (HashMap Text Text))
restoreMetadata = Maybe (Sensitive (HashMap Text Text))
a} :: GetRecoveryPointRestoreMetadataResponse) 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced)

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

instance
  Prelude.NFData
    GetRecoveryPointRestoreMetadataResponse
  where
  rnf :: GetRecoveryPointRestoreMetadataResponse -> ()
rnf GetRecoveryPointRestoreMetadataResponse' {Int
Maybe Text
Maybe (Sensitive (HashMap Text Text))
httpStatus :: Int
restoreMetadata :: Maybe (Sensitive (HashMap Text Text))
recoveryPointArn :: Maybe Text
backupVaultArn :: Maybe Text
$sel:httpStatus:GetRecoveryPointRestoreMetadataResponse' :: GetRecoveryPointRestoreMetadataResponse -> Int
$sel:restoreMetadata:GetRecoveryPointRestoreMetadataResponse' :: GetRecoveryPointRestoreMetadataResponse
-> Maybe (Sensitive (HashMap Text Text))
$sel:recoveryPointArn:GetRecoveryPointRestoreMetadataResponse' :: GetRecoveryPointRestoreMetadataResponse -> Maybe Text
$sel:backupVaultArn:GetRecoveryPointRestoreMetadataResponse' :: GetRecoveryPointRestoreMetadataResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backupVaultArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
recoveryPointArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive (HashMap Text Text))
restoreMetadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus