{-# 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.DescribeRecoveryPoint
-- 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 metadata associated with a recovery point, including ID, status,
-- encryption, and lifecycle.
module Amazonka.Backup.DescribeRecoveryPoint
  ( -- * Creating a Request
    DescribeRecoveryPoint (..),
    newDescribeRecoveryPoint,

    -- * Request Lenses
    describeRecoveryPoint_backupVaultName,
    describeRecoveryPoint_recoveryPointArn,

    -- * Destructuring the Response
    DescribeRecoveryPointResponse (..),
    newDescribeRecoveryPointResponse,

    -- * Response Lenses
    describeRecoveryPointResponse_backupSizeInBytes,
    describeRecoveryPointResponse_backupVaultArn,
    describeRecoveryPointResponse_backupVaultName,
    describeRecoveryPointResponse_calculatedLifecycle,
    describeRecoveryPointResponse_completionDate,
    describeRecoveryPointResponse_compositeMemberIdentifier,
    describeRecoveryPointResponse_createdBy,
    describeRecoveryPointResponse_creationDate,
    describeRecoveryPointResponse_encryptionKeyArn,
    describeRecoveryPointResponse_iamRoleArn,
    describeRecoveryPointResponse_isEncrypted,
    describeRecoveryPointResponse_isParent,
    describeRecoveryPointResponse_lastRestoreTime,
    describeRecoveryPointResponse_lifecycle,
    describeRecoveryPointResponse_parentRecoveryPointArn,
    describeRecoveryPointResponse_recoveryPointArn,
    describeRecoveryPointResponse_resourceArn,
    describeRecoveryPointResponse_resourceType,
    describeRecoveryPointResponse_sourceBackupVaultArn,
    describeRecoveryPointResponse_status,
    describeRecoveryPointResponse_statusMessage,
    describeRecoveryPointResponse_storageClass,
    describeRecoveryPointResponse_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:/ 'newDescribeRecoveryPoint' smart constructor.
data DescribeRecoveryPoint = DescribeRecoveryPoint'
  { -- | 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.
    DescribeRecoveryPoint -> 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@.
    DescribeRecoveryPoint -> Text
recoveryPointArn :: Prelude.Text
  }
  deriving (DescribeRecoveryPoint -> DescribeRecoveryPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeRecoveryPoint -> DescribeRecoveryPoint -> Bool
$c/= :: DescribeRecoveryPoint -> DescribeRecoveryPoint -> Bool
== :: DescribeRecoveryPoint -> DescribeRecoveryPoint -> Bool
$c== :: DescribeRecoveryPoint -> DescribeRecoveryPoint -> Bool
Prelude.Eq, ReadPrec [DescribeRecoveryPoint]
ReadPrec DescribeRecoveryPoint
Int -> ReadS DescribeRecoveryPoint
ReadS [DescribeRecoveryPoint]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeRecoveryPoint]
$creadListPrec :: ReadPrec [DescribeRecoveryPoint]
readPrec :: ReadPrec DescribeRecoveryPoint
$creadPrec :: ReadPrec DescribeRecoveryPoint
readList :: ReadS [DescribeRecoveryPoint]
$creadList :: ReadS [DescribeRecoveryPoint]
readsPrec :: Int -> ReadS DescribeRecoveryPoint
$creadsPrec :: Int -> ReadS DescribeRecoveryPoint
Prelude.Read, Int -> DescribeRecoveryPoint -> ShowS
[DescribeRecoveryPoint] -> ShowS
DescribeRecoveryPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeRecoveryPoint] -> ShowS
$cshowList :: [DescribeRecoveryPoint] -> ShowS
show :: DescribeRecoveryPoint -> String
$cshow :: DescribeRecoveryPoint -> String
showsPrec :: Int -> DescribeRecoveryPoint -> ShowS
$cshowsPrec :: Int -> DescribeRecoveryPoint -> ShowS
Prelude.Show, forall x. Rep DescribeRecoveryPoint x -> DescribeRecoveryPoint
forall x. DescribeRecoveryPoint -> Rep DescribeRecoveryPoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeRecoveryPoint x -> DescribeRecoveryPoint
$cfrom :: forall x. DescribeRecoveryPoint -> Rep DescribeRecoveryPoint x
Prelude.Generic)

-- |
-- Create a value of 'DescribeRecoveryPoint' 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', 'describeRecoveryPoint_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', 'describeRecoveryPoint_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@.
newDescribeRecoveryPoint ::
  -- | 'backupVaultName'
  Prelude.Text ->
  -- | 'recoveryPointArn'
  Prelude.Text ->
  DescribeRecoveryPoint
newDescribeRecoveryPoint :: Text -> Text -> DescribeRecoveryPoint
newDescribeRecoveryPoint
  Text
pBackupVaultName_
  Text
pRecoveryPointArn_ =
    DescribeRecoveryPoint'
      { $sel:backupVaultName:DescribeRecoveryPoint' :: Text
backupVaultName =
          Text
pBackupVaultName_,
        $sel:recoveryPointArn:DescribeRecoveryPoint' :: 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.
describeRecoveryPoint_backupVaultName :: Lens.Lens' DescribeRecoveryPoint Prelude.Text
describeRecoveryPoint_backupVaultName :: Lens' DescribeRecoveryPoint Text
describeRecoveryPoint_backupVaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPoint' {Text
backupVaultName :: Text
$sel:backupVaultName:DescribeRecoveryPoint' :: DescribeRecoveryPoint -> Text
backupVaultName} -> Text
backupVaultName) (\s :: DescribeRecoveryPoint
s@DescribeRecoveryPoint' {} Text
a -> DescribeRecoveryPoint
s {$sel:backupVaultName:DescribeRecoveryPoint' :: Text
backupVaultName = Text
a} :: DescribeRecoveryPoint)

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

instance Core.AWSRequest DescribeRecoveryPoint where
  type
    AWSResponse DescribeRecoveryPoint =
      DescribeRecoveryPointResponse
  request :: (Service -> Service)
