{-# 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.DescribeBackupJob
-- 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 backup job details for the specified @BackupJobId@.
module Amazonka.Backup.DescribeBackupJob
  ( -- * Creating a Request
    DescribeBackupJob (..),
    newDescribeBackupJob,

    -- * Request Lenses
    describeBackupJob_backupJobId,

    -- * Destructuring the Response
    DescribeBackupJobResponse (..),
    newDescribeBackupJobResponse,

    -- * Response Lenses
    describeBackupJobResponse_accountId,
    describeBackupJobResponse_backupJobId,
    describeBackupJobResponse_backupOptions,
    describeBackupJobResponse_backupSizeInBytes,
    describeBackupJobResponse_backupType,
    describeBackupJobResponse_backupVaultArn,
    describeBackupJobResponse_backupVaultName,
    describeBackupJobResponse_bytesTransferred,
    describeBackupJobResponse_childJobsInState,
    describeBackupJobResponse_completionDate,
    describeBackupJobResponse_createdBy,
    describeBackupJobResponse_creationDate,
    describeBackupJobResponse_expectedCompletionDate,
    describeBackupJobResponse_iamRoleArn,
    describeBackupJobResponse_isParent,
    describeBackupJobResponse_numberOfChildJobs,
    describeBackupJobResponse_parentJobId,
    describeBackupJobResponse_percentDone,
    describeBackupJobResponse_recoveryPointArn,
    describeBackupJobResponse_resourceArn,
    describeBackupJobResponse_resourceType,
    describeBackupJobResponse_startBy,
    describeBackupJobResponse_state,
    describeBackupJobResponse_statusMessage,
    describeBackupJobResponse_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:/ 'newDescribeBackupJob' smart constructor.
data DescribeBackupJob = DescribeBackupJob'
  { -- | Uniquely identifies a request to Backup to back up a resource.
    DescribeBackupJob -> Text
backupJobId :: Prelude.Text
  }
  deriving (DescribeBackupJob -> DescribeBackupJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBackupJob -> DescribeBackupJob -> Bool
$c/= :: DescribeBackupJob -> DescribeBackupJob -> Bool
== :: DescribeBackupJob -> DescribeBackupJob -> Bool
$c== :: DescribeBackupJob -> DescribeBackupJob -> Bool
Prelude.Eq, ReadPrec [DescribeBackupJob]
ReadPrec DescribeBackupJob
Int -> ReadS DescribeBackupJob
ReadS [DescribeBackupJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBackupJob]
$creadListPrec :: ReadPrec [DescribeBackupJob]
readPrec :: ReadPrec DescribeBackupJob
$creadPrec :: ReadPrec DescribeBackupJob
readList :: ReadS [DescribeBackupJob]
$creadList :: ReadS [DescribeBackupJob]
readsPrec :: Int -> ReadS DescribeBackupJob
$creadsPrec :: Int -> ReadS DescribeBackupJob
Prelude.Read, Int -> DescribeBackupJob -> ShowS
[DescribeBackupJob] -> ShowS
DescribeBackupJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBackupJob] -> ShowS
$cshowList :: [DescribeBackupJob] -> ShowS
show :: DescribeBackupJob -> String
$cshow :: DescribeBackupJob -> String
showsPrec :: Int -> DescribeBackupJob -> ShowS
$cshowsPrec :: Int -> DescribeBackupJob -> ShowS
Prelude.Show, forall x. Rep DescribeBackupJob x -> DescribeBackupJob
forall x. DescribeBackupJob -> Rep DescribeBackupJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeBackupJob x -> DescribeBackupJob
$cfrom :: forall x. DescribeBackupJob -> Rep DescribeBackupJob x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBackupJob' 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:
--
-- 'backupJobId', 'describeBackupJob_backupJobId' - Uniquely identifies a request to Backup to back up a resource.
newDescribeBackupJob ::
  -- | 'backupJobId'
  Prelude.Text ->
  DescribeBackupJob
newDescribeBackupJob :: Text -> DescribeBackupJob
newDescribeBackupJob Text
pBackupJobId_ =
  DescribeBackupJob' {$sel:backupJobId:DescribeBackupJob' :: Text
backupJobId = Text
pBackupJobId_}

-- | Uniquely identifies a request to Backup to back up a resource.
describeBackupJob_backupJobId :: Lens.Lens' DescribeBackupJob Prelude.Text
describeBackupJob_backupJobId :: Lens' DescribeBackupJob Text
describeBackupJob_backupJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJob' {Text
backupJobId :: Text
$sel:backupJobId:DescribeBackupJob' :: DescribeBackupJob -> Text
backupJobId} -> Text
backupJobId) (\s :: DescribeBackupJob
s@DescribeBackupJob' {} Text
a -> DescribeBackupJob
s {$sel:backupJobId:DescribeBackupJob' :: Text
backupJobId = Text
a} :: DescribeBackupJob)