-> DescribeRecoveryPoint -> Request DescribeRecoveryPoint
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 DescribeRecoveryPoint
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeRecoveryPoint)))
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 Integer
-> Maybe Text
-> Maybe Text
-> Maybe CalculatedLifecycle
-> Maybe POSIX
-> Maybe Text
-> Maybe RecoveryPointCreator
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe POSIX
-> Maybe Lifecycle
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe RecoveryPointStatus
-> Maybe Text
-> Maybe StorageClass
-> Int
-> DescribeRecoveryPointResponse
DescribeRecoveryPointResponse'
            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
"BackupSizeInBytes")
            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
"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
"BackupVaultName")
            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
"CalculatedLifecycle")
            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
"CompletionDate")
            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
"CompositeMemberIdentifier")
            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
"CreatedBy")
            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
"CreationDate")
            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
"EncryptionKeyArn")
            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
"IamRoleArn")
            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
"IsEncrypted")
            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
"IsParent")
            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
"LastRestoreTime")
            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
"Lifecycle")
            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
"ParentRecoveryPointArn")
            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
"ResourceArn")
            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
"ResourceType")
            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
"SourceBackupVaultArn")
            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
"Status")
            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
"StatusMessage")
            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
"StorageClass")
            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 DescribeRecoveryPoint where
  hashWithSalt :: Int -> DescribeRecoveryPoint -> Int
hashWithSalt Int
_salt DescribeRecoveryPoint' {Text
recoveryPointArn :: Text
backupVaultName :: Text
$sel:recoveryPointArn:DescribeRecoveryPoint' :: DescribeRecoveryPoint -> Text
$sel:backupVaultName:DescribeRecoveryPoint' :: DescribeRecoveryPoint -> 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 DescribeRecoveryPoint where
  rnf :: DescribeRecoveryPoint -> ()
rnf DescribeRecoveryPoint' {Text
recoveryPointArn :: Text
backupVaultName :: Text
$sel:recoveryPointArn:DescribeRecoveryPoint' :: DescribeRecoveryPoint -> Text
$sel:backupVaultName:DescribeRecoveryPoint' :: DescribeRecoveryPoint -> 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 DescribeRecoveryPoint where
  toHeaders :: DescribeRecoveryPoint -> 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 DescribeRecoveryPoint where
  toPath :: DescribeRecoveryPoint -> ByteString
toPath DescribeRecoveryPoint' {Text
recoveryPointArn :: Text
backupVaultName :: Text
$sel:recoveryPointArn:DescribeRecoveryPoint' :: DescribeRecoveryPoint -> Text
$sel:backupVaultName:DescribeRecoveryPoint' :: DescribeRecoveryPoint -> 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
      ]

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

-- | /See:/ 'newDescribeRecoveryPointResponse' smart constructor.
data DescribeRecoveryPointResponse = DescribeRecoveryPointResponse'
  { -- | The size, in bytes, of a backup.
    DescribeRecoveryPointResponse -> Maybe Integer
backupSizeInBytes :: Prelude.Maybe Prelude.Integer,
    -- | An ARN that uniquely identifies a backup vault; for example,
    -- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
    DescribeRecoveryPointResponse -> Maybe Text
backupVaultArn :: Prelude.Maybe Prelude.Text,
    -- | 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 Region where they are created. They consist of lowercase
    -- letters, numbers, and hyphens.
    DescribeRecoveryPointResponse -> Maybe Text
backupVaultName :: Prelude.Maybe Prelude.Text,
    -- | A @CalculatedLifecycle@ object containing @DeleteAt@ and
    -- @MoveToColdStorageAt@ timestamps.
    DescribeRecoveryPointResponse -> Maybe CalculatedLifecycle
calculatedLifecycle :: Prelude.Maybe CalculatedLifecycle,
    -- | The date and time that a job to create a recovery point is completed, in
    -- Unix format and Coordinated Universal Time (UTC). The value of
    -- @CompletionDate@ is accurate to milliseconds. For example, the value
    -- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
    DescribeRecoveryPointResponse -> Maybe POSIX
completionDate :: Prelude.Maybe Data.POSIX,
    -- | This is the identifier of a resource within a composite group, such as
    -- nested (child) recovery point belonging to a composite (parent) stack.
    -- The ID is transferred from the
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/resources-section-structure.html#resources-section-structure-syntax logical ID>
    -- within a stack.
    DescribeRecoveryPointResponse -> Maybe Text
compositeMemberIdentifier :: Prelude.Maybe Prelude.Text,
    -- | Contains identifying information about the creation of a recovery point,
    -- including the @BackupPlanArn@, @BackupPlanId@, @BackupPlanVersion@, and
    -- @BackupRuleId@ of the backup plan used to create it.
    DescribeRecoveryPointResponse -> Maybe RecoveryPointCreator
createdBy :: Prelude.Maybe RecoveryPointCreator,
    -- | The date and time that a recovery point is created, in Unix format and
    -- Coordinated Universal Time (UTC). The value of @CreationDate@ is
    -- accurate to milliseconds. For example, the value 1516925490.087
    -- represents Friday, January 26, 2018 12:11:30.087 AM.
    DescribeRecoveryPointResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | The server-side encryption key used to protect your backups; for
    -- example,
    -- @arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
    DescribeRecoveryPointResponse -> Maybe Text
encryptionKeyArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies the IAM role ARN used to create the target recovery point; for
    -- example, @arn:aws:iam::123456789012:role\/S3Access@.
    DescribeRecoveryPointResponse -> Maybe Text
iamRoleArn :: Prelude.Maybe Prelude.Text,
    -- | A Boolean value that is returned as @TRUE@ if the specified recovery
    -- point is encrypted, or @FALSE@ if the recovery point is not encrypted.
    DescribeRecoveryPointResponse -> Maybe Bool
isEncrypted :: Prelude.Maybe Prelude.Bool,
    -- | This returns the boolean value that a recovery point is a parent
    -- (composite) job.
    DescribeRecoveryPointResponse -> Maybe Bool
isParent :: Prelude.Maybe Prelude.Bool,
    -- | The date and time that a recovery point was last restored, in Unix
    -- format and Coordinated Universal Time (UTC). The value of
    -- @LastRestoreTime@ is accurate to milliseconds. For example, the value
    -- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
    DescribeRecoveryPointResponse -> Maybe POSIX
lastRestoreTime :: Prelude.Maybe Data.POSIX,
    -- | The lifecycle defines when a protected resource is transitioned to cold
    -- storage and when it expires. Backup transitions and expires backups
    -- automatically according to the lifecycle that you define.
    --
    -- Backups that are transitioned to cold storage must be stored in cold
    -- storage for a minimum of 90 days. Therefore, the “retention” setting
    -- must be 90 days greater than the “transition to cold after days”
    -- setting. The “transition to cold after days” setting cannot be changed
    -- after a backup has been transitioned to cold.
    --
    -- Resource types that are able to be transitioned to cold storage are
    -- listed in the \"Lifecycle to cold storage\" section of the
    -- <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html#features-by-resource Feature availability by resource>
    -- table. Backup ignores this expression for other resource types.
    DescribeRecoveryPointResponse -> Maybe Lifecycle
lifecycle :: Prelude.Maybe Lifecycle,
    -- | This is an ARN that uniquely identifies a parent (composite) recovery
    -- point; for example,
    -- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
    DescribeRecoveryPointResponse -> Maybe Text
parentRecoveryPointArn :: 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@.
    DescribeRecoveryPointResponse -> Maybe Text
recoveryPointArn :: Prelude.Maybe Prelude.Text,
    -- | An ARN that uniquely identifies a saved resource. The format of the ARN
    -- depends on the resource type.
    DescribeRecoveryPointResponse -> Maybe Text
resourceArn :: Prelude.Maybe Prelude.Text,
    -- | The type of Amazon Web Services resource to save as a recovery point;
    -- for example, an Amazon Elastic Block Store (Amazon EBS) volume or an
    -- Amazon Relational Database Service (Amazon RDS) database.
    DescribeRecoveryPointResponse -> Maybe Text
resourceType :: Prelude.Maybe Prelude.Text,
    -- | An Amazon Resource Name (ARN) that uniquely identifies the source vault
    -- where the resource was originally backed up in; for example,
    -- @arn:aws:backup:us-east-1:123456789012:vault:BackupVault@. If the
    -- recovery is restored to the same Amazon Web Services account or Region,
    -- this value will be @null@.
    DescribeRecoveryPointResponse -> Maybe Text
sourceBackupVaultArn :: Prelude.Maybe Prelude.Text,
    -- | A status code specifying the state of the recovery point.
    --
    -- @PARTIAL@ status indicates Backup could not create the recovery point
    -- before the backup window closed. To increase your backup plan window
    -- using the API, see
    -- <https://docs.aws.amazon.com/aws-backup/latest/devguide/API_UpdateBackupPlan.html UpdateBackupPlan>.
    -- You can also increase your backup plan window using the Console by
    -- choosing and editing your backup plan.
    --
    -- @EXPIRED@ status indicates that the recovery point has exceeded its
    -- retention period, but Backup lacks permission or is otherwise unable to
    -- delete it. To manually delete these recovery points, see
    -- <https://docs.aws.amazon.com/aws-backup/latest/devguide/gs-cleanup-resources.html#cleanup-backups Step 3: Delete the recovery points>
    -- in the /Clean up resources/ section of /Getting started/.
    --
    -- @STOPPED@ status occurs on a continuous backup where a user has taken
    -- some action that causes the continuous backup to be disabled. This can
    -- be caused by the removal of permissions, turning off versioning, turning
    -- off events being sent to EventBridge, or disabling the EventBridge rules
    -- that are put in place by Backup.
    --
    -- To resolve @STOPPED@ status, ensure that all requested permissions are
    -- in place and that versioning is enabled on the S3 bucket. Once these
    -- conditions are met, the next instance of a backup rule running will
    -- result in a new continuous recovery point being created. The recovery
    -- points with STOPPED status do not need to be deleted.
    DescribeRecoveryPointResponse -> Maybe RecoveryPointStatus
status :: Prelude.Maybe RecoveryPointStatus,
    -- | A status message explaining the reason for the recovery point deletion
    -- failure.
    DescribeRecoveryPointResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | Specifies the storage class of the recovery point. Valid values are
    -- @WARM@ or @COLD@.
    DescribeRecoveryPointResponse -> Maybe StorageClass
storageClass :: Prelude.Maybe StorageClass,
    -- | The response's http status code.
    DescribeRecoveryPointResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeRecoveryPointResponse
-> DescribeRecoveryPointResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeRecoveryPointResponse
-> DescribeRecoveryPointResponse -> Bool
$c/= :: DescribeRecoveryPointResponse
-> DescribeRecoveryPointResponse -> Bool
== :: DescribeRecoveryPointResponse
-> DescribeRecoveryPointResponse -> Bool
$c== :: DescribeRecoveryPointResponse
-> DescribeRecoveryPointResponse -> Bool
Prelude.Eq, ReadPrec [DescribeRecoveryPointResponse]
ReadPrec DescribeRecoveryPointResponse
Int -> ReadS DescribeRecoveryPointResponse
ReadS [DescribeRecoveryPointResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeRecoveryPointResponse]
$creadListPrec :: ReadPrec [DescribeRecoveryPointResponse]
readPrec :: ReadPrec DescribeRecoveryPointResponse
$creadPrec :: ReadPrec DescribeRecoveryPointResponse
readList :: ReadS [DescribeRecoveryPointResponse]
$creadList :: ReadS [DescribeRecoveryPointResponse]
readsPrec :: Int -> ReadS DescribeRecoveryPointResponse
$creadsPrec :: Int -> ReadS DescribeRecoveryPointResponse
Prelude.Read, Int -> DescribeRecoveryPointResponse -> ShowS
[DescribeRecoveryPointResponse] -> ShowS
DescribeRecoveryPointResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeRecoveryPointResponse] -> ShowS
$cshowList :: [DescribeRecoveryPointResponse] -> ShowS
show :: DescribeRecoveryPointResponse -> String
$cshow :: DescribeRecoveryPointResponse -> String
showsPrec :: Int -> DescribeRecoveryPointResponse -> ShowS
$cshowsPrec :: Int -> DescribeRecoveryPointResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeRecoveryPointResponse x
-> DescribeRecoveryPointResponse
forall x.
DescribeRecoveryPointResponse
-> Rep DescribeRecoveryPointResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeRecoveryPointResponse x
-> DescribeRecoveryPointResponse
$cfrom :: forall x.
DescribeRecoveryPointResponse
-> Rep DescribeRecoveryPointResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeRecoveryPointResponse' 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:
--
-- 'backupSizeInBytes', 'describeRecoveryPointResponse_backupSizeInBytes' - The size, in bytes, of a backup.
--
-- 'backupVaultArn', 'describeRecoveryPointResponse_backupVaultArn' - An ARN that uniquely identifies a backup vault; for example,
-- @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
--
-- 'backupVaultName', 'describeRecoveryPointResponse_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 Region where they are created. They consist of lowercase
-- letters, numbers, and hyphens.
--
-- 'calculatedLifecycle', 'describeRecoveryPointResponse_calculatedLifecycle' - A @CalculatedLifecycle@ object containing @DeleteAt@ and
-- @MoveToColdStorageAt@ timestamps.
--
-- 'completionDate', 'describeRecoveryPointResponse_completionDate' - The date and time that a job to create a recovery point is completed, in
-- Unix format and Coordinated Universal Time (UTC). The value of
-- @CompletionDate@ is accurate to milliseconds. For example, the value
-- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'compositeMemberIdentifier', 'describeRecoveryPointResponse_compositeMemberIdentifier' - This is the identifier of a resource within a composite group, such as
-- nested (child) recovery point belonging to a composite (parent) stack.
-- The ID is transferred from the
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/resources-section-structure.html#resources-section-structure-syntax logical ID>
-- within a stack.
--
-- 'createdBy', 'describeRecoveryPointResponse_createdBy' - Contains identifying information about the creation of a recovery point,
-- including the @BackupPlanArn@, @BackupPlanId@, @BackupPlanVersion@, and
-- @BackupRuleId@ of the backup plan used to create it.
--
-- 'creationDate', 'describeRecoveryPointResponse_creationDate' - The date and time that a recovery point is created, in Unix format and
-- Coordinated Universal Time (UTC). The value of @CreationDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'encryptionKeyArn', 'describeRecoveryPointResponse_encryptionKeyArn' - The server-side encryption key used to protect your backups; for
-- example,
-- @arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
--
-- 'iamRoleArn', 'describeRecoveryPointResponse_iamRoleArn' - Specifies the IAM role ARN used to create the target recovery point; for
-- example, @arn:aws:iam::123456789012:role\/S3Access@.
--
-- 'isEncrypted', 'describeRecoveryPointResponse_isEncrypted' - A Boolean value that is returned as @TRUE@ if the specified recovery
-- point is encrypted, or @FALSE@ if the recovery point is not encrypted.
--
-- 'isParent', 'describeRecoveryPointResponse_isParent' - This returns the boolean value that a recovery point is a parent
-- (composite) job.
--
-- 'lastRestoreTime', 'describeRecoveryPointResponse_lastRestoreTime' - The date and time that a recovery point was last restored, in Unix
-- format and Coordinated Universal Time (UTC). The value of
-- @LastRestoreTime@ is accurate to milliseconds. For example, the value
-- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'lifecycle', 'describeRecoveryPointResponse_lifecycle' - The lifecycle defines when a protected resource is transitioned to cold
-- storage and when it expires. Backup transitions and expires backups
-- automatically according to the lifecycle that you define.
--
-- Backups that are transitioned to cold storage must be stored in cold
-- storage for a minimum of 90 days. Therefore, the “retention” setting
-- must be 90 days greater than the “transition to cold after days”
-- setting. The “transition to cold after days” setting cannot be changed
-- after a backup has been transitioned to cold.
--
-- Resource types that are able to be transitioned to cold storage are
-- listed in the \"Lifecycle to cold storage\" section of the
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html#features-by-resource Feature availability by resource>
-- table. Backup ignores this expression for other resource types.
--
-- 'parentRecoveryPointArn', 'describeRecoveryPointResponse_parentRecoveryPointArn' - This is an ARN that uniquely identifies a parent (composite) recovery
-- point; for example,
-- @arn:aws:backup:us-east-1:123456789012:recovery-point:1EB3B5E7-9EB0-435A-A80B-108B488B0D45@.
--
-- 'recoveryPointArn', 'describeRecoveryPointResponse_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@.
--
-- 'resourceArn', 'describeRecoveryPointResponse_resourceArn' - An ARN that uniquely identifies a saved resource. The format of the ARN
-- depends on the resource type.
--
-- 'resourceType', 'describeRecoveryPointResponse_resourceType' - The type of Amazon Web Services resource to save as a recovery point;
-- for example, an Amazon Elastic Block Store (Amazon EBS) volume or an
-- Amazon Relational Database Service (Amazon RDS) database.
--
-- 'sourceBackupVaultArn', 'describeRecoveryPointResponse_sourceBackupVaultArn' - An Amazon Resource Name (ARN) that uniquely identifies the source vault
-- where the resource was originally backed up in; for example,
-- @arn:aws:backup:us-east-1:123456789012:vault:BackupVault@. If the
-- recovery is restored to the same Amazon Web Services account or Region,
-- this value will be @null@.
--
-- 'status', 'describeRecoveryPointResponse_status' - A status code specifying the state of the recovery point.
--
-- @PARTIAL@ status indicates Backup could not create the recovery point
-- before the backup window closed. To increase your backup plan window
-- using the API, see
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/API_UpdateBackupPlan.html UpdateBackupPlan>.
-- You can also increase your backup plan window using the Console by
-- choosing and editing your backup plan.
--
-- @EXPIRED@ status indicates that the recovery point has exceeded its
-- retention period, but Backup lacks permission or is otherwise unable to
-- delete it. To manually delete these recovery points, see
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/gs-cleanup-resources.html#cleanup-backups Step 3: Delete the recovery points>
-- in the /Clean up resources/ section of /Getting started/.
--
-- @STOPPED@ status occurs on a continuous backup where a user has taken
-- some action that causes the continuous backup to be disabled. This can
-- be caused by the removal of permissions, turning off versioning, turning
-- off events being sent to EventBridge, or disabling the EventBridge rules
-- that are put in place by Backup.
--
-- To resolve @STOPPED@ status, ensure that all requested permissions are
-- in place and that versioning is enabled on the S3 bucket. Once these
-- conditions are met, the next instance of a backup rule running will
-- result in a new continuous recovery point being created. The recovery
-- points with STOPPED status do not need to be deleted.
--
-- 'statusMessage', 'describeRecoveryPointResponse_statusMessage' - A status message explaining the reason for the recovery point deletion
-- failure.
--
-- 'storageClass', 'describeRecoveryPointResponse_storageClass' - Specifies the storage class of the recovery point. Valid values are
-- @WARM@ or @COLD@.
--
-- 'httpStatus', 'describeRecoveryPointResponse_httpStatus' - The response's http status code.
newDescribeRecoveryPointResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeRecoveryPointResponse
newDescribeRecoveryPointResponse :: Int -> DescribeRecoveryPointResponse
newDescribeRecoveryPointResponse Int
pHttpStatus_ =
  DescribeRecoveryPointResponse'
    { $sel:backupSizeInBytes:DescribeRecoveryPointResponse' :: Maybe Integer
backupSizeInBytes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backupVaultArn:DescribeRecoveryPointResponse' :: Maybe Text
backupVaultArn = forall a. Maybe a
Prelude.Nothing,
      $sel:backupVaultName:DescribeRecoveryPointResponse' :: Maybe Text
backupVaultName = forall a. Maybe a
Prelude.Nothing,
      $sel:calculatedLifecycle:DescribeRecoveryPointResponse' :: Maybe CalculatedLifecycle
calculatedLifecycle = forall a. Maybe a
Prelude.Nothing,
      $sel:completionDate:DescribeRecoveryPointResponse' :: Maybe POSIX
completionDate = forall a. Maybe a
Prelude.Nothing,
      $sel:compositeMemberIdentifier:DescribeRecoveryPointResponse' :: Maybe Text
compositeMemberIdentifier = forall a. Maybe a
Prelude.Nothing,
      $sel:createdBy:DescribeRecoveryPointResponse' :: Maybe RecoveryPointCreator
createdBy = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:DescribeRecoveryPointResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionKeyArn:DescribeRecoveryPointResponse' :: Maybe Text
encryptionKeyArn = forall a. Maybe a
Prelude.Nothing,
      $sel:iamRoleArn:DescribeRecoveryPointResponse' :: Maybe Text
iamRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:isEncrypted:DescribeRecoveryPointResponse' :: Maybe Bool
isEncrypted = forall a. Maybe a
Prelude.Nothing,
      $sel:isParent:DescribeRecoveryPointResponse' :: Maybe Bool
isParent = forall a. Maybe a
Prelude.Nothing,
      $sel:lastRestoreTime:DescribeRecoveryPointResponse' :: Maybe POSIX
lastRestoreTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lifecycle:DescribeRecoveryPointResponse' :: Maybe Lifecycle
lifecycle = forall a. Maybe a
Prelude.Nothing,
      $sel:parentRecoveryPointArn:DescribeRecoveryPointResponse' :: Maybe Text
parentRecoveryPointArn = forall a. Maybe a
Prelude.Nothing,
      $sel:recoveryPointArn:DescribeRecoveryPointResponse' :: Maybe Text
recoveryPointArn = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:DescribeRecoveryPointResponse' :: Maybe Text
resourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:DescribeRecoveryPointResponse' :: Maybe Text
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceBackupVaultArn:DescribeRecoveryPointResponse' :: Maybe Text
sourceBackupVaultArn = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeRecoveryPointResponse' :: Maybe RecoveryPointStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:DescribeRecoveryPointResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:storageClass:DescribeRecoveryPointResponse' :: Maybe StorageClass
storageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeRecoveryPointResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The size, in bytes, of a backup.
describeRecoveryPointResponse_backupSizeInBytes :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Integer)
describeRecoveryPointResponse_backupSizeInBytes :: Lens' DescribeRecoveryPointResponse (Maybe Integer)
describeRecoveryPointResponse_backupSizeInBytes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Integer
backupSizeInBytes :: Maybe Integer
$sel:backupSizeInBytes:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Integer
backupSizeInBytes} -> Maybe Integer
backupSizeInBytes) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Integer
a -> DescribeRecoveryPointResponse
s {$sel:backupSizeInBytes:DescribeRecoveryPointResponse' :: Maybe Integer
backupSizeInBytes = Maybe Integer
a} :: DescribeRecoveryPointResponse)

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