instance Core.AWSRequest DescribeBackupJob where
  type
    AWSResponse DescribeBackupJob =
      DescribeBackupJobResponse
  request :: (Service -> Service)
-> DescribeBackupJob -> Request DescribeBackupJob
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 DescribeBackupJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeBackupJob)))
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 (HashMap Text Text)
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe (HashMap BackupJobState Integer)
-> Maybe POSIX
-> Maybe RecoveryPointCreator
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe Bool
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe BackupJobState
-> Maybe Text
-> Int
-> DescribeBackupJobResponse
DescribeBackupJobResponse'
            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
"AccountId")
            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
"BackupJobId")
            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
"BackupOptions" 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.<*> (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
"BackupType")
            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
"BytesTransferred")
            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
"ChildJobsInState"
                            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.<*> (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
"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
"ExpectedCompletionDate")
            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
"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
"NumberOfChildJobs")
            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
"ParentJobId")
            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
"PercentDone")
            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
"StartBy")
            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
"State")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

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

instance Prelude.NFData DescribeBackupJob where
  rnf :: DescribeBackupJob -> ()
rnf DescribeBackupJob' {Text
backupJobId :: Text
$sel:backupJobId:DescribeBackupJob' :: DescribeBackupJob -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
backupJobId

instance Data.ToHeaders DescribeBackupJob where
  toHeaders :: DescribeBackupJob -> 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 DescribeBackupJob where
  toPath :: DescribeBackupJob -> ByteString
toPath DescribeBackupJob' {Text
backupJobId :: Text
$sel:backupJobId:DescribeBackupJob' :: DescribeBackupJob -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/backup-jobs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupJobId]

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