-- | 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 Region where they are created. They consist of lowercase
-- letters, numbers, and hyphens.
describeRecoveryPointResponse_backupVaultName :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
describeRecoveryPointResponse_backupVaultName :: Lens' DescribeRecoveryPointResponse (Maybe Text)
describeRecoveryPointResponse_backupVaultName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Text
backupVaultName :: Maybe Text
$sel:backupVaultName:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
backupVaultName} -> Maybe Text
backupVaultName) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Text
a -> DescribeRecoveryPointResponse
s {$sel:backupVaultName:DescribeRecoveryPointResponse' :: Maybe Text
backupVaultName = Maybe Text
a} :: DescribeRecoveryPointResponse)

-- | A @CalculatedLifecycle@ object containing @DeleteAt@ and
-- @MoveToColdStorageAt@ timestamps.
describeRecoveryPointResponse_calculatedLifecycle :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe CalculatedLifecycle)
describeRecoveryPointResponse_calculatedLifecycle :: Lens' DescribeRecoveryPointResponse (Maybe CalculatedLifecycle)
describeRecoveryPointResponse_calculatedLifecycle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe CalculatedLifecycle
calculatedLifecycle :: Maybe CalculatedLifecycle
$sel:calculatedLifecycle:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe CalculatedLifecycle
calculatedLifecycle} -> Maybe CalculatedLifecycle
calculatedLifecycle) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe CalculatedLifecycle
a -> DescribeRecoveryPointResponse
s {$sel:calculatedLifecycle:DescribeRecoveryPointResponse' :: Maybe CalculatedLifecycle
calculatedLifecycle = Maybe CalculatedLifecycle
a} :: DescribeRecoveryPointResponse)

-- | The date and time that a job to create a recovery point is completed, in
-- Unix format and Coordinated Universal Time (UTC). The value of
-- @CompletionDate@ is accurate to milliseconds. For example, the value
-- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
describeRecoveryPointResponse_completionDate :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.UTCTime)
describeRecoveryPointResponse_completionDate :: Lens' DescribeRecoveryPointResponse (Maybe UTCTime)
describeRecoveryPointResponse_completionDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe POSIX
completionDate :: Maybe POSIX
$sel:completionDate:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe POSIX
completionDate} -> Maybe POSIX
completionDate) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe POSIX
a -> DescribeRecoveryPointResponse
s {$sel:completionDate:DescribeRecoveryPointResponse' :: Maybe POSIX
completionDate = Maybe POSIX
a} :: DescribeRecoveryPointResponse) 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

-- | This is the identifier of a resource within a composite group, such as
-- nested (child) recovery point belonging to a composite (parent) stack.
-- The ID is transferred from the
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/resources-section-structure.html#resources-section-structure-syntax logical ID>
-- within a stack.
describeRecoveryPointResponse_compositeMemberIdentifier :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
describeRecoveryPointResponse_compositeMemberIdentifier :: Lens' DescribeRecoveryPointResponse (Maybe Text)
describeRecoveryPointResponse_compositeMemberIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Text
compositeMemberIdentifier :: Maybe Text
$sel:compositeMemberIdentifier:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
compositeMemberIdentifier} -> Maybe Text
compositeMemberIdentifier) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Text
a -> DescribeRecoveryPointResponse
s {$sel:compositeMemberIdentifier:DescribeRecoveryPointResponse' :: Maybe Text
compositeMemberIdentifier = Maybe Text
a} :: DescribeRecoveryPointResponse)