-- | /See:/ 'newDescribeBackupJobResponse' smart constructor.
data DescribeBackupJobResponse = DescribeBackupJobResponse'
  { -- | Returns the account ID that owns the backup job.
    DescribeBackupJobResponse -> Maybe Text
accountId :: Prelude.Maybe Prelude.Text,
    -- | Uniquely identifies a request to Backup to back up a resource.
    DescribeBackupJobResponse -> Maybe Text
backupJobId :: Prelude.Maybe Prelude.Text,
    -- | Represents the options specified as part of backup plan or on-demand
    -- backup job.
    DescribeBackupJobResponse -> Maybe (HashMap Text Text)
backupOptions :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The size, in bytes, of a backup.
    DescribeBackupJobResponse -> Maybe Integer
backupSizeInBytes :: Prelude.Maybe Prelude.Integer,
    -- | Represents the actual backup type selected for a backup job. For
    -- example, if a successful Windows Volume Shadow Copy Service (VSS) backup
    -- was taken, @BackupType@ returns @\"WindowsVSS\"@. If @BackupType@ is
    -- empty, then the backup type was a regular backup.
    DescribeBackupJobResponse -> Maybe Text
backupType :: Prelude.Maybe Prelude.Text,
    -- | An Amazon Resource Name (ARN) that uniquely identifies a backup vault;
    -- for example, @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
    DescribeBackupJobResponse -> 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 Amazon Web Services Region where they are created. They
    -- consist of lowercase letters, numbers, and hyphens.
    DescribeBackupJobResponse -> Maybe Text
backupVaultName :: Prelude.Maybe Prelude.Text,
    -- | The size in bytes transferred to a backup vault at the time that the job
    -- status was queried.
    DescribeBackupJobResponse -> Maybe Integer
bytesTransferred :: Prelude.Maybe Prelude.Integer,
    -- | This returns the statistics of the included child (nested) backup jobs.
    DescribeBackupJobResponse -> Maybe (HashMap BackupJobState Integer)
childJobsInState :: Prelude.Maybe (Prelude.HashMap BackupJobState Prelude.Integer),
    -- | The date and time that a job to create a backup job 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.
    DescribeBackupJobResponse -> Maybe POSIX
completionDate :: Prelude.Maybe Data.POSIX,
    -- | Contains identifying information about the creation of a backup job,
    -- including the @BackupPlanArn@, @BackupPlanId@, @BackupPlanVersion@, and
    -- @BackupRuleId@ of the backup plan that is used to create it.
    DescribeBackupJobResponse -> Maybe RecoveryPointCreator
createdBy :: Prelude.Maybe RecoveryPointCreator,
    -- | The date and time that a backup job 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.
    DescribeBackupJobResponse -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | The date and time that a job to back up resources is expected to be
    -- completed, in Unix format and Coordinated Universal Time (UTC). The
    -- value of @ExpectedCompletionDate@ is accurate to milliseconds. For
    -- example, the value 1516925490.087 represents Friday, January 26, 2018
    -- 12:11:30.087 AM.
    DescribeBackupJobResponse -> Maybe POSIX
expectedCompletionDate :: Prelude.Maybe Data.POSIX,
    -- | Specifies the IAM role ARN used to create the target recovery point; for
    -- example, @arn:aws:iam::123456789012:role\/S3Access@.
    DescribeBackupJobResponse -> Maybe Text
iamRoleArn :: Prelude.Maybe Prelude.Text,
    -- | This returns the boolean value that a backup job is a parent (composite)
    -- job.
    DescribeBackupJobResponse -> Maybe Bool
isParent :: Prelude.Maybe Prelude.Bool,
    -- | This returns the number of child (nested) backup jobs.
    DescribeBackupJobResponse -> Maybe Integer
numberOfChildJobs :: Prelude.Maybe Prelude.Integer,
    -- | This returns the parent (composite) resource backup job ID.
    DescribeBackupJobResponse -> Maybe Text
parentJobId :: Prelude.Maybe Prelude.Text,
    -- | Contains an estimated percentage that is complete of a job at the time
    -- the job status was queried.
    DescribeBackupJobResponse -> Maybe Text
percentDone :: 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@.
    DescribeBackupJobResponse -> 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.
    DescribeBackupJobResponse -> Maybe Text
resourceArn :: Prelude.Maybe Prelude.Text,
    -- | The type of Amazon Web Services resource to be backed up; for example,
    -- an Amazon Elastic Block Store (Amazon EBS) volume or an Amazon
    -- Relational Database Service (Amazon RDS) database.
    DescribeBackupJobResponse -> Maybe Text
resourceType :: Prelude.Maybe Prelude.Text,
    -- | Specifies the time in Unix format and Coordinated Universal Time (UTC)
    -- when a backup job must be started before it is canceled. The value is
    -- calculated by adding the start window to the scheduled time. So if the
    -- scheduled time were 6:00 PM and the start window is 2 hours, the
    -- @StartBy@ time would be 8:00 PM on the date specified. The value of
    -- @StartBy@ is accurate to milliseconds. For example, the value
    -- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
    DescribeBackupJobResponse -> Maybe POSIX
startBy :: Prelude.Maybe Data.POSIX,
    -- | The current state of a resource recovery point.
    DescribeBackupJobResponse -> Maybe BackupJobState
state :: Prelude.Maybe BackupJobState,
    -- | A detailed message explaining the status of the job to back up a
    -- resource.
    DescribeBackupJobResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeBackupJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeBackupJobResponse -> DescribeBackupJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeBackupJobResponse -> DescribeBackupJobResponse -> Bool
$c/= :: DescribeBackupJobResponse -> DescribeBackupJobResponse -> Bool
== :: DescribeBackupJobResponse -> DescribeBackupJobResponse -> Bool
$c== :: DescribeBackupJobResponse -> DescribeBackupJobResponse -> Bool
Prelude.Eq, ReadPrec [DescribeBackupJobResponse]
ReadPrec DescribeBackupJobResponse
Int -> ReadS DescribeBackupJobResponse
ReadS [DescribeBackupJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeBackupJobResponse]
$creadListPrec :: ReadPrec [DescribeBackupJobResponse]
readPrec :: ReadPrec DescribeBackupJobResponse
$creadPrec :: ReadPrec DescribeBackupJobResponse
readList :: ReadS [DescribeBackupJobResponse]
$creadList :: ReadS [DescribeBackupJobResponse]
readsPrec :: Int -> ReadS DescribeBackupJobResponse
$creadsPrec :: Int -> ReadS DescribeBackupJobResponse
Prelude.Read, Int -> DescribeBackupJobResponse -> ShowS
[DescribeBackupJobResponse] -> ShowS
DescribeBackupJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeBackupJobResponse] -> ShowS
$cshowList :: [DescribeBackupJobResponse] -> ShowS
show :: DescribeBackupJobResponse -> String
$cshow :: DescribeBackupJobResponse -> String
showsPrec :: Int -> DescribeBackupJobResponse -> ShowS
$cshowsPrec :: Int -> DescribeBackupJobResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeBackupJobResponse x -> DescribeBackupJobResponse
forall x.
DescribeBackupJobResponse -> Rep DescribeBackupJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeBackupJobResponse x -> DescribeBackupJobResponse
$cfrom :: forall x.
DescribeBackupJobResponse -> Rep DescribeBackupJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeBackupJobResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'accountId', 'describeBackupJobResponse_accountId' - Returns the account ID that owns the backup job.
--
-- 'backupJobId', 'describeBackupJobResponse_backupJobId' - Uniquely identifies a request to Backup to back up a resource.
--
-- 'backupOptions', 'describeBackupJobResponse_backupOptions' - Represents the options specified as part of backup plan or on-demand
-- backup job.
--
-- 'backupSizeInBytes', 'describeBackupJobResponse_backupSizeInBytes' - The size, in bytes, of a backup.
--
-- 'backupType', 'describeBackupJobResponse_backupType' - Represents the actual backup type selected for a backup job. For
-- example, if a successful Windows Volume Shadow Copy Service (VSS) backup
-- was taken, @BackupType@ returns @\"WindowsVSS\"@. If @BackupType@ is
-- empty, then the backup type was a regular backup.
--
-- 'backupVaultArn', 'describeBackupJobResponse_backupVaultArn' - An Amazon Resource Name (ARN) that uniquely identifies a backup vault;
-- for example, @arn:aws:backup:us-east-1:123456789012:vault:aBackupVault@.
--
-- 'backupVaultName', 'describeBackupJobResponse_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.
--
-- 'bytesTransferred', 'describeBackupJobResponse_bytesTransferred' - The size in bytes transferred to a backup vault at the time that the job
-- status was queried.
--
-- 'childJobsInState', 'describeBackupJobResponse_childJobsInState' - This returns the statistics of the included child (nested) backup jobs.
--
-- 'completionDate', 'describeBackupJobResponse_completionDate' - The date and time that a job to create a backup job 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.
--
-- 'createdBy', 'describeBackupJobResponse_createdBy' - Contains identifying information about the creation of a backup job,
-- including the @BackupPlanArn@, @BackupPlanId@, @BackupPlanVersion@, and
-- @BackupRuleId@ of the backup plan that is used to create it.
--
-- 'creationDate', 'describeBackupJobResponse_creationDate' - The date and time that a backup job 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.
--
-- 'expectedCompletionDate', 'describeBackupJobResponse_expectedCompletionDate' - The date and time that a job to back up resources is expected to be
-- completed, in Unix format and Coordinated Universal Time (UTC). The
-- value of @ExpectedCompletionDate@ is accurate to milliseconds. For
-- example, the value 1516925490.087 represents Friday, January 26, 2018
-- 12:11:30.087 AM.
--
-- 'iamRoleArn', 'describeBackupJobResponse_iamRoleArn' - Specifies the IAM role ARN used to create the target recovery point; for
-- example, @arn:aws:iam::123456789012:role\/S3Access@.
--
-- 'isParent', 'describeBackupJobResponse_isParent' - This returns the boolean value that a backup job is a parent (composite)
-- job.
--
-- 'numberOfChildJobs', 'describeBackupJobResponse_numberOfChildJobs' - This returns the number of child (nested) backup jobs.
--
-- 'parentJobId', 'describeBackupJobResponse_parentJobId' - This returns the parent (composite) resource backup job ID.
--
-- 'percentDone', 'describeBackupJobResponse_percentDone' - Contains an estimated percentage that is complete of a job at the time
-- the job status was queried.
--
-- 'recoveryPointArn', 'describeBackupJobResponse_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', 'describeBackupJobResponse_resourceArn' - An ARN that uniquely identifies a saved resource. The format of the ARN
-- depends on the resource type.
--
-- 'resourceType', 'describeBackupJobResponse_resourceType' - The type of Amazon Web Services resource to be backed up; for example,
-- an Amazon Elastic Block Store (Amazon EBS) volume or an Amazon
-- Relational Database Service (Amazon RDS) database.
--
-- 'startBy', 'describeBackupJobResponse_startBy' - Specifies the time in Unix format and Coordinated Universal Time (UTC)
-- when a backup job must be started before it is canceled. The value is
-- calculated by adding the start window to the scheduled time. So if the
-- scheduled time were 6:00 PM and the start window is 2 hours, the
-- @StartBy@ time would be 8:00 PM on the date specified. The value of
-- @StartBy@ is accurate to milliseconds. For example, the value
-- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'state', 'describeBackupJobResponse_state' - The current state of a resource recovery point.
--
-- 'statusMessage', 'describeBackupJobResponse_statusMessage' - A detailed message explaining the status of the job to back up a
-- resource.
--
-- 'httpStatus', 'describeBackupJobResponse_httpStatus' - The response's http status code.
newDescribeBackupJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeBackupJobResponse
newDescribeBackupJobResponse :: Int -> DescribeBackupJobResponse
newDescribeBackupJobResponse Int
pHttpStatus_ =
  DescribeBackupJobResponse'
    { $sel:accountId:DescribeBackupJobResponse' :: Maybe Text
accountId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backupJobId:DescribeBackupJobResponse' :: Maybe Text
backupJobId = forall a. Maybe a
Prelude.Nothing,
      $sel:backupOptions:DescribeBackupJobResponse' :: Maybe (HashMap Text Text)
backupOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:backupSizeInBytes:DescribeBackupJobResponse' :: Maybe Integer
backupSizeInBytes = forall a. Maybe a
Prelude.Nothing,
      $sel:backupType:DescribeBackupJobResponse' :: Maybe Text
backupType = forall a. Maybe a
Prelude.Nothing,
      $sel:backupVaultArn:DescribeBackupJobResponse' :: Maybe Text
backupVaultArn = forall a. Maybe a
Prelude.Nothing,
      $sel:backupVaultName:DescribeBackupJobResponse' :: Maybe Text
backupVaultName = forall a. Maybe a
Prelude.Nothing,
      $sel:bytesTransferred:DescribeBackupJobResponse' :: Maybe Integer
bytesTransferred = forall a. Maybe a
Prelude.Nothing,
      $sel:childJobsInState:DescribeBackupJobResponse' :: Maybe (HashMap BackupJobState Integer)
childJobsInState = forall a. Maybe a
Prelude.Nothing,
      $sel:completionDate:DescribeBackupJobResponse' :: Maybe POSIX
completionDate = forall a. Maybe a
Prelude.Nothing,
      $sel:createdBy:DescribeBackupJobResponse' :: Maybe RecoveryPointCreator
createdBy = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:DescribeBackupJobResponse' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:expectedCompletionDate:DescribeBackupJobResponse' :: Maybe POSIX
expectedCompletionDate = forall a. Maybe a
Prelude.Nothing,
      $sel:iamRoleArn:DescribeBackupJobResponse' :: Maybe Text
iamRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:isParent:DescribeBackupJobResponse' :: Maybe Bool
isParent = forall a. Maybe a
Prelude.Nothing,
      $sel:numberOfChildJobs:DescribeBackupJobResponse' :: Maybe Integer
numberOfChildJobs = forall a. Maybe a
Prelude.Nothing,
      $sel:parentJobId:DescribeBackupJobResponse' :: Maybe Text
parentJobId = forall a. Maybe a
Prelude.Nothing,
      $sel:percentDone:DescribeBackupJobResponse' :: Maybe Text
percentDone = forall a. Maybe a
Prelude.Nothing,
      $sel:recoveryPointArn:DescribeBackupJobResponse' :: Maybe Text
recoveryPointArn = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:DescribeBackupJobResponse' :: Maybe Text
resourceArn = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:DescribeBackupJobResponse' :: Maybe Text
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:startBy:DescribeBackupJobResponse' :: Maybe POSIX
startBy = forall a. Maybe a
Prelude.Nothing,
      $sel:state:DescribeBackupJobResponse' :: Maybe BackupJobState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:DescribeBackupJobResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeBackupJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Returns the account ID that owns the backup job.
describeBackupJobResponse_accountId :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.Text)
describeBackupJobResponse_accountId :: Lens' DescribeBackupJobResponse (Maybe Text)
describeBackupJobResponse_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe Text
accountId :: Maybe Text
$sel:accountId:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
accountId} -> Maybe Text
accountId) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe Text
a -> DescribeBackupJobResponse
s {$sel:accountId:DescribeBackupJobResponse' :: Maybe Text
accountId = Maybe Text
a} :: DescribeBackupJobResponse)

-- | Uniquely identifies a request to Backup to back up a resource.
describeBackupJobResponse_backupJobId :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.Text)
describeBackupJobResponse_backupJobId :: Lens' DescribeBackupJobResponse (Maybe Text)
describeBackupJobResponse_backupJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe Text
backupJobId :: Maybe Text
$sel:backupJobId:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
backupJobId} -> Maybe Text
backupJobId) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe Text
a -> DescribeBackupJobResponse
s {$sel:backupJobId:DescribeBackupJobResponse' :: Maybe Text
backupJobId = Maybe Text
a} :: DescribeBackupJobResponse)

-- | Represents the options specified as part of backup plan or on-demand
-- backup job.
describeBackupJobResponse_backupOptions :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describeBackupJobResponse_backupOptions :: Lens' DescribeBackupJobResponse (Maybe (HashMap Text Text))
describeBackupJobResponse_backupOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe (HashMap Text Text)
backupOptions :: Maybe (HashMap Text Text)
$sel:backupOptions:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe (HashMap Text Text)
backupOptions} -> Maybe (HashMap Text Text)
backupOptions) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe (HashMap Text Text)
a -> DescribeBackupJobResponse
s {$sel:backupOptions:DescribeBackupJobResponse' :: Maybe (HashMap Text Text)
backupOptions = Maybe (HashMap Text Text)
a} :: DescribeBackupJobResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | Represents the actual backup type selected for a backup job. For
-- example, if a successful Windows Volume Shadow Copy Service (VSS) backup
-- was taken, @BackupType@ returns @\"WindowsVSS\"@. If @BackupType@ is
-- empty, then the backup type was a regular backup.
describeBackupJobResponse_backupType :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.Text)
describeBackupJobResponse_backupType :: Lens' DescribeBackupJobResponse (Maybe Text)
describeBackupJobResponse_backupType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe Text
backupType :: Maybe Text
$sel:backupType:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
backupType} -> Maybe Text
backupType) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe Text
a -> DescribeBackupJobResponse
s {$sel:backupType:DescribeBackupJobResponse' :: Maybe Text
backupType = Maybe Text
a} :: DescribeBackupJobResponse)

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

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