-- | Contains identifying information about the creation of a recovery point,
-- including the @BackupPlanArn@, @BackupPlanId@, @BackupPlanVersion@, and
-- @BackupRuleId@ of the backup plan used to create it.
describeRecoveryPointResponse_createdBy :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe RecoveryPointCreator)
describeRecoveryPointResponse_createdBy :: Lens' DescribeRecoveryPointResponse (Maybe RecoveryPointCreator)
describeRecoveryPointResponse_createdBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe RecoveryPointCreator
createdBy :: Maybe RecoveryPointCreator
$sel:createdBy:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe RecoveryPointCreator
createdBy} -> Maybe RecoveryPointCreator
createdBy) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe RecoveryPointCreator
a -> DescribeRecoveryPointResponse
s {$sel:createdBy:DescribeRecoveryPointResponse' :: Maybe RecoveryPointCreator
createdBy = Maybe RecoveryPointCreator
a} :: DescribeRecoveryPointResponse)

-- | The date and time that a recovery point is created, in Unix format and
-- Coordinated Universal Time (UTC). The value of @CreationDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
describeRecoveryPointResponse_creationDate :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.UTCTime)
describeRecoveryPointResponse_creationDate :: Lens' DescribeRecoveryPointResponse (Maybe UTCTime)
describeRecoveryPointResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe POSIX
a -> DescribeRecoveryPointResponse
s {$sel:creationDate:DescribeRecoveryPointResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: DescribeRecoveryPointResponse) 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 server-side encryption key used to protect your backups; for
-- example,
-- @arn:aws:kms:us-west-2:111122223333:key\/1234abcd-12ab-34cd-56ef-1234567890ab@.
describeRecoveryPointResponse_encryptionKeyArn :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
describeRecoveryPointResponse_encryptionKeyArn :: Lens' DescribeRecoveryPointResponse (Maybe Text)
describeRecoveryPointResponse_encryptionKeyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Text
encryptionKeyArn :: Maybe Text
$sel:encryptionKeyArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
encryptionKeyArn} -> Maybe Text
encryptionKeyArn) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Text
a -> DescribeRecoveryPointResponse
s {$sel:encryptionKeyArn:DescribeRecoveryPointResponse' :: Maybe Text
encryptionKeyArn = Maybe Text
a} :: DescribeRecoveryPointResponse)

-- | Specifies the IAM role ARN used to create the target recovery point; for
-- example, @arn:aws:iam::123456789012:role\/S3Access@.
describeRecoveryPointResponse_iamRoleArn :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
describeRecoveryPointResponse_iamRoleArn :: Lens' DescribeRecoveryPointResponse (Maybe Text)
describeRecoveryPointResponse_iamRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Text
iamRoleArn :: Maybe Text
$sel:iamRoleArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
iamRoleArn} -> Maybe Text
iamRoleArn) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Text
a -> DescribeRecoveryPointResponse
s {$sel:iamRoleArn:DescribeRecoveryPointResponse' :: Maybe Text
iamRoleArn = Maybe Text
a} :: DescribeRecoveryPointResponse)

-- | A Boolean value that is returned as @TRUE@ if the specified recovery
-- point is encrypted, or @FALSE@ if the recovery point is not encrypted.
describeRecoveryPointResponse_isEncrypted :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Bool)
describeRecoveryPointResponse_isEncrypted :: Lens' DescribeRecoveryPointResponse (Maybe Bool)
describeRecoveryPointResponse_isEncrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Bool
isEncrypted :: Maybe Bool
$sel:isEncrypted:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Bool
isEncrypted} -> Maybe Bool
isEncrypted) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Bool
a -> DescribeRecoveryPointResponse
s {$sel:isEncrypted:DescribeRecoveryPointResponse' :: Maybe Bool
isEncrypted = Maybe Bool
a} :: DescribeRecoveryPointResponse)

-- | This returns the boolean value that a recovery point is a parent
-- (composite) job.
describeRecoveryPointResponse_isParent :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Bool)
describeRecoveryPointResponse_isParent :: Lens' DescribeRecoveryPointResponse (Maybe Bool)
describeRecoveryPointResponse_isParent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Bool
isParent :: Maybe Bool
$sel:isParent:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Bool
isParent} -> Maybe Bool
isParent) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Bool
a -> DescribeRecoveryPointResponse
s {$sel:isParent:DescribeRecoveryPointResponse' :: Maybe Bool
isParent = Maybe Bool
a} :: DescribeRecoveryPointResponse)

-- | The date and time that a recovery point was last restored, in Unix
-- format and Coordinated Universal Time (UTC). The value of
-- @LastRestoreTime@ is accurate to milliseconds. For example, the value
-- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
describeRecoveryPointResponse_lastRestoreTime :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.UTCTime)
describeRecoveryPointResponse_lastRestoreTime :: Lens' DescribeRecoveryPointResponse (Maybe UTCTime)
describeRecoveryPointResponse_lastRestoreTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe POSIX
lastRestoreTime :: Maybe POSIX
$sel:lastRestoreTime:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe POSIX
lastRestoreTime} -> Maybe POSIX
lastRestoreTime) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe POSIX
a -> DescribeRecoveryPointResponse
s {$sel:lastRestoreTime:DescribeRecoveryPointResponse' :: Maybe POSIX
lastRestoreTime = Maybe POSIX
a} :: DescribeRecoveryPointResponse) 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 lifecycle defines when a protected resource is transitioned to cold
-- storage and when it expires. Backup transitions and expires backups
-- automatically according to the lifecycle that you define.
--
-- Backups that are transitioned to cold storage must be stored in cold
-- storage for a minimum of 90 days. Therefore, the “retention” setting
-- must be 90 days greater than the “transition to cold after days”
-- setting. The “transition to cold after days” setting cannot be changed
-- after a backup has been transitioned to cold.
--
-- Resource types that are able to be transitioned to cold storage are
-- listed in the \"Lifecycle to cold storage\" section of the
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/whatisbackup.html#features-by-resource Feature availability by resource>
-- table. Backup ignores this expression for other resource types.
describeRecoveryPointResponse_lifecycle :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Lifecycle)
describeRecoveryPointResponse_lifecycle :: Lens' DescribeRecoveryPointResponse (Maybe Lifecycle)
describeRecoveryPointResponse_lifecycle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Lifecycle
lifecycle :: Maybe Lifecycle
$sel:lifecycle:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Lifecycle
lifecycle} -> Maybe Lifecycle
lifecycle) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Lifecycle
a -> DescribeRecoveryPointResponse
s {$sel:lifecycle:DescribeRecoveryPointResponse' :: Maybe Lifecycle
lifecycle = Maybe Lifecycle
a} :: DescribeRecoveryPointResponse)

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

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

-- | An ARN that uniquely identifies a saved resource. The format of the ARN
-- depends on the resource type.
describeRecoveryPointResponse_resourceArn :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
describeRecoveryPointResponse_resourceArn :: Lens' DescribeRecoveryPointResponse (Maybe Text)
describeRecoveryPointResponse_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Text
resourceArn :: Maybe Text
$sel:resourceArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
resourceArn} -> Maybe Text
resourceArn) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Text
a -> DescribeRecoveryPointResponse
s {$sel:resourceArn:DescribeRecoveryPointResponse' :: Maybe Text
resourceArn = Maybe Text
a} :: DescribeRecoveryPointResponse)

-- | The type of Amazon Web Services resource to save as a recovery point;
-- for example, an Amazon Elastic Block Store (Amazon EBS) volume or an
-- Amazon Relational Database Service (Amazon RDS) database.
describeRecoveryPointResponse_resourceType :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
describeRecoveryPointResponse_resourceType :: Lens' DescribeRecoveryPointResponse (Maybe Text)
describeRecoveryPointResponse_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Text
resourceType :: Maybe Text
$sel:resourceType:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
resourceType} -> Maybe Text
resourceType) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Text
a -> DescribeRecoveryPointResponse
s {$sel:resourceType:DescribeRecoveryPointResponse' :: Maybe Text
resourceType = Maybe Text
a} :: DescribeRecoveryPointResponse)

-- | An Amazon Resource Name (ARN) that uniquely identifies the source vault
-- where the resource was originally backed up in; for example,
-- @arn:aws:backup:us-east-1:123456789012:vault:BackupVault@. If the
-- recovery is restored to the same Amazon Web Services account or Region,
-- this value will be @null@.
describeRecoveryPointResponse_sourceBackupVaultArn :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
describeRecoveryPointResponse_sourceBackupVaultArn :: Lens' DescribeRecoveryPointResponse (Maybe Text)
describeRecoveryPointResponse_sourceBackupVaultArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Text
sourceBackupVaultArn :: Maybe Text
$sel:sourceBackupVaultArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
sourceBackupVaultArn} -> Maybe Text
sourceBackupVaultArn) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Text
a -> DescribeRecoveryPointResponse
s {$sel:sourceBackupVaultArn:DescribeRecoveryPointResponse' :: Maybe Text
sourceBackupVaultArn = Maybe Text
a} :: DescribeRecoveryPointResponse)