-- | The size in bytes transferred to a backup vault at the time that the job
-- status was queried.
describeBackupJobResponse_bytesTransferred :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.Integer)
describeBackupJobResponse_bytesTransferred :: Lens' DescribeBackupJobResponse (Maybe Integer)
describeBackupJobResponse_bytesTransferred = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe Integer
bytesTransferred :: Maybe Integer
$sel:bytesTransferred:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Integer
bytesTransferred} -> Maybe Integer
bytesTransferred) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe Integer
a -> DescribeBackupJobResponse
s {$sel:bytesTransferred:DescribeBackupJobResponse' :: Maybe Integer
bytesTransferred = Maybe Integer
a} :: DescribeBackupJobResponse)

-- | This returns the statistics of the included child (nested) backup jobs.
describeBackupJobResponse_childJobsInState :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe (Prelude.HashMap BackupJobState Prelude.Integer))
describeBackupJobResponse_childJobsInState :: Lens'
  DescribeBackupJobResponse (Maybe (HashMap BackupJobState Integer))
describeBackupJobResponse_childJobsInState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe (HashMap BackupJobState Integer)
childJobsInState :: Maybe (HashMap BackupJobState Integer)
$sel:childJobsInState:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe (HashMap BackupJobState Integer)
childJobsInState} -> Maybe (HashMap BackupJobState Integer)
childJobsInState) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe (HashMap BackupJobState Integer)
a -> DescribeBackupJobResponse
s {$sel:childJobsInState:DescribeBackupJobResponse' :: Maybe (HashMap BackupJobState Integer)
childJobsInState = Maybe (HashMap BackupJobState Integer)
a} :: DescribeBackupJobResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The date and time that a job to create a backup job 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.
describeBackupJobResponse_completionDate :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.UTCTime)
describeBackupJobResponse_completionDate :: Lens' DescribeBackupJobResponse (Maybe UTCTime)
describeBackupJobResponse_completionDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe POSIX
completionDate :: Maybe POSIX
$sel:completionDate:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe POSIX
completionDate} -> Maybe POSIX
completionDate) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe POSIX
a -> DescribeBackupJobResponse
s {$sel:completionDate:DescribeBackupJobResponse' :: Maybe POSIX
completionDate = Maybe POSIX
a} :: DescribeBackupJobResponse) 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

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

-- | The date and time that a backup job 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.
describeBackupJobResponse_creationDate :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.UTCTime)
describeBackupJobResponse_creationDate :: Lens' DescribeBackupJobResponse (Maybe UTCTime)
describeBackupJobResponse_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe POSIX
a -> DescribeBackupJobResponse
s {$sel:creationDate:DescribeBackupJobResponse' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: DescribeBackupJobResponse) 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 date and time that a job to back up resources is expected to be
-- completed, in Unix format and Coordinated Universal Time (UTC). The
-- value of @ExpectedCompletionDate@ is accurate to milliseconds. For
-- example, the value 1516925490.087 represents Friday, January 26, 2018
-- 12:11:30.087 AM.
describeBackupJobResponse_expectedCompletionDate :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.UTCTime)
describeBackupJobResponse_expectedCompletionDate :: Lens' DescribeBackupJobResponse (Maybe UTCTime)
describeBackupJobResponse_expectedCompletionDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe POSIX
expectedCompletionDate :: Maybe POSIX
$sel:expectedCompletionDate:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe POSIX
expectedCompletionDate} -> Maybe POSIX
expectedCompletionDate) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe POSIX
a -> DescribeBackupJobResponse
s {$sel:expectedCompletionDate:DescribeBackupJobResponse' :: Maybe POSIX
expectedCompletionDate = Maybe POSIX
a} :: DescribeBackupJobResponse) 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

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

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

-- | This returns the number of child (nested) backup jobs.
describeBackupJobResponse_numberOfChildJobs :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.Integer)
describeBackupJobResponse_numberOfChildJobs :: Lens' DescribeBackupJobResponse (Maybe Integer)
describeBackupJobResponse_numberOfChildJobs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe Integer
numberOfChildJobs :: Maybe Integer
$sel:numberOfChildJobs:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Integer
numberOfChildJobs} -> Maybe Integer
numberOfChildJobs) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe Integer
a -> DescribeBackupJobResponse
s {$sel:numberOfChildJobs:DescribeBackupJobResponse' :: Maybe Integer
numberOfChildJobs = Maybe Integer
a} :: DescribeBackupJobResponse)

-- | This returns the parent (composite) resource backup job ID.
describeBackupJobResponse_parentJobId :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.Text)
describeBackupJobResponse_parentJobId :: Lens' DescribeBackupJobResponse (Maybe Text)
describeBackupJobResponse_parentJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe Text
parentJobId :: Maybe Text
$sel:parentJobId:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
parentJobId} -> Maybe Text
parentJobId) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe Text
a -> DescribeBackupJobResponse
s {$sel:parentJobId:DescribeBackupJobResponse' :: Maybe Text
parentJobId = Maybe Text
a} :: DescribeBackupJobResponse)

-- | Contains an estimated percentage that is complete of a job at the time
-- the job status was queried.
describeBackupJobResponse_percentDone :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.Text)
describeBackupJobResponse_percentDone :: Lens' DescribeBackupJobResponse (Maybe Text)
describeBackupJobResponse_percentDone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe Text
percentDone :: Maybe Text
$sel:percentDone:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
percentDone} -> Maybe Text
percentDone) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe Text
a -> DescribeBackupJobResponse
s {$sel:percentDone:DescribeBackupJobResponse' :: Maybe Text
percentDone = Maybe Text
a} :: DescribeBackupJobResponse)

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

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

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

-- | Specifies the time in Unix format and Coordinated Universal Time (UTC)
-- when a backup job must be started before it is canceled. The value is
-- calculated by adding the start window to the scheduled time. So if the
-- scheduled time were 6:00 PM and the start window is 2 hours, the
-- @StartBy@ time would be 8:00 PM on the date specified. The value of
-- @StartBy@ is accurate to milliseconds. For example, the value
-- 1516925490.087 represents Friday, January 26, 2018 12:11:30.087 AM.
describeBackupJobResponse_startBy :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.UTCTime)
describeBackupJobResponse_startBy :: Lens' DescribeBackupJobResponse (Maybe UTCTime)
describeBackupJobResponse_startBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe POSIX
startBy :: Maybe POSIX
$sel:startBy:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe POSIX
startBy} -> Maybe POSIX
startBy) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe POSIX
a -> DescribeBackupJobResponse
s {$sel:startBy:DescribeBackupJobResponse' :: Maybe POSIX
startBy = Maybe POSIX
a} :: DescribeBackupJobResponse) 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 current state of a resource recovery point.
describeBackupJobResponse_state :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe BackupJobState)
describeBackupJobResponse_state :: Lens' DescribeBackupJobResponse (Maybe BackupJobState)
describeBackupJobResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe BackupJobState
state :: Maybe BackupJobState
$sel:state:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe BackupJobState
state} -> Maybe BackupJobState
state) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe BackupJobState
a -> DescribeBackupJobResponse
s {$sel:state:DescribeBackupJobResponse' :: Maybe BackupJobState
state = Maybe BackupJobState
a} :: DescribeBackupJobResponse)

-- | A detailed message explaining the status of the job to back up a
-- resource.
describeBackupJobResponse_statusMessage :: Lens.Lens' DescribeBackupJobResponse (Prelude.Maybe Prelude.Text)
describeBackupJobResponse_statusMessage :: Lens' DescribeBackupJobResponse (Maybe Text)
describeBackupJobResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeBackupJobResponse' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: DescribeBackupJobResponse
s@DescribeBackupJobResponse' {} Maybe Text
a -> DescribeBackupJobResponse
s {$sel:statusMessage:DescribeBackupJobResponse' :: Maybe Text
statusMessage = Maybe Text
a} :: DescribeBackupJobResponse)

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

instance Prelude.NFData DescribeBackupJobResponse where
  rnf :: DescribeBackupJobResponse -> ()
rnf DescribeBackupJobResponse' {Int
Maybe Bool
Maybe Integer
Maybe Text
Maybe (HashMap Text Text)
Maybe (HashMap BackupJobState Integer)
Maybe POSIX
Maybe BackupJobState
Maybe RecoveryPointCreator
httpStatus :: Int
statusMessage :: Maybe Text
state :: Maybe BackupJobState
startBy :: Maybe POSIX
resourceType :: Maybe Text
resourceArn :: Maybe Text
recoveryPointArn :: Maybe Text
percentDone :: Maybe Text
parentJobId :: Maybe Text
numberOfChildJobs :: Maybe Integer
isParent :: Maybe Bool
iamRoleArn :: Maybe Text
expectedCompletionDate :: Maybe POSIX
creationDate :: Maybe POSIX
createdBy :: Maybe RecoveryPointCreator
completionDate :: Maybe POSIX
childJobsInState :: Maybe (HashMap BackupJobState Integer)
bytesTransferred :: Maybe Integer
backupVaultName :: Maybe Text
backupVaultArn :: Maybe Text
backupType :: Maybe Text
backupSizeInBytes :: Maybe Integer
backupOptions :: Maybe (HashMap Text Text)
backupJobId :: Maybe Text
accountId :: Maybe Text
$sel:httpStatus:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Int
$sel:statusMessage:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:state:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe BackupJobState
$sel:startBy:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe POSIX
$sel:resourceType:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:resourceArn:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:recoveryPointArn:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:percentDone:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:parentJobId:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:numberOfChildJobs:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Integer
$sel:isParent:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Bool
$sel:iamRoleArn:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:expectedCompletionDate:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe POSIX
$sel:creationDate:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe POSIX
$sel:createdBy:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe RecoveryPointCreator
$sel:completionDate:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe POSIX
$sel:childJobsInState:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe (HashMap BackupJobState Integer)
$sel:bytesTransferred:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Integer
$sel:backupVaultName:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:backupVaultArn:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:backupType:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:backupSizeInBytes:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Integer
$sel:backupOptions:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe (HashMap Text Text)
$sel:backupJobId:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
$sel:accountId:DescribeBackupJobResponse' :: DescribeBackupJobResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backupJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
backupOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
backupType
      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 Integer
bytesTransferred
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap BackupJobState Integer)
childJobsInState
      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 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 POSIX
expectedCompletionDate
      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
isParent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
numberOfChildJobs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentJobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
percentDone
      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 POSIX
startBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BackupJobState
state
      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
        Int
httpStatus