-- | A status code specifying the state of the recovery point.
--
-- @PARTIAL@ status indicates Backup could not create the recovery point
-- before the backup window closed. To increase your backup plan window
-- using the API, see
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/API_UpdateBackupPlan.html UpdateBackupPlan>.
-- You can also increase your backup plan window using the Console by
-- choosing and editing your backup plan.
--
-- @EXPIRED@ status indicates that the recovery point has exceeded its
-- retention period, but Backup lacks permission or is otherwise unable to
-- delete it. To manually delete these recovery points, see
-- <https://docs.aws.amazon.com/aws-backup/latest/devguide/gs-cleanup-resources.html#cleanup-backups Step 3: Delete the recovery points>
-- in the /Clean up resources/ section of /Getting started/.
--
-- @STOPPED@ status occurs on a continuous backup where a user has taken
-- some action that causes the continuous backup to be disabled. This can
-- be caused by the removal of permissions, turning off versioning, turning
-- off events being sent to EventBridge, or disabling the EventBridge rules
-- that are put in place by Backup.
--
-- To resolve @STOPPED@ status, ensure that all requested permissions are
-- in place and that versioning is enabled on the S3 bucket. Once these
-- conditions are met, the next instance of a backup rule running will
-- result in a new continuous recovery point being created. The recovery
-- points with STOPPED status do not need to be deleted.
describeRecoveryPointResponse_status :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe RecoveryPointStatus)
describeRecoveryPointResponse_status :: Lens' DescribeRecoveryPointResponse (Maybe RecoveryPointStatus)
describeRecoveryPointResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe RecoveryPointStatus
status :: Maybe RecoveryPointStatus
$sel:status:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe RecoveryPointStatus
status} -> Maybe RecoveryPointStatus
status) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe RecoveryPointStatus
a -> DescribeRecoveryPointResponse
s {$sel:status:DescribeRecoveryPointResponse' :: Maybe RecoveryPointStatus
status = Maybe RecoveryPointStatus
a} :: DescribeRecoveryPointResponse)

-- | A status message explaining the reason for the recovery point deletion
-- failure.
describeRecoveryPointResponse_statusMessage :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe Prelude.Text)
describeRecoveryPointResponse_statusMessage :: Lens' DescribeRecoveryPointResponse (Maybe Text)
describeRecoveryPointResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe Text
a -> DescribeRecoveryPointResponse
s {$sel:statusMessage:DescribeRecoveryPointResponse' :: Maybe Text
statusMessage = Maybe Text
a} :: DescribeRecoveryPointResponse)

-- | Specifies the storage class of the recovery point. Valid values are
-- @WARM@ or @COLD@.
describeRecoveryPointResponse_storageClass :: Lens.Lens' DescribeRecoveryPointResponse (Prelude.Maybe StorageClass)
describeRecoveryPointResponse_storageClass :: Lens' DescribeRecoveryPointResponse (Maybe StorageClass)
describeRecoveryPointResponse_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeRecoveryPointResponse' {Maybe StorageClass
storageClass :: Maybe StorageClass
$sel:storageClass:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe StorageClass
storageClass} -> Maybe StorageClass
storageClass) (\s :: DescribeRecoveryPointResponse
s@DescribeRecoveryPointResponse' {} Maybe StorageClass
a -> DescribeRecoveryPointResponse
s {$sel:storageClass:DescribeRecoveryPointResponse' :: Maybe StorageClass
storageClass = Maybe StorageClass
a} :: DescribeRecoveryPointResponse)

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

instance Prelude.NFData DescribeRecoveryPointResponse where
  rnf :: DescribeRecoveryPointResponse -> ()
rnf DescribeRecoveryPointResponse' {Int
Maybe Bool
Maybe Integer
Maybe Text
Maybe POSIX
Maybe CalculatedLifecycle
Maybe Lifecycle
Maybe RecoveryPointCreator
Maybe RecoveryPointStatus
Maybe StorageClass
httpStatus :: Int
storageClass :: Maybe StorageClass
statusMessage :: Maybe Text
status :: Maybe RecoveryPointStatus
sourceBackupVaultArn :: Maybe Text
resourceType :: Maybe Text
resourceArn :: Maybe Text
recoveryPointArn :: Maybe Text
parentRecoveryPointArn :: Maybe Text
lifecycle :: Maybe Lifecycle
lastRestoreTime :: Maybe POSIX
isParent :: Maybe Bool
isEncrypted :: Maybe Bool
iamRoleArn :: Maybe Text
encryptionKeyArn :: Maybe Text
creationDate :: Maybe POSIX
createdBy :: Maybe RecoveryPointCreator
compositeMemberIdentifier :: Maybe Text
completionDate :: Maybe POSIX
calculatedLifecycle :: Maybe CalculatedLifecycle
backupVaultName :: Maybe Text
backupVaultArn :: Maybe Text
backupSizeInBytes :: Maybe Integer
$sel:httpStatus:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Int
$sel:storageClass:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe StorageClass
$sel:statusMessage:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:status:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe RecoveryPointStatus
$sel:sourceBackupVaultArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:resourceType:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:resourceArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:recoveryPointArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:parentRecoveryPointArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:lifecycle:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Lifecycle
$sel:lastRestoreTime:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe POSIX
$sel:isParent:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Bool
$sel:isEncrypted:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Bool
$sel:iamRoleArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:encryptionKeyArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:creationDate:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe POSIX
$sel:createdBy:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe RecoveryPointCreator
$sel:compositeMemberIdentifier:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:completionDate:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe POSIX
$sel:calculatedLifecycle:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe CalculatedLifecycle
$sel:backupVaultName:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:backupVaultArn:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Text
$sel:backupSizeInBytes:DescribeRecoveryPointResponse' :: DescribeRecoveryPointResponse -> Maybe Integer
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
backupSizeInBytes
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
backupVaultName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CalculatedLifecycle
calculatedLifecycle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
completionDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
compositeMemberIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecoveryPointCreator
createdBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
encryptionKeyArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
iamRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isEncrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isParent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastRestoreTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Lifecycle
lifecycle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentRecoveryPointArn
      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 Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceBackupVaultArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RecoveryPointStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageClass
storageClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